Visual Basic, .NET, ASP, VBA, VBScript
 
  Библиотека кодов  
  Информация о компьютере  
     
  Как определить серийный номер для диска  
  Расположите на форме элемент 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
 
     
  VBNet online (всего: 52050)  
 

Логин:

Пароль:

Регистрация, забыли пароль?


В чате сейчас человек
 
     
  VBNet рекомендует  
   
     
  Лучшие материалы  
 
ActiveX контролы (112)
Hitman74_Library (36119)
WindowsXPControls (20739)
FlexGridPlus (19374)
DSMAniGifControl (18295)
FreeButton (15157)
Примеры кода (546)
Parol (18027)
Passworder (9299)
Screen saver (7654)
Kerish AI (5817)
Folder_L (5768)
Статьи по VB (136)
Мое второе впечатление... (11236)
VB .NET: дорога в будущее (11161)
Основы SQL (9225)
Сообщения Windows в Vi... (8788)
Классовая теория прогр... (8619)
 
     
Техническая поддержка MTW-хостинг | © Copyright 2002-2011 VBNet.RU | Пишите нам