Kod:
Option Compare Database
Option Explicit
Private Declare PtrSafe Function GetVolumeInformation 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 PtrSafe Function GetAdaptersInfo Lib "IPHLPAPI" _
(pAdapterInfo As Any, pBufLen As Long) As Long
Function GetHDDSerialNumber() As String
Dim serialNumber As Long
Dim volumeName As String * 255
Dim fileSystemName As String * 255
If GetVolumeInformation("C:\", volumeName, Len(volumeName), serialNumber, 0, 0, fileSystemName, Len(fileSystemName)) <> 0 Then
GetHDDSerialNumber = Hex(serialNumber)
Else
GetHDDSerialNumber = "N/A"
End If
End Function
Function GetMACAddress() As String
Dim adapterInfo As Any
Dim bufLen As Long
Dim macAddress As String
If GetAdaptersInfo(adapterInfo, bufLen) = 0 Then
macAddress = Right("00" & Hex(AscB(adapterInfo(4))), 2)
For i = 1 To 5
macAddress = macAddress & ":" & Right("00" & Hex(AscB(adapterInfo(i + 4))), 2)
Next i
GetMACAddress = UCase(macAddress)
Else
GetMACAddress = "N/A"
End If
End Function
Sub TestGetInfo()
MsgBox "HDD Serial Number: " & GetHDDSerialNumber() & vbCrLf & _
"MAC Address: " & GetMACAddress()
End Sub