如题!

解决方案 »

  1.   

    Public Const NCBASTAT As Long = &H33
    Public Const NCBNAMSZ As Long = 16 'Lunghezza massima del NomeHost: ?da protocollo NetBios, non cambiare!
    Public Const HEAP_ZERO_MEMORY As Long = &H8
    Public Const HEAP_GENERATE_EXCEPTIONS As Long = &H4
    Public Const NCBRESET As Long = &H32Public Type NET_CONTROL_BLOCK
       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   As String * NCBNAMSZ
       ncb_name       As String * NCBNAMSZ
       ncb_rto        As Byte
       ncb_sto        As Byte
       ncb_post       As Long
       ncb_lana_num   As Byte
       ncb_cmd_cplt   As Byte
       ncb_reserve(9) As Byte
       ncb_event      As Long
    End TypePublic Type ADAPTER_STATUS
       adapter_address(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 TypePublic Type NAME_BUFFER
       name        As String * NCBNAMSZ
       name_num    As Integer
       name_flags  As Integer
    End TypePublic Type ASTAT
       adapt          As ADAPTER_STATUS
       NameBuff(30)   As NAME_BUFFER
    End TypePublic Declare Function Netbios Lib "netapi32.dll" (pncb As NET_CONTROL_BLOCK) As BytePublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)Public Declare Function GetProcessHeap Lib "kernel32" () As LongPublic Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As LongPublic Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
    Public Function DaiMACAddress(ByVal NomeHost As String) As String
        On Error Resume Next
        Dim Tmp As String, pASTAT As Long
        Dim NCB As NET_CONTROL_BLOCK, AST As ASTAT
        Dim NomeGiusto As Boolean
        
        NCB.ncb_command = NCBRESET   'resetta la mia Interfaccia
        Call Netbios(NCB)
        
        'La lunghezza massima del Nome host ?16 caratteri
        
        NCB.ncb_callname = NomeHost  'setta l'host remoto di cui si vuol
        NCB.ncb_command = NCBASTAT   'conoscere il MAC e richiede le info
        
        
        NCB.ncb_lana_num = 0         'forza la lettura dei dati sull'interfaccia 0
        NCB.ncb_length = Len(AST)    'ALTRIMENTI SE SI HANNO + INTERFACCE BISOGNA
                                     'LEGGERE SU OGNUNA
        
        'gestisce l'Heap per l'allocazione dinamica della struttura NET_CONTROL_BLOCK
        
        pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, NCB.ncb_length)
        
        'controllo sul puntatore pASTAT
        
        If pASTAT = 0 Then
            Debug.Print "Errore nell'allocazione della Memoria"
            Exit Function
        End If
        
        'riempie i Dati nella struttura ASTAT
        
        NCB.ncb_buffer = pASTAT
        Call Netbios(NCB)
        
        CopyMemory AST, NCB.ncb_buffer, Len(AST)
        
        'controlla i dati ritornati e che hanno riempito la struttura ASTAT
        
        NomeGiusto = False
        For t = 0 To 5
            If AST.adapt.adapter_address(t) <> 0 Then
                NomeGiusto = True
                Exit For
            End If
        Next
        
        'se l'hosto non ?raggiungibile ritorna 0 in tutto l'array e NomeGiusto ?false
        
        If NomeGiusto = True Then
            Tmp = Format$(Hex(AST.adapt.adapter_address(0)), "00") & "-" & Format$(Hex(AST.adapt.adapter_address(1)), "00") & "-" & Format$(Hex(AST.adapt.adapter_address(2)), "00") & "-" & Format$(Hex(AST.adapt.adapter_address(3)), "00") & "-" & Format$(Hex(AST.adapt.adapter_address(4)), "00") & "-" & Format$(Hex(AST.adapt.adapter_address(5)), "00")
            HeapFree GetProcessHeap(), 0, pASTAT
            DaiMACAddress = Tmp
        Else
            DaiMACAddress = "-1"
        End If
    End Function'***************** ESEMPIO DI APPLICAZIONE ********************Private Sub Command1_Click()
        Screen.MousePointer = vbHourglass
        x = DaiMACAddress(UCase(Text1.Text))
        If x = "-1" Then x = "Host Inesistente"
        LblMAC = x
        LblMAC.Refresh
        Screen.MousePointer = vbNormal
    End Sub好像只能得到局域网得mac地址,internet应该不行.