网卡物理ID（但在多网卡的情况下不能识别）：
Option Explicit
'***********************#######################nic mac

Private Const NCBASTAT = &H33
Private Const NCBNAMSZ = 16
Private Const HEAP_ZERO_MEMORY = &H8
Private Const HEAP_GENERATE_EXCEPTIONS = &H4
Private Const NCBRESET = &H32

Private Type NCB
ncb_command As Byte 'Integer
ncb_retcode As Byte 'Integer
ncb_lsn As Byte 'Integer
ncb_num As Byte ' Integer
ncb_buffer As Long 'String
ncb_length As Integer
ncb_callname As String * NCBNAMSZ
ncb_name As String * NCBNAMSZ
ncb_rto As Byte 'Integer
ncb_sto As Byte ' Integer
ncb_post As Long
ncb_lana_num As Byte 'Integer
ncb_cmd_cplt As Byte 'Integer
ncb_reserve(9) As Byte ' Reserved, must be 0
ncb_event As Long
End Type

Private Type ADAPTER_STATUS
adapter_address(5) As Byte 'As String * 6
rev_major As Byte 'Integer
reserved0 As Byte 'Integer
adapter_type As Byte 'Integer
rev_minor As Byte 'Integer
duration As Integer
frmr_recv As Integer
frmr_xmit As Integer
iframe_recv_err As Integer
xmit_aborts As Integer
xmit_success As Long
recv_success As Long
iframe_xmit_err As Integer
recv_buff_unavail As Integer
t1_timeouts As Integer
ti_timeouts As Integer
Reserved1 As Long
free_ncbs As Integer
max_cfg_ncbs As Integer
max_ncbs As Integer
xmit_buf_unavail As Integer
max_dgram_size As Integer
pending_sess As Integer
max_cfg_sess As Integer
max_sess As Integer
max_sess_pkt_size As Integer
name_count As Integer
End Type

Private Type NAME_BUFFER
name As String * NCBNAMSZ
name_num As Integer
name_flags As Integer
End Type

Private Type ASTAT
adapt As ADAPTER_STATUS
NameBuff(30) As NAME_BUFFER
End Type

Private Declare Function Netbios Lib "Netapi32.dll" (pncb As NCB) As Byte
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long



Private Function NicAddress(LanaNumber As Long) As String '***********************#######################nic mac add 方法（只能在单一网卡的情况下识别正确）
Dim udtNCB As NCB
Dim bytResponse As Byte
Dim udtASTAT As ASTAT
Dim udtTempASTAT As ASTAT
Dim lngASTAT As Long
Dim strOut As String
Dim X As Integer
udtNCB.ncb_command = NCBRESET
bytResponse = Netbios(udtNCB)
udtNCB.ncb_command = NCBASTAT
udtNCB.ncb_lana_num = LanaNumber
udtNCB.ncb_callname = "* "
udtNCB.ncb_length = Len(udtASTAT)
lngASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length)
strOut = ""
If lngASTAT Then
udtNCB.ncb_buffer = lngASTAT
bytResponse = Netbios(udtNCB)
CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
With udtASTAT.adapt
For X = 0 To 5
strOut = strOut & Right$("00" & Hex$(.adapter_address(X)), 2)
Next X
End With
HeapFree GetProcessHeap(), 0, lngASTAT
End If
NicAddress = strOut
End Function


msgbox nicaddress(0)

Private Const MAX_IDE_DRIVES As Long = 4 ' Max number of drives assuming primary/secondary, master/slave topology
Private Const IDENTIFY_BUFFER_SIZE As Long = 512
Private Const DFP_SEND_DRIVE_COMMAND As Long = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA As Long = &H7C088

Private Type GETVERSIONOUTPARAMS
bVersion As Byte ' Binary driver version.
bRevision As Byte ' Binary driver revision.
bReserved As Byte ' Not used.
bIDEDeviceMap As Byte ' Bit map of IDE devices.
fCapabilities As Long ' Bit mask of driver capabilities.
dwReserved(3) As Long ' For future use.
End Type
Private Type IDEREGS
bFeaturesReg As Byte ' Used for specifying SMART "commands".
bSectorCountReg As Byte ' IDE sector count register
bSectorNumberReg As Byte ' IDE sector number register
bCylLowReg As Byte ' IDE low order cylinder value
bCylHighReg As Byte ' IDE high order cylinder value
bDriveHeadReg As Byte ' IDE drive/head register
bCommandReg As Byte ' Actual IDE command.
End Type

Private Type SENDCMDINPARAMS
cBufferSize As Long ' Buffer size in bytes
irDriveRegs As IDEREGS ' Structure with drive register values.
bDriveNumber As Byte ' Physical drive number to send
bReserved(2) As Byte ' Reserved for future expansion.
dwReserved(3) As Long ' For future use.
bBuffer(0) As Byte ' Input buffer.
End Type
Private Const IDE_ATAPI_ID As Long = &HA1 ' Returns ID sector for ATAPI.
Private Const IDE_ID_FUNCTION As Long = &HEC ' Returns ID sector for ATA.
Private Const IDE_EXECUTE_SMART_FUNCTION As Long = &HB0 ' Performs SMART cmd.
Private Type DRIVERSTATUS
bReserved(1) As Byte ' Reserved for future expansion.
dwReserved(1) As Long ' Reserved for future expansion.
End Type

Private Type SENDCMDOUTPARAMS
cBufferSize As Long ' Size of bBuffer in bytes
drvStatus As DRIVERSTATUS ' Driver status structure.
bBuffer(0) As Byte ' Buffer of arbitrary length in which to store the data read from the ' drive.
End Type


Private Type ATTRTHRESHOLD
bAttrID As Byte ' Identifies which attribute
bWarrantyThreshold As Byte ' Triggering value
bReserved(9) As Byte ' ...
End Type

Private Type IDSECTOR
wGenConfig As Integer
wNumCyls As Integer
wReserved As Integer
wNumHeads As Integer
wBytesPerTrack As Integer
wBytesPerSector As Integer
wSectorsPerTrack As Integer
wVendorUnique(2) As Integer
sSerialNumber(19) As Byte
wBufferType As Integer
sFirmwareRev(7) As Byte
sModelNumber(39) As Byte
End Type




Private Const VER_PLATFORM_WIN32s As Long = 0
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Declare Function GetVersionEx Lib "KERNEL32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const OPEN_EXISTING As Long = 3
Private Declare Function CreateFile Lib "KERNEL32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "KERNEL32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long

Private m_DiskInfo As IDSECTOR

Private Function OpenSMART(ByVal nDrive As Byte) As Long

Dim hSMARTIOCTL As Long
Dim hd As String
Dim VersionInfo As OSVERSIONINFO

VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
GetVersionEx VersionInfo
Select Case VersionInfo.dwPlatformId
Case VER_PLATFORM_WIN32s
OpenSMART = hSMARTIOCTL
Case VER_PLATFORM_WIN32_WINDOWS
hSMARTIOCTL = CreateFile("\\.\SMARTVSD", 0, 0, 0, CREATE_NEW, 0, 0)
Case VER_PLATFORM_WIN32_NT
If nDrive < MAX_IDE_DRIVES Then
hd = "\\.\PhysicalDrive" & nDrive
hSMARTIOCTL = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
End If
End Select
OpenSMART = hSMARTIOCTL

End Function

Private Function DoIDENTIFY(ByVal hSMARTIOCTL As Long, pSCIP As SENDCMDINPARAMS, pSCOP() As Byte, ByVal bIDCmd As Byte, ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean


pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)
'
pSCIP.irDriveRegs.bCommandReg = bIDCmd
pSCIP.bDriveNumber = bDriveNum
DoIDENTIFY = CBool(DeviceIoControl(hSMARTIOCTL, DFP_RECEIVE_DRIVE_DATA, _
pSCIP, 32, _
pSCOP(0), 528, _
lpcbBytesReturned, 0))

End Function


Public Function GetDiskInfo(ByVal nDrive As Byte) As Long

Dim hSMARTIOCTL As Long
Dim cbBytesReturned As Long
Dim VersionParams As GETVERSIONOUTPARAMS
Dim scip As SENDCMDINPARAMS
Dim scop() As Byte
Dim OutCmd As SENDCMDOUTPARAMS
Dim bDfpDriveMap As Byte
Dim bIDCmd As Byte ' IDE or ATAPI IDENTIFY cmd
Dim uDisk As IDSECTOR

m_DiskInfo = uDisk
hSMARTIOCTL = OpenSMART(nDrive)
If hSMARTIOCTL <> INVALID_HANDLE_VALUE Then

Call DeviceIoControl(hSMARTIOCTL, DFP_GET_VERSION, ByVal 0, 0, VersionParams, Len(VersionParams), cbBytesReturned, 0)

bIDCmd = IIf((VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10), IDE_ATAPI_ID, IDE_ID_FUNCTION)

ReDim scop(LenB(OutCmd) + IDENTIFY_BUFFER_SIZE - 1) As Byte
If DoIDENTIFY(hSMARTIOCTL, scip, scop, bIDCmd, nDrive, cbBytesReturned) Then
CopyMemory m_DiskInfo, scop(LenB(OutCmd) - 4), LenB(m_DiskInfo)
CloseHandle hSMARTIOCTL
GetDiskInfo = 1
Exit Function '>---> Bottom
End If
CloseHandle hSMARTIOCTL
GetDiskInfo = 0
End If

End Function

Private Sub Command1_Click()
If GetDiskInfo(0) = 1 Then
pSerialNumber = StrConv(m_DiskInfo.sSerialNumber, vbUnicode)
MsgBox "硬盘物理系列号" & pSerialNumber
pModelNumber = StrConv(m_DiskInfo.sModelNumber, vbUnicode)
MsgBox "硬盘型号" & pModelNumber
End If
End Sub