Как определить серийный номер для диска

Private Declare Function GetVolumeSerialNumber 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 Function VolumeSerialNumber(ByVal RootPath As String) As String Dim VolLabel As String Dim VolSize As Long Dim Serial As Long Dim MaxLen As Long Dim Flags As Long Dim Name As String Dim NameSize As Long Dim s As String Dim ret as Boolean ret=GetVolumeSerialNumber(RootPath, VolLabel, VolSize, _ Serial, MaxLen, Flags, Name, NameSize) If ret Then ’Create an 8 character string s = Format(Hex(Serial), "00000000") ’Adds the ’-’ between the first 4 characters and the last 4 characters VolumeSerialNumber = Left(s, 4) + "-" + Right(s, 4) Else ’If the call to API function fails the function returns a zero serial number VolumeSerialNumber = "0000-0000" End If End Function Private Sub Command1_Click() MsgBox VolumeSerialNumber("C:\") ’Shows the serial number of your Hard Disk End Sub

Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long Function GetSerialNumber(DriveLetter As String) As String Dim SerialNum As Long Dim VolNameBuf As String Dim FileSysNameBuf As String Select Case Len(DriveLetter) Case 1 If LCase(DriveLetter) Like "[a-z]" Then DriveLetter = Left(DriveLetter, 1) & ":\" Else GetSerialNumber = "Error - Bad drive designation" End If Case 2 If LCase(DriveLetter) Like "[a-z]:" Then DriveLetter = DriveLetter & "\" Else GetSerialNumber = "Error - Bad drive designation" End If Case 3 If LCase(DriveLetter) Like "[!a-z]:\" Then GetSerialNumber = "Error - Bad drive designation" End If Case Else GetSerialNumber = "Error - Bad drive designation" End Select If Len(GetSerialNumber) = 0 Then VolNameBuf = String(255, Chr(0)) FileSysNameBuf = String(255, Chr$(0)) GetVolumeInformation DriveLetter, VolNameBuf, Len(VolNameBuf), SerialNum, 0, 0, FileSysNameBuf, Len(FileSysNameBuf) GetSerialNumber = Right("00000000" & Hex(SerialNum), 8) End If End Function Private Sub Command1_Click() MsgBox GetSerialNumber("C:") End Sub