[fouadhdfouad]

كود :

Option Explicit

Private Declare Function GetVolumeInformationA Lib "kernel32" _
   Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
   ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
   lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
   lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
   ByVal nFileSystemNameSize As Long) As Long

Private Declare Function GetProcessorInfo Lib "kernel32" _
   Alias "GetSystemInfo" (lpSystemInfo As SYSTEM_INFO) As Long

Private Type SYSTEM_INFO
   dwOemID As Long
   dwPageSize As Long
   lpMinimumApplicationAddress As Long
   lpMaximumApplicationAddress As Long
   dwActiveProcessorMask As Long
   dwNumberOfProcessors As Long
   dwProcessorType As Long
   dwAllocationGranularity As Long
   dwReserved As Long
End Type

Private Sub Form_Load()
   Dim processorID As String
   processorID = GetProcessorID()
   MsgBox "Processor ID: " & processorID
End Sub

Private Function GetProcessorID() As String
   Dim sysInfo As SYSTEM_INFO
   Dim serialNum As Long
   Dim serialNumStr As String
   Dim volName As String
   Dim fileSysName As String
   Dim maxCompLen As Long
   Dim fileSysFlags As Long

   GetProcessorInfo sysInfo
   GetVolumeInformationA "C:\", volName, 255, serialNum, maxCompLen, _
       fileSysFlags, fileSysName, 255
   serialNumStr = Right("00000000" & Hex$(serialNum), 8)
   GetProcessorID = Mid(serialNumStr, 7, 2) & Mid(serialNumStr, 5, 2) & _
       Mid(serialNumStr, 3, 2) & Mid(serialNumStr, 1, 2)
End Function