سورس کدهای مفید و کاربردی VB.Net

[Netsky]

با سلام به همه کاربران گرامی سایت برنامه نویس .
با توجه به این که بنده تاپیکی جامع در مورد سورس کدهای VB.NET ندیدم ، تصمیم گرفتم تا یک تاپیک در این رابطه راه اندازی کنم و از این به بعد نمونه کدهای کاربردی رو در اینجا قرار بدیم .
با کمک و یاری دوستان انشاالله تاپیک پر محتوایی خواهد شد .
دوستان عزیز ، برای جلوگیری از هرج و مرج و بهم ریختگی تاپیک از شما عزیزان درخواست میکنم که به نکات زیر توجه کنید :
1- از سوال کردن در این تاپیک خودداری کنید . سوالات خود را در تاپیک جداگانه مطرح کنید . در صورتی هم که در مورد یک سورس کد سوالی دارید از فرد ارسال کننده سوال خود به صورت پیام خصوصی بپرسید .
2- از پرداختن به بحث های حاشیه ای و مشاجره لفظی با دیگر کاربران اکیدا خودداری کنید .
3- از قرار دادن فایل اجرایی ( Exe ) بدون سورس کد امتنا کنید .
4- برای تشکر کردن از سورس کدهای دیگران نیز از دکمه تشکر استفاده کنید و پست بیهوده ارسال نکنید .

5- سورس کدهای خود را در فضایی که سایت به شما ارائه میدهد آپلود کنید و در صورتی که فایل شما حجیم تر از فضای ارائه شده است ، فایل خود را در مکانی دیگر آپلود و سپس لینک را در سایت قرار دهید . از درخواست ایمیل کاربران برای فرستادن سورس کد که باعث بوجود آمدن پست های بیهوده (حاوی آدرس ایمیل ها) میشود خودداری کنید .

6- در هر پست یک سورس ارسال کنید و از قرار دادن دسته جمعی سورس کدها در یک پست که باعث سردرگم شدن کاربر میشود خودداری کنید .


در پایان از همه دست اندرکاران سایت برنامه نویس و کاربران فهیم و گرامی کمال تشکر را دارم.
امید ما ، سورس کدهای خوب و مفید شما .........
با تشکر ...........

[Netsky]

سلام .
اولین برنامه رو هم خودم میزارم . با این برنامه میتونید آیکون درایوهاتون رو عوض کنید .

[Netsky]

سلام به همگی .
اینم برنامه بعدی که واستون میزام . آموزش کامل انجام کارهای گرافیکی در vb.net
20 تابع در مورد کارهای گرافیکی در این برنامه بررسی شدن .

[Netsky]

سلام .
بابا دمتون گرم . اینقدر همکاری میکنید یهو خسته شنید . بابا یه کدی ، یه چیزی بزارین .
خب ، در هر صورت برنامه بعدی که واستون نوشتم رو معرفی میکنم .
با این برنامه میتونید اطلاعات مفید هر درایو رو بگیرید . مثل :
1- فضای کلی
2- فضای خالی
3- فضای استفاده شده
4- نوع درایو
5- فرمت درایو
امیدوارم خوشتون بیاد .
بای بای ...................

[armin8651]

سلام
اینم برنامه کرنومتر که با یه روش جالب نوشتم که امیدوارم به دردتون بخوره.

[Netsky]

سلام .
یه برنامه دیگه واستون نوشتم . با این برنامه میتونید اطلاعات دمربوط به یک فایل رو استخراج کنید :
1- آدرس کامل فایل
2- ساعت ساخته شدن فایل
3- تاریخ ساخته شدن فایل
4- پسوند فایل
5- زمان آخرین دسترسی به فایل
6- زمان آخرین ویرایش فایل
7- اندازه فایل
امیدوارم خوشتون بیاد .
بای بای ..............

[Netsky]

سلام عرض میکنم خدمت تمام برنامه نویسای عزیز .

یه کد نوشتم که گفتم شاید واستون جالب باشه و براتون گذاشتم .

کد زیر رو در Form_Load کپی کنید . و نتیجه رو مشاهده کنید :

   Dim g As New Drawing2D.GraphicsPath

  g.AddEllipse(10, 10, 200, 200)

  Me.Region = New System.Drawing.Region(g)

  

[Netsky]

سلام به همه دوستان .
بابا خیلی با مرامین . این همه استاد و دریغ از یک سورس کد . البته باید از armin8651 تشکر کنم که حداقل یه سورس گذاشت .
خب حالا بگذریم . کد بعدی که میزارم میتونه واستون یه متن رو به صورت Vertical ( عمودی ) روی فرم چاپ کنه . امیدوارم خوشتون بیاد :

Dim formgraphic As System.Drawing.Graphics = Me.CreateGraphics

        Dim drawstring As String = "N e t s k y"

        Dim drawfont As New Font("Tahoma", 25)

        Dim drawbrush As New SolidBrush(Color.Blue)

        Dim x As Single = 150.0

        Dim y As Single = 50.0

        Dim drawformat As New StringFormat

        drawformat.FormatFlags = StringFormatFlags.DirectionVertical

        formgraphic.DrawString(drawstring, drawfont, drawbrush, x, y, drawformat)

        drawfont.Dispose()

        drawbrush.Dispose()

        formgraphic.Dispose()

[armin8651]

خواهش میکنم Netsky
اینم یک برنامه که عکس اسکن شده از اسکنر رو مستقیم میاره تو یک پیکچر باکس.

[Netsky]

سلام .
اینم یه برنامه باحال دیگه واسه دوستای خودم .
با این برنامه میتونید درایوهای USB کامپیوترتون رو پیدا کنید .
امیدوارم خوشتون بیاد .

[Netsky]

سلام .

اساتید گرامی ، لطفا در پربار شدن این تاپیک کمک کنید .

بابا از بس که گفتم زبونم مو در آورد .

خب از این بحث ها بگذریم و بریم سراغ کد بعدی . کار این کد اینه که عکس مورد نظرتون رو Rotate ( چرخش ) میکنه .

اگه خواستید زاویه رو هم تغییر بدید توی اعدادی که داخل کد هست ، دست ببرید .

            Dim Graphic As Graphics

          Graphic = Me.CreateGraphics

          '---------------------------

          Dim DestPoint As Point() = {New Point(100, 0), New Point(260, 50), New Point(100, 200)}

          'DestPoint = Destination Point

          '----------------------------                 

          'Adrese Aks Mored Nazare Khodetoon Ro Be Jaye ("c:\Your_Image.jpg") Bezarid . 

          Dim NewImage As Image = Image.FromFile("C:\Your_Image.jpg")

          '-------------------------------------------------

          Graphic.DrawImage(NewImage, DestPoint)

  

[Netsky]

سلام .
یه سورس کد دیگه واستون دارم . اینو از سایت Code Project دانلود کردم . خیلی باحاله . میتونید به عکس هاتون افکت های بسیار زیبای انیمیشنی بدید . اگه دانلود نکنید ضرر کردید .

[ricky22]

سلام منم می خوام تو این تاپیک فعالیت کنم

با این کد میشه سری اطلاعات رو یه جای خاص از رجیستری ذخیره کنید که مثلا برای ثبت تنظیمات کاربر میتونید مورد استفاده قرار بدید

ذخیره اطلاعات

    SaveSetting(My.Application.Info.AssemblyName, "Appearance", "Font", FontName)

  SaveSetting(My.Application.Info.AssemblyName, "Appearance", "Color", ColorName)

  

بازیابی اطلاعات

    FontName=GetSetting(My.Application.Info.AssemblyNa  me, "Appearance", "Font","")

  ColorName=GetSetting(My.Application.Info.AssemblyN  ame, "Appearance", "Color","")

  

HKEY_CURRENT_USER\Software\VB and VBA Program Settings محل ذخیره سازی اطلاعات

[ricky22]

سلام دوباره

با این کد می تونید یک فایل رو در شبکه با استفاده از وینسوک ارسال کنید.

    Public Sub SendData(ByVal sFile As String, ByVal sSaveAs As String, ByVal tcpSend As Winsock)

      On Error GoTo ErrHandler

      Dim sSend As String, sBuf As String

      Dim ifreefile As Integer

      Dim lRead As Long, lLen As Long, lThisRead As Long, lLastRead As Long

      Dim strData As String

      tcpSend.GetData(strData)

      ifreefile = FreeFile

  

      ' Open file for binary access:

      Open sFile For Binary Access Read As #ifreefile

      lLen = LOF(ifreefile)

  

      ' Loop through the file, loading it up in chunks of 64k:

      Do While lRead < lLen

          lThisRead = 65536

          If lThisRead + lRead > lLen Then

              lThisRead = lLen - lRead

          End If

          If Not lThisRead = lLastRead Then

              sBuf = Space$(lThisRead)

          End If

          Get #ifreefile, , sBuf

          lRead = lRead + lThisRead

          sSend = sSend & sBuf

          sBuf = Space$(0)

      Loop

      lTotal = lLen

      Close(ifreefile)

      bSendingFile = True

      '// Send the file notification

      tcpSend.SendData("FILE" & sSaveAs)

      DoEvents()

      '// Send the file

      tcpServer.SendData(sSend)

      DoEvents()

      '// Finished

      tcpSend.SendData("FILEEND")

      bSendingFile = False

      MMControl1.FileName = "FileDone.wav"

      MMControl1.Command = "Open"

      MMControl1.Command = "Play"

      Exit Sub

  ErrHandler:

      MsgBox "Err " & Err & " : " & Error

  End Sub

  

  Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long)

      Dim strData As String

      Dim ifreefile

  

      '    DoEvents

      tcpServer.GetData(strData)

      If Right$(strData, 7) = "FILEEND" Then

          bFileArriving = False

          lblProgress = "Saving File to " & App.Path & "\" & sFile

          sArriving = sArriving & Left$(strData, Len(strData) - 7)

          ifreefile = FreeFile

          MMControl1.FileName = "File.wav"

          MMControl1.Command = "Open"

          MMControl1.Command = "Play"

              Open sFile For Binary Access Write As #ifreefile

              Put #ifreefile, 1, sArriving

              Close #ifreefile

              ShellExecute 0, vbNullString, App.Path & "\" & sFile,

          vbNullString, vbNullString, vbNormalFocus

          lblProgress = "Complete"

      ElseIf Left$(strData, 4) = "FILE" Then

          bFileArriving = True

          sFile = Right$(strData, Len(strData) - 4)

      ElseIf bFileArriving Then

          lblProgress = "Receiving " & bytesTotal & " bytes for " & sFile & ""

  >from " & tcpServer.RemoteHostIP

          sArriving = sArriving & strData

          MMControl1.FileName = "FileDone.wav"

          MMControl1.Command = "Open"

          MMControl1.Command = "Play"

      End If

  End Sub

  

[ricky22]

انجام اعمال متداول در رجیستری

    Imports Microsoft.Win32

  

  

  Private Sub button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click

      ' // Create SubKey

      Registry.LocalMachine.CreateSubKey("Software\Sinpi  n", RegistryKeyPermissionCheck.ReadWriteSubTree)

  

      '//Create Key and Set Value

      Dim reg As RegistryKey = Registry.LocalMachine.OpenSubKey("Software\Sinpin"  , True)

      reg.SetValue("DWord", "1", RegistryValueKind.DWord)

      reg.SetValue("ExpandString", "1", RegistryValueKind.ExpandString)

      reg.SetValue("QWord", "1", RegistryValueKind.QWord)

      reg.SetValue("String", "1", RegistryValueKind.String)

      reg.SetValue("Unknown", "1", RegistryValueKind.Unknown)

  

      '// Delete Key

      reg.DeleteValue("DWOrd")

  

      '// Delete SubKey

      Registry.LocalMachine.DeleteSubKey("Software\Sinpi  n")

  

      '// Read Key Value

      Dim val As String = reg.GetValue("QWord").ToString()

  

      '// Retrieve All Keys

      For Each s As String In reg.GetValueNames()

          MessageBox.Show(s)

      Next

  

  End Sub

[ricky22]

اجرا کردن یک فایل اجرایی با کدنویسی

  System.Diagnostics.Process.Start("mspaint.exe")

چنانچه فایل اجرایی نیاز به آرگومان خط فرمان داشته باشد:

  System.Diagnostics.Process.Start("mspaint.exe", "c:\Test.bmp")

  

تغییر خواص یک فایل

  Imports System.IO

  

  

  Public Class Form1

  

      Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

          Dim file As FileInfo = New FileInfo("C:\test.txt")

          file.Attributes = file.Attributes Or FileAttributes.ReadOnly Or FileAttributes.Hidden

      End Sub

  End Class

[ricky22]

سلام چاپ متنی بر روی عکس

Dim bim AsNew Bitmap(PictureBox1.Image)

Dim g As Graphics = Graphics.FromImage(bim)

PictureBox1.CreateGraphics.DrawString(TextBox1.Tex  t, Me.Font, Brushes.Black, 10, 10)

g.DrawString(TextBox1.Text, Me.Font, Brushes.Black, 10, 10)

bim.Save("e:\test.jpg")

[Netsky]

سلام به همگی .
یک کد فوق العاده دیگه واستون آماده کردم .
با این کد میتونید انتقال هرگونه اطلاعات به USB درایوها غیر ممکن کنید .
البته نگران نباشید . کد واسه غیرفعال کردنش رو هم گذاشتم .

خب ، اول کد واسه فعال سازی :

Public Function Lock_USB()

        My.Computer.Registry.SetValue("HKEY_LOCAL_MACHINE\  SYSTEM\CurrentControlSet\Control\StorageDevicePoli  cies\", "writeProtect", 1, Microsoft.Win32.RegistryValueKind.DWord)

    End Function

کد غیر فعال کردن :

Public Function Unlock_USB()

        My.Computer.Registry.LocalMachine.DeleteSubKey("SY  STEM\CurrentControlSet\Control\StorageDevicePolici  es")

    End Function

امیدوارم حالشو ببرید ...............

[bashiry]

سلام به همگی .
یک کد فوق العاده دیگه واستون آماده کردم .
با این کد میتونید انتقال هرگونه اطلاعات به USB درایوها غیر ممکن کنید .
البته نگران نباشید . کد واسه غیرفعال کردنش رو هم گذاشتم .

خب ، اول کد واسه فعال سازی :

Public Function Lock_USB()

        My.Computer.Registry.SetValue("HKEY_LOCAL_MACHINE\  SYSTEM\CurrentControlSet\Control\StorageDevicePoli  cies\", "writeProtect", 1, Microsoft.Win32.RegistryValueKind.DWord)

    End Function

کد غیر فعال کردن :

Public Function Unlock_USB()

        My.Computer.Registry.LocalMachine.DeleteSubKey("SY  STEM\CurrentControlSet\Control\StorageDevicePolici  es")

    End Function

امیدوارم حالشو ببرید ...............

مبحث داره میره توی ترفند های رجیستری

این تغییر تو رجیستری خوبه.
ولی وقتی فلش برای بار اول به سیستم وصل میشه جواب نمیده.

[Netsky]

سلام .
اگه بعد از انجام تغییر توی ریجستری سیستم رو ریست کنید ، کاملا درست کار میکنه .
بای بای .............

[Netsky]

سلام به همه برنامه نویسای عزیز .

بازم اومدم با چندتا کد دیگه تا بتونم کمکی هرچند ناچیز کرده باشم .

خب بریم سراغ کدها :

1- اولی واسه بدست آوردن درایو ویندوز هستش :

   Public Function Windows_Drive()

          MsgBox(My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Volatile Environment", "HOMEDRIVE", 0), MsgBoxStyle.Information, "Windows Drive")  
End Function
  

2- کد دوم واسه بدست آوردن مسیر فولدر Application Data :

   Public Function AppData_Path()

          MsgBox(My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Volatile Environment", "APPDATA", 0), MsgBoxStyle.Information, "Application Data Folder")

  End Function

3- کد شماره 3 واستون مسیر فولدر یوزر برمیگردونه :

   Public Function UserFolder_Path()

  Dim win_drv As String

  win_drv = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Volatile Environment", "HOMEDRIVE", 0)

  MsgBox(win_drv + My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Volatile Environment", "HOMEPATH", 0), MsgBoxStyle.Information, "User Folder")

  End Function

امیدوارم استفاده کنید ...........

[Netsky]

سلام به همه .
تاسوعای حسینی رو خدمت همه شما دوستان تسلیت عرض می کنم .
یه کد دیگه واستون آماده کردم . خیلی از برنامه نویسا واسه اینکه تاریخ شمسی رو در برنامشون ایجاد کنند از کامپوننت های مختلف و زیادی استفاده میکنن ، در صورتی که در خود VB.Net میتونید خیلی راحت تاریخ میلادی رو به شمسی تبدیل کنید . بوسیله کد زیر میتونید این کار رو انجام بدید .

Public Function Shamsi_Date() As String

        Dim DT As Date = Date.Now

        Dim Year, Month, Day As String

        Dim Glob As New Globalization.PersianCalendar

        Year = Glob.GetYear(DT)

        Month = Glob.GetMonth(DT)

        Day = Glob.GetDayOfMonth(DT)

        Shamsi_Date = Year & "\" & Month & "\" & Day

        MsgBox(Shamsi_Date)

    End Function

امیدوارم استفاده کنید .......................

[Netsky]

سلام به همه دوستان برنامه نویس .
یه کد دیگه واستون نوشتم . با این کد میتونید برنامه رو با 5 بار اجرا از کار بندازید .
نکته : این کد رو باید در رویداد Form_Load کپی کنید .

Dim verify

        verify = GetSetting(Application.CompanyName, "ST", "ST")

        If verify = "" Then

            SaveSetting(Application.CompanyName, "ST", "ST", 5)

        Else

            If verify <= 0 Then

                MsgBox("The Beta Period is Over!!!", MsgBoxStyle.Critical, "Beta Period")

                End

            End If

            verify = Val(verify) - 1

            SaveSetting(Application.CompanyName, "ST", "ST", verify)

        End If

البته نکته ای که باید بگم ، این روش رو خیلی راحت میشه دور زد . کافیه کاربر یکم با ریجستری آشنا باشه .

[maminb]

البته نکته ای که باید بگم ، این روش رو خیلی راحت میشه دور زد . کافیه کاربر یکم با ریجستری آشنا باشه .

برای جلوگیری از دور زدن، میتونین مقادیر رو به صورت encrypt شده ذخیره کنید و بعدا استفاده کنید. یه شرط هم بذارین اگه کلید پاک شده بود کلا برنامه از کار بیفته.

نظرتون چیه؟

[Netsky]

برای جلوگیری از دور زدن، میتونین مقادیر رو به صورت encrypt شده ذخیره کنید و بعدا استفاده کنید. یه شرط هم بذارین اگه کلید پاک شده بود کلا برنامه از کار بیفته.

نظرتون چیه؟

سلام دوست عزیز .
نظر شما درسته . البته چون کد کوتاه بود نمیخواستم درگیر پیچیدگی های زیاد بشه .
انشالله گفته شما رو در یه سورس کد کامل عملی میکنم .
با تشکر از نظر شما ....................

[maminb]

سلام دوست عزیز .
نظر شما درسته . البته چون کد کوتاه بود نمیخواستم درگیر پیچیدگی های زیاد بشه .
انشالله گفته شما رو در یه سورس کد کامل عملی میکنم .
با تشکر از نظر شما ....................

موافقم. خیلی خوب میشه. پس منتظریم!!!

[Netsky]

سلام به همه دوستان عزیز .
عاشورای حسینی رو به تمامی هموطنان عزیز تسلیت عرض میکنم .
یه کد دیگه واستون آماده کردم .
با استفاده از این کد میتونید خیلی راحت صفحه Welcome Screen ویندوز رو تغییر بدید . فقط کافیه آدرس عکس رو بدید .

 Public Function Change_WelcomeScreen()

        'Change Welcome Screen.

        'Note : You Must Select Bitmap (BMP Format) File. 

        My.Computer.Registry.SetValue("HKEY_USERS\.DEFAULT  \Control Panel\Desktop\", "Wallpaper", "C:\Your_Image.bmp")

    End Function

امیدوارم از این کد استفاده لازم رو ببرید .

[Netsky]

Hi To All .
انگلیسی نوشتم که تنوع باشه .
خب با یه کد دیگه در خدمت شما هستیم . این کد میتونه سرویس پک ویندوز رو واستون پیدا کنه .

Public Function ServicePack()

        MsgBox(My.Computer.Registry.GetValue("HKEY_LOCAL_M  ACHINE\SOFTWARE\MICROSOFT\WINDOWS NT\CURRENTVERSION", "CSDVersion", 0))

    End Function

[Netsky]

سلام سلام سلام . امیدوارم حالتون خوب باشه .
یه کد باحال دیگه نوشتم که تقدیم میکنم . با این کد میتونید اطلاعات مربوط به CPU رو استخراج کنید .
اطلاعاتی از قبیل :
1- نام شرکت سازنده
2- مدل و قدرت CPU
3- نام CPU

Public Function GetInfo_CPU()

        Dim VendorIdentifier, Identifier, ProcessorName As String

        VendorIdentifier = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\  HARDWARE\DESCRIPTION\System\CentralProcessor\0", "VendorIdentifier", 0)

        Identifier = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\  HARDWARE\DESCRIPTION\System\CentralProcessor\0", "Identifier", 0)

        ProcessorName = My.Computer.Registry.GetValue("HKEY_LOCAL_MACHINE\  HARDWARE\DESCRIPTION\System\CentralProcessor\0", "ProcessorNameString", 0)

        MsgBox("Vendor : " & VendorIdentifier & vbCrLf & _

               "Model : " & Identifier & vbCrLf & _

               "Processor Name : " & Trim(ProcessorName))

    End Function

[Netsky]

HI To You
یک کد دیگه نوشتم تا بتونید باهاش مدل Hard Disk رو در بیارید .

Public Function HardDisk_Model()

        MsgBox(My.Computer.Registry.GetValue("HKEY_LOCAL_M  ACHINE\HARDWARE\DEVICEMAP\Scsi\Scsi Port 0\Scsi Bus 0\Target Id 0\Logical Unit Id 0", "Identifier", 0), MsgBoxStyle.Information, "Hard Disk Model")

    End Function

[Netsky]

خب . یک کد دیگه نوشتم که باهاش میتونید Task Manager رو غیر فعال کنید .
کد واسه غیر فعال کردن :

Public Function Disable_TakManager()

        My.Computer.Registry.SetValue("HKEY_CURRENT_USER\S  oftware\Microsoft\Windows\CurrentVersion\Policies\  System", "DisableTaskMgr", 1, Microsoft.Win32.RegistryValueKind.DWord)

    End Function

این کد هم واسه فعال کردنه :

Public Function Enable_TaskManager()

        My.Computer.Registry.CurrentUser.DeleteSubKey("Sof  tware\Microsoft\Windows\CurrentVersion\Policies\Sy  stem")

    End Function

[shask00l]

یه کرونو متر ساده با استفاده از کلاس datetime , timespan ... برای مبتدی ها چیز خوبیه

[Netsky]

ciao
یکم از این تایپک برنامه VB توی بخش ویژوال بیسیک یاد بگیرید . چقدر کاربرای فعالی داره !!!!
بخش VB.Net هم که چی بگم ..............
خب گذشته از این حرفا بریم سراغ کد بعدی .
با این کد یه سری اطلاعات کلی رو در مورد بایوس بگیرید .
اطلاعاتی از قبیل :
1- ورژن بایوس
2- شماره ساخت
3- Caption
4- کد شناسه
5- کارخانه سازنده
6- نام بایوس
7- شماره سریال
نکته : ابتدا باید رفرنس System.Managment رو اضافه کنید .

Public Function GetInfo_BIOS()

        Dim Bios_ID As String

        Dim BiosClass As New Management.ManagementClass("Win32_BIOS")

        Dim Bioss As Management.ManagementObjectCollection = BiosClass.GetInstances()

        Dim BiossEnumerator As _

        Management.ManagementObjectCollection.ManagementOb  jectEnumerator = _

        Bioss.GetEnumerator()

        Bios_ID = "1"

        While BiossEnumerator.MoveNext()

            Dim Bios As Management.ManagementObject = _

            CType(BiossEnumerator.Current, Management.ManagementObject)

            '   Bios_ID = Bios("BiosCharacteristics")



            Bios_ID = Join(Bios("BIOSVersion"))

            Bios_ID &= Bios("BuildNumber")

            Bios_ID &= Bios("Caption")

            Bios_ID &= Bios("IdentificationCode")

            Bios_ID &= Bios("Manufacturer")

            Bios_ID &= Bios("Name")

            Bios_ID &= Bios("SerialNumber")



        End While

        MessageBox.Show(Bios_ID, "", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)

    End Function

[Netsky]

سلامی گرم در این فصل سرد .

امیدوارم حال خودتون و CPU تون خوب باشه .

راستی گفتم CPU ، خب امروز هم یک سری کد باحال در مورد CPU دارم .

خب کد اول :

این کد معماری پردازنده رو برمیگردونه .

مثلا x86 - MIPS - Alpha - Intel Itanuim Processor - PowePC - x64 :

نکته : باید رفرنس System.Management رو اضافه کنید .

البته همه شما که استادید ولی یه توضیح در مورد اضافه کردن رفرنس ها میدم ( شاید یکی تازه کار باشه ).

خب شما اگه بخاید یه رفرنس رو اضافه کنید باید در محیط ویژوال استدیو اینطوری عمل کنید :

به منوی Project برید و گزینه Add Reference رو بزنید . حالا در کادری که واستون باز میشه میتونید رفرنس دلخواه خودتون رو اضافه کنید. از داخل لیست گزینه System.Management رو اضافه کنید .

اگه هم سوالی داشتید من دربست در خدمتم .

خب کد زیر هم منتظر شماست .

Dim Architecture As String

        Dim mgmt As Management.ManagementClass = New Management.ManagementClass("Win32_Processor")

        Dim objcol As Management.ManagementObjectCollection = mgmt.GetInstances()

        For Each obj As Management.ManagementObject In objcol

            If Architecture = String.Empty Then

                Architecture = obj.Properties("Architecture").Value.ToString

            End If

        Next

        Select Case Architecture

            Case "0"

                MsgBox("x86")

            Case "1"

                MsgBox("MIPS")

            Case "2"

                MsgBox("Alpha")

            Case "3"

                MsgBox("PowerPC")

            Case "6"

                MsgBox("Intel Itanuim Processor Family")

            Case "9"

                MsgBox("x64")

        End Select

[Netsky]

کد دوم :
بوسیله کد زیر میتونید بفهمید سیستمی که برنامه داره روش اجرا میشه چند بیتی هستش . 32 یا 64 .

Dim AdrsWidth As String

        Dim mgmt As Management.ManagementClass = New Management.ManagementClass("Win32_Processor")

        Dim objcol As Management.ManagementObjectCollection = mgmt.GetInstances()

        For Each obj As Management.ManagementObject In objcol

            If AdrsWidth = String.Empty Then

                AdrsWidth = obj.Properties("AddressWidth").Value.ToString

            End If

        Next

        Select Case AdrsWidth

            Case "32"

                MsgBox("32-Bit")

            Case "64"

                MsgBox("64-Bit")

        End Select

[Netsky]

سومین کد :

خب با این کد هم میتونید وضعیت CPU رو بدست بیارید .

وضعیت های CPU عبارتند از :

1- Unknow : شناخته نشده .

2- CPU Enabled : سی پی یو فعال است .

3- CPU Disabled By User Via BIOS Setup: سی پی یو بوسیله کاربر از طریق بایوس غیر فعال شده است .

4- CPU Disabled By BIOS (POST Error): سی پی یو بوسیله بایوس غیر فعال شده است ( خطای روال POST ) .

5- CPU Is Idle : سی پی یو در حالت بیکاری است .

6- Reserved : رزرو شده .

7- Other : دیگر حالات

Dim CPUStatus As String

        Dim mgmt As Management.ManagementClass = New Management.ManagementClass("Win32_Processor")

        Dim objcol As Management.ManagementObjectCollection = mgmt.GetInstances()

        For Each obj As Management.ManagementObject In objcol

            If CPUStatus = String.Empty Then

                CPUStatus = obj.Properties("CPUStatus").Value.ToString

            End If

        Next

        Select Case CPUStatus

            Case "0"

                MsgBox("Unknow")

            Case "1"

                MsgBox("CPU Enabled")

            Case "2"

                MsgBox("CPU Disabled by User via BIOS Setup")

            Case "3"

                MsgBox("CPU Disabled by BIOS (POST Error)")

            Case "4"

                MsgBox("CPU Is Idle")

            Case "5"

                MsgBox("Reserved")

            Case "6"

                MsgBox("Reserved")

            Case "7"

                MsgBox("Other")

        End Select

[Netsky]

سلامی به گرمی وجودتان .

خب دوستان عزیز چندتا کد دیگه دارم در رابطه با سخت افزار و این بار HARD DISK !!!

حدودا یه 10 تایی کد هست که در 10 پست تقدیمتون میشه .

خب ، بوسیله کد اول میتونید بفهمید که نحوه اتصال هارددیسک از چه نوعیه .

Dim HDD_Connection As String

        Dim mgmt As Management.ManagementClass = New Management.ManagementClass("Win32_DiskDrive")

        Dim objcol As Management.ManagementObjectCollection = mgmt.GetInstances()

        For Each obj As Management.ManagementObject In objcol

            If HDD_Connection = String.Empty Then

                HDD_Connection = obj.Properties("InterfaceType").Value.ToString

            End If

        Next

        MsgBox(HDD_Connection, MsgBoxStyle.Information, "Hard Disk Connection")

[Netsky]

کد دوم :

این کد هم بهتون کمک میکنه تا متوجه بشید که هارد سیستمتون از چه نوعیه .

ثابت یا قابل حمل .

Dim HDD_Type As String

        Dim mgmt As Management.ManagementClass = New Management.ManagementClass("Win32_DiskDrive")

        Dim objcol As Management.ManagementObjectCollection = mgmt.GetInstances()

        For Each obj As Management.ManagementObject In objcol

            If HDD_Type = String.Empty Then

                HDD_Type = obj.Properties("MediaType").Value.ToString

            End If

        Next

        MsgBox(HDD_Type, MsgBoxStyle.Information, "Hard Disk Type")

[Netsky]

کد سوم :

این کد تعداد پارتیشن های هارددیسکتون رو بر میگردونه . مثلا 6

Dim HDD_Partitions As String

        Dim mgmt As Management.ManagementClass = New Management.ManagementClass("Win32_DiskDrive")

        Dim objcol As Management.ManagementObjectCollection = mgmt.GetInstances()

        For Each obj As Management.ManagementObject In objcol

            If HDD_Partitions = String.Empty Then

                HDD_Partitions = obj.Properties("Partitions").Value.ToString

            End If

        Next

        MsgBox(HDD_Partitions, MsgBoxStyle.Information, "Hard Disk Partitions Number")

[Netsky]

کد پنجم :

خب ، این کد میتونه خیلی بهتون کمک کنه . بدون هیچ گونه دردسری میتونید میزان فضای کلی هارددیسک رو محاسبه کنید .

Dim HDD_Size As String

        Dim mgmt As Management.ManagementClass = New Management.ManagementClass("Win32_DiskDrive")

        Dim objcol As Management.ManagementObjectCollection = mgmt.GetInstances()

        For Each obj As Management.ManagementObject In objcol

            If HDD_Size = String.Empty Then

                HDD_Size = obj.Properties("Size").Value.ToString

            End If

        Next

        MsgBox(Math.Round(HDD_Size / 1073741724) & " GB", MsgBoxStyle.Information, "Hard Disk Total Size")