|
Private Const NAME_FLAGS_MASK = &H87
Private Const GROUP_NAME = &H80 Private Const UNIQUE_NAME = &H0 Private Const REGISTERING = &H0 Private Const REGISTERED = &H4 Private Const DEREGISTERED = &H5 Private Const DUPLICATE = &H6 Private Const DUPLICATE_DEREG = &H7 Private Type NTWRKCNTRLBLCK ncb_command As Byte ncb_retcode As Byte ncb_lsn As Byte ncb_num As Byte ncb_buffer As Long ncb_length As Integer ncb_callname(0 To 15) As Byte ncb_name(0 To 15) As Byte ncb_rto As Byte ncb_sto As Byte lpFunc As Long ncb_lana_num As Byte ncb_cmd_cplt As Byte ncb_reserve(0 To 9) As Byte ncb_event As Long End Type Private Type LANA_ENUM length As Byte lana(0 To 256) As Byte End Type Private Type ADAPTER_STATUS adapter_address(0 To 5) As Byte rev_major As Byte reserved0 As Byte adapter_type As Byte rev_minor As Byte 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_(0 To 15) As Byte name_num As Byte name_flags As Byte End Type Private Type NET_STATUS Adapter As ADAPTER_STATUS NameBuffer(30) As NAME_BUFFER End Type Private Const NCBENUM = &H37 Private Const NCBRESET = &H32 Private Const NCBASTAT = &H33 Private Declare Function NetBios Lib "netapi32.dll" _ Alias "Netbios"(ByRef pncb As NTWRKCNTRLBLCK) As Byte Private Declare Function VarPtr Lib "MSVBVM50.DLL" _ (pVoid As Any) As Long Private Function GetMacAddr() As String Dim NCB As NTWRKCNTRLBLCK, Status As NET_STATUS, LanEnum As LANA_ENUM Dim bReturn As Byte, sMacAddress As String, i As Integer, sHex As String, l% Dim k%, iNumNames%, j%, m%, sName$, sBuff$, iPos%, nFlags% NCB.ncb_command = NCBENUM NCB.ncb_buffer = VarPtr(LanEnum) NCB.ncb_length = LenB(LanEnum) bReturn = NetBios(NCB) sBuff = "" l = LanEnum.length If l > 0 Then For k = 0 To l NCB.ncb_command = NCBRESET NCB.ncb_lana_num = LanEnum.lana(k) bReturn = NetBios(NCB) NCB.ncb_command = NCBASTAT NCB.ncb_lana_num = LanEnum.lana(k) 'Numero massimo di sessioni = 42 NCB.ncb_callname(0) = 42 For i = 1 To 14 'Numero massimo di sessioni = 32 NCB.ncb_callname(i) = 32 32, Use NAME_NUMBER_1 Next i NCB.ncb_callname(15) = 0 NCB.ncb_buffer = VarPtr(Status) NCB.ncb_length = LenB(Status) bReturn = NetBios(NCB) sBuff = sBuff & "Network #" & Hex$(k) & vbCrLf & Chr$(9) sMacAddress = "" For i = 0 To 5 sHex = Hex(Status.Adapter.adapter_address(i)) If Len(sHex) = 1 Then sHex = "0" & sHex sMacAddress = sMacAddress & sHex If i <> 5 Then sMacAddress = sMacAddress + "-" Next i sBuff = sBuff & "Mac Address = " & UCase(sMacAddress) & vbCrLf & Chr$(9) sBuff = sBuff & "Adapter Type = " & Hex$(Status.Adapter.adapter_type) & vbCrLf & Chr$(9) iNumNames = Status.Adapter.name_count sBuff = sBuff & "Name Count = " & Hex$(iNumNames) & vbCrLf & Chr$(9) If iNumNames > 0 Then For j = 0 To iNumNames - 1 sName = "" For m = 0 To 15 sName = sName & Chr$(Status.NameBuffer(j).name_(m)) Next m iPos = InStr(sName, Chr$(0)) If iPos Then sName = Left$(sName, iPos - 1) sName = Trim$(sName) nFlags = Status.NameBuffer(j).name_flags If (nFlags And GROUP_NAME) = GROUP_NAME Then sBuff = sBuff & "WorkGroup Name is #" & Hex$(j + 1) & " = " & sName & vbCrLf & Chr$(9) & Chr$(9) Else sBuff = sBuff & "Name #" & Hex$(j + 1) & " = " & sName & vbCrLf & Chr$(9) & Chr$(9) End If sBuff = sBuff & "Name Flags = " & Hex$(nFlags) & vbCrLf & Chr$(9) Next j Else sBuff = sBuff & "No Names" & vbCrLf & Chr$(9) End If sBuff = sBuff & vbCrLf Next k End If GetMacAddr = sBuff End Function Private Sub Command1_Click() Text1 = GetMacAddr() End Sub |