Hddsn - DotFix - Портал разработки и защиты программ

Автор: vbcode. Дата публикации: 04.08.2004

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

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

ВАРИАНТ 1

CODE NOW!

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

CODE NOW!

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

Комментарии

отсутствуют

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

:: Последние обновления ::

04.09.2011 Долгожданный релиз VB Decompiler. Масса улучшений декомпиляции Native Code. Значительно расширенна и обновлена справочная система на русском и английском языках.

20.12.2010 DotFix Software поздравляет наших клиентов и посетителей сайта с наступающим Новым Годом и рождеством! Желаем приятно провести праздники и успехов в новом году!

28.11.2010 Выпущена новая версия защиты DotFix NiceProtect. Основные изменения коснулись обфускатора Delphi программ. Теперь имеется полная поддержка Tab и Page контролов на формах, что обеспечивает максимальную совместимость обфускации с Delphi XE программами.

21.10.2010 Обновлен декомпилятор Visual Basic программ до версии 8.1. Декомпиляция P-Code программ становится все более идеальной, также проделана большая работа по улучшению анализа Native Code и .NET приложений.

16.09.2009 Полностью обновлен движок сайта! Теперь все ссылки имеют читаемый понятный вид, разного рода глюки на страницах убраны. И теперь сайт полноценно работает на второй версии нашего движка.

Архив новостей

Движок сайта: DotFix Engine v0.2
Администрация сайта: