vb代码:获取网卡实际MAC
发布时间:2020-12-17 08:21:00 所属栏目:百科 来源:网络整理
导读:Option ExplicitDim ID() As VariantPrivate Const GENERIC_READ = H80000000Private Const GENERIC_WRITE = H40000000Private Const FILE_SHARE_READ = H1Private Const FILE_SHARE_WRITE = H2Private Const OPEN_EXISTING = 3Private Const OID_802_3_PERM
Option Explicit Dim ID() As Variant Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const FILE_SHARE_READ = &H1 Private Const FILE_SHARE_WRITE = &H2 Private Const OPEN_EXISTING = 3 Private Const OID_802_3_PERMANENT_ADDRESS = &H1010101 Private Const OID_802_3_CURRENT_ADDRESS = &H1010102 Private Const IOCTL_NDIS_QUERY_GLOBAL_STATS = &H170002 Private Const ERROR_BUFFER_OVERFLOW = 111 Private Const MAX_ADAPTER_NAME_LENGTH As Long = 260 Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 132 Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8 Private Const MIB_IF_TYPE_ETHERNET = 6 Private Type IP_ADDR_STRING Next As Long IpAddress As String * 16 IpMask As String * 16 Context As Long End Type Private Type IP_ADAPTER_INFO Next As Long ComboIndex As Long AdapterName As String * MAX_ADAPTER_NAME_LENGTH Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH AddressLength As Long Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte Index As Long Type As Long DhcpEnabled As Long CurrentIpAddress As Long IpAddressList As IP_ADDR_STRING GatewayList As IP_ADDR_STRING DhcpServer As IP_ADDR_STRING HaveWins As Boolean PrimaryWinsServer As IP_ADDR_STRING SecondaryWinsServer As IP_ADDR_STRING LeaSEObtained As Long LeaseExpires As Long End Type Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" (pTcpTable As Any,pdwSize As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dst As Any,src As Any,ByVal bcount As Long) 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,Optional ByVal lpOverlapped As Long = 0) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Function GetTrueMac(ByVal NetId As String,ByRef WorkMac As String,ByRef TrueMac As String) As Long Dim J As Long Dim hDev As Long Dim InBuf As Long Dim OutBuf(256) As Byte Dim BytesReturned As Long Dim s As String hDev = CreateFile("." & NetId,GENERIC_READ Or GENERIC_WRITE,FILE_SHARE_READ Or FILE_SHARE_WRITE,ByVal 0,OPEN_EXISTING,0) InBuf = OID_802_3_PERMANENT_ADDRESS If (DeviceIoControl(hDev,IOCTL_NDIS_QUERY_GLOBAL_STATS,InBuf,4,ByVal VarPtr(OutBuf(0)),256,BytesReturned,ByVal 0)) Then For J = 0 To BytesReturned - 1 s = Hex(Val(OutBuf(J))) If J = 0 Then TrueMac = IIf(Len(s) = 1,"0" & s,s) Else TrueMac = TrueMac & "-" & IIf(Len(s) = 1,s) End If Next End If ' Debug.Print TrueMac InBuf = OID_802_3_CURRENT_ADDRESS If (DeviceIoControl(hDev,ByVal 0)) Then For J = 0 To BytesReturned - 1 s = Hex(Val(OutBuf(J))) If J = 0 Then WorkMac = IIf(Len(s) = 1,s) Else WorkMac = WorkMac & "-" & IIf(Len(s) = 1,s) End If Next End If ' Debug.Print WorkMac Error1: CloseHandle hDev End Function Function GetNetId(ByRef NetId() As Variant) As Long Dim AdapterInfo As IP_ADAPTER_INFO Dim AdapterInfoSize As Long Dim AdapterInfoBuffer() As Byte Dim i As Long Dim J As Long Dim Error As Long Dim Padapt As Long Dim MacAddr2 As IP_ADAPTER_INFO AdapterInfoSize = 0 Error = GetAdaptersInfo(ByVal 0&,AdapterInfoSize) If Error <> 0 Then If Error <> ERROR_BUFFER_OVERFLOW Then Exit Function End If End If ReDim AdapterInfoBuffer(AdapterInfoSize - 1) Error = GetAdaptersInfo(AdapterInfoBuffer(0),AdapterInfoSize) If Error <> 0 Then Exit Function End If CopyMemory AdapterInfo,AdapterInfoBuffer(0),Len(AdapterInfo) Padapt = AdapterInfo.Next Do While Padapt <> 0 CopyMemory MacAddr2,AdapterInfo,Len(MacAddr2) Select Case MacAddr2.Type Case MIB_IF_TYPE_ETHERNET ReDim Preserve NetId(i) NetId(i) = MacAddr2.AdapterName i = i + 1 End Select Padapt = MacAddr2.Next If Padapt <> 0 Then CopyMemory AdapterInfo,ByVal Padapt,Len(AdapterInfo) End If Loop GetNetId = i End Function Private Sub Form_Click() ReDim Preserve ID(GetNetId(ID)) Dim Wk As String,TK As String Dim i As Byte Cls Print "WorkMAC","TrueMAC" For i = 0 To UBound(ID) - 1 ID(i) = Left(ID(i),InStr(ID(i),Chr(0)) - 1) Call GetTrueMac(ID(i),Wk,TK) Print Wk,TK Next End Sub (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |