学步园

 Option   Explicit  
   
  Private   Const   NCBASTAT   As   Long   =   &H33  
  Private   Const   NCBNAMSZ   As   Long   =   16  
  Private   Const   HEAP_ZERO_MEMORY   As   Long   =   &H8  
  Private   Const   HEAP_GENERATE_EXCEPTIONS   As   Long   =   &H4  
  Private   Const   NCBRESET   As   Long   =   &H32  
  Private   Const   NCBENUM   As   Long   =   &H37  
  Private   Const   MAX_LANA   As   Long   =   254  
   
  Type   LANA_ENUM  
          Length   As   Byte  
          Lana(MAX_LANA)   As   Byte  
  End   Type  
   
  Private   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   Type  
   
  Private   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   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   NET_CONTROL_BLOCK)   As   Byte  
                 
  Private   Declare   Sub   CopyMemory   Lib   "kernel32"   Alias   "RtlMoveMemory"   (hpvDest   As   Any,   ByVal   hpvSource   As   Long,   ByVal   cbCopy   As   Long)  
  'Private   Declare   Sub   CopyMemory   Lib   "kernel32"   Alias   "RtlMoveMemory"   _  
                  (hpvDest   As   Any,   hpvSource   As   Any,   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  
   
   
   
  'MsgBox   GetMACAddressa  
  Sub   Main()  
             
  '       Dim   网卡对象   As   Object  
  '       Dim   网卡子对象   As   Object  
  '       Set   网卡对象   =   GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_NetworkAdapter")  
  '       For   Each   网卡子对象   In   网卡对象  
  '               Debug.Print   网卡子对象.name  
  '               'Call   ddd(网卡子对象.Index)  
  '       Next  
           
  'Call   disp(0)  
     
        Dim   Lana   As   LANA_ENUM  
        Dim   NCB   As   NET_CONTROL_BLOCK  
        Dim   i   As   Integer  
        Dim   pASTAT   As   Long  
         
        'CopyMemory   &O0,   Lana,   Len(Lana)  
        NCB.ncb_buffer   =   VarPtr(Lana)  
        NCB.ncb_length   =   Len(Lana)  
        NCB.ncb_command   =   NCBENUM  
        pASTAT   =   Netbios(NCB)  
        For   i   =   0   To   Lana.Length   -   1  
                  MsgBox   Lana.Lana(i),   ,   "号"  
                  Call   disp(Lana.Lana(i))  
        Next  
  End   Sub  
   
  Private   Function   disp(ByVal   num   As   Long)  
        Dim   tmp   As   String  
        Dim   pASTAT   As   Long  
        Dim   LngBuff   As   Long  
        Dim   NCB   As   NET_CONTROL_BLOCK  
        Dim   AST   As   ASTAT  
  '       Dim   lanaenum   As   LANA_ENUM  
         
  '       NCB.ncb_command   =   NCBENUM  
  '       NCB.ncb_buffer   =   LngBuff  
  '       NCB.ncb_length   =   Len(lanaenum)  
  '       pASTAT   =   Netbios(NCB)  
  '       If   pASTAT   =   0   Then   MsgBox   "err":   Exit   Sub  
         
        NCB.ncb_command   =   NCBRESET  
        NCB.ncb_lana_num   =   num  
        Call   Netbios(NCB)  
        NCB.ncb_callname   =   "*"  
        NCB.ncb_command   =   NCBASTAT  
        NCB.ncb_lana_num   =   num  
        NCB.ncb_length   =   Len(AST)  
             
        pASTAT   =   HeapAlloc(GetProcessHeap(),   HEAP_GENERATE_EXCEPTIONS   Or   HEAP_ZERO_MEMORY,   NCB.ncb_length)  
                               
        If   pASTAT   =   0   Then  
              MsgBox   "在读取网络配置信息时内存分配错误!"  
              Exit   Function  
        End   If  
             
        NCB.ncb_buffer   =   pASTAT  
        Call   Netbios(NCB)  
             
        CopyMemory   AST,   NCB.ncb_buffer,   Len(AST)  
             
        tmp   =   Hex(AST.adapt.adapter_address(0))   &   Hex(AST.adapt.adapter_address(1))   &   Hex(AST.adapt.adapter_address(2))   &   _  
        Hex(AST.adapt.adapter_address(3))   &   Hex(AST.adapt.adapter_address(4))   &   Hex(AST.adapt.adapter_address(5))  
                                 
        HeapFree   GetProcessHeap(),   0,   pASTAT  
        MsgBox   tmp  
  End   Function