Современные решения

для защиты Windows приложений

и восстановления исходного кода
Автор: vbcode. Дата публикации: 04.08.2004

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


Расположите на форме элемент CommandButton

ВАРИАНТ 1

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

ВАРИАНТ 2

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


Комментарии

отсутствуют

Добавление комментария


Ваше имя (на форуме):

Ваш пароль (на форуме):

Комментарии могут добавлять только пользователи,
зарегистрированные на форуме данного сайта. Если Вы не
зарегистрированы, то сначала зарегистрируйтесь тут

Комментарий: