VB编程-读取本地计算机IP地址及MAC地址

这是一个获取本机的IP的思路：  
  添加一个WINSOCK控件  
  在一个窗体上添加一个text 

   Private     Sub    Form_Load()     
      Text1.Text    =    Winsock1.LocalIP     
   End     Sub   
' 获取物理地址的代码：
Option     Explicit   
   
         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   
   
   Public     Function    GetMACAddress(sIP    As     String )    As     String   
           Dim    sRtn    As     String   
           Dim    myNcb    As    NCB  
           Dim    bRet    As     Byte   
           
           Dim    aIP()    As     String   
           Dim    X    As     Long   
           Dim    nIP    As     String   
           
           If     InStr (sIP,    " . " )    =     0     Then   
                GetMACAddress    =     " Invaild   IP   Address. "   
                 Exit     Function   
           End     If   
           
          aIP    =     Split (sIP,    " . " ,    - 1 ,   vbTextCompare)  
           If     UBound (aIP())    <>     3     Then   
                GetMACAddress    =     " Invaild   IP   Address. "   
                 Exit     Function   
           End     If   
           
           For    X    =     0     To     UBound (aIP())  
                   If     Len (aIP(X))    >     3     Then   
                        GetMACAddress    =     " Invaild   IP   Address "   
                         Exit     Function   
                   End     If   
                   
                   If     IsNumeric (aIP(X))    =     False     Then   
                        GetMACAddress    =     " Invaild   IP   Address "   
                         Exit     Function   
                   End     If   
                   
                   If     InStr (aIP(X),    " , " )    <>     0     Then   
                        GetMACAddress    =     " Invaild   IP   Address "   
                         Exit     Function   
                   End     If   
                   
                   If     CLng (aIP(X))    >     255     Then   
                        GetMACAddress    =     " Invaild   IP   Address "   
                         Exit     Function   
                   End     If   
                   
                   If    nIP    =     ""     Then   
                        nIP    =     String ( 3     -     Len (aIP(X)),    " 0 " )    &    aIP(X)  
                   Else   
                        nIP    =    nIP    &     " . "     &     String ( 3     -     Len (aIP(X)),    " 0 " )    &    aIP(X)  
                   End     If   
           Next   
   
          sRtn    =     ""   
          myNcb.ncb_command    =    NCBRESET  
          bRet    =    Netbios(myNcb)  
          myNcb.ncb_command    =    NCBASTAT  
          myNcb.ncb_lana_num    =     0   
          myNcb.ncb_callname    =    nIP    &     Chr ( 0 )  
           
           Dim    myASTAT    As    ASTAT,   tempASTAT    As    ASTAT  
           Dim    pASTAT    As     Long   
          myNcb.ncb_length    =     Len (myASTAT)  
           
          pASTAT    =    HeapAlloc(GetProcessHeap(),   HEAP_GENERATE_EXCEPTIONS    Or    HEAP_ZERO_MEMORY,   myNcb.ncb_length)  
           If    pASTAT    =     0     Then   
                  GetMACAddress    =     " memory   allcoation   failed! "   
                   Exit     Function   
           End     If   
   
          myNcb.ncb_buffer    =    pASTAT  
          bRet    =    Netbios(myNcb)  
   
           If    bRet    <>     0     Then   
                GetMACAddress    =     " Can   not   get   the   MAC   Address   from   IP   Address:    "     &    sIP  
                 Exit     Function   
           End     If   
           
          CopyMemory   myASTAT,   myNcb.ncb_buffer,    Len (myASTAT)  
           
           Dim    sTemp    As     String   
           Dim    I    As     Long   
           For    I    =     0     To     5   
                  sTemp    =     Hex (myASTAT.adapt.adapter_address(I))  
                   If    I    =     0     Then   
                        sRtn    =    IIf( Len (sTemp)    <     2 ,    " 0 "     &    sTemp,   sTemp)  
                   Else   
                        sRtn    =    sRtn    &     Space ( 1 )    &    IIf( Len (sTemp)    <     2 ,    " 0 "     &    sTemp,   sTemp)  
                   End     If   
           Next   
          HeapFree   GetProcessHeap(),    0 ,   pASTAT  
          GetMACAddress    =    sRtn  
   End     Function   
   
   Private     Sub    Command1_Click()  
   ' 修改IP地址即可  
   MsgBox    GetMACAddress( " 192.168.0.1 " )  
   End     Sub

转载于:https://www.cnblogs.com/findw/archive/2011/03/23/1993087.html