我的机器有两块网卡,比如分别在172.16..和172.18..中,如何利用winsock.localip提取本机中的172.18..ip,我每次提取总是172.16..,请教方法,必送分

解决方案 »

  1.   

    Option Explicit
    Dim fileName As StringPrivate Sub Command1_Click()
        Dim strString As String, FileNo
        Dim sVar
        
        If Winsock1.LocalPort = 0 Then
            strString = "硈钡梆絪腹﹟ゼ砞﹚"
        Else
            strString = Winsock1.LocalPort
        End If
        
        Text1.Text = "眤诀嘿" & Winsock1.LocalHostName & vbCrLf
        Text1.Text = Text1.Text & "IP " & Winsock1.LocalIP & vbCrLf
        Text1.Text = Text1.Text & "硈钡梆" & strString & vbCrLf
        Text1.Text = Text1.Text & "硄癟﹚" & IIf(Winsock1.Protocol = 0, "TCP ﹚", "UDP ﹚")    FileNo = FreeFile()
        Open fileName For Input As #FileNo
            While Not EOF(FileNo)
                Line Input #FileNo, sVar
                Text1.Text = Text1.Text & sVar & vbCrLf
            Wend
        Close #FileNoEnd SubPrivate Sub Command2_Click()
        Unload Me
    End SubPrivate Sub Form_Load()
        
        fileName = "c:\IPDetail.txt"
        
        Shell "command.com /c ipconfig.exe > " & fileName
        DoEvents    Do While Trim(Dir(fileName)) = ""
            DoEvents
        LoopEnd Sub
    你翻译成简体看看,以前写的繁体程序打开就这样子,无奈下 -_-#
      

  2.   

    Option ExplicitPrivate Const WS_VERSION_REQD = &H101
    Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
    Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
    Private Const MIN_SOCKETS_REQD = 1
    Private Const SOCKET_ERROR = -1
    Private Const WSADescription_Len = 256
    Private Const WSASYS_Status_Len = 128Private Type HOSTENT
           hName As Long
           hAliases As Long
           hAddrType As Integer
           hLength As Integer
           hAddrList As LongEnd Type
    Private Type WSADATA
           wversion As Integer
           wHighVersion As Integer
           szDescription(0 To WSADescription_Len) As Byte
           szSystemStatus(0 To WSASYS_Status_Len) As Byte
           iMaxSockets As Integer
           iMaxUdpDg As Integer
           lpszVendorInfo As LongEnd Type   Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
       Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
       Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
       Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, HostLen&) As Long
       Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long   Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)   Function hibyte(ByVal wParam As Integer)       hibyte = wParam \ &H100 And &HFF&   End Function   Function lobyte(ByVal wParam As Integer)       lobyte = wParam And &HFF&   End Function   Sub SocketsInitialize()
       Dim WSAD As WSADATA
       Dim iReturn As Integer
       Dim sLowByte As String, sHighByte As String, sMsg As String       iReturn = WSAStartup(WS_VERSION_REQD, WSAD)       If iReturn <> 0 Then
               MsgBox "Winsock.dll is not responding."
               End
           End If       If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
               sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
               sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
               sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
               sMsg = sMsg & " is not supported by winsock.dll "
               MsgBox sMsg
               End
           End If       If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
               sMsg = "This application requires a minimum of "
               sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
               MsgBox sMsg
               End
           End If   End Sub   Sub SocketsCleanup()
       Dim lReturn As Long       lReturn = WSACleanup()       If lReturn <> 0 Then
               MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
               End
           End If   End Sub   Sub Form_Load()       SocketsInitialize   End Sub   Private Sub Form_Unload(Cancel As Integer)       SocketsCleanup   End Sub   Private Sub Command1_click()
       Dim hostname As String * 256
       Dim hostent_addr As Long
       Dim host As HOSTENT
       Dim hostip_addr As Long
       Dim temp_ip_address() As Byte
       Dim i As Integer
       Dim ip_address As String       If gethostname(hostname, 256) = SOCKET_ERROR Then
               MsgBox "Windows Sockets error " & Str(WSAGetLastError())
               Exit Sub
           Else
               hostname = Trim$(hostname)
           End If       hostent_addr = gethostbyname(hostname)       If hostent_addr = 0 Then
               MsgBox "Winsock.dll is not responding."
               Exit Sub
           End If       RtlMoveMemory host, hostent_addr, LenB(host)
           RtlMoveMemory hostip_addr, host.hAddrList, 4       ReDim temp_ip_address(1 To host.hLength)
           RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength       For i = 1 To host.hLength
               ip_address = ip_address & temp_ip_address(i) & "."
           Next
           ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)       MsgBox hostname
           MsgBox ip_address   End Sub
      

  3.   

    '获取本机IP地址,支持多网卡,可以分别获取多个网卡的IPOption ExplicitPrivate Const MAX_ADAPTER_NAME_LENGTH         As Long = 256
    Private Const MAX_ADAPTER_DESCRIPTION_LENGTH  As Long = 128
    Private Const MAX_ADAPTER_ADDRESS_LENGTH      As Long = 8
    Private Const ERROR_SUCCESS  As Long = 0Private Type IP_ADDRESS_STRING
        IpAddr(0 To 15)  As Byte
    End TypePrivate Type IP_MASK_STRING
        IpMask(0 To 15)  As Byte
    End TypePrivate Type IP_ADDR_STRING
        dwNext     As Long
        IpAddress  As IP_ADDRESS_STRING
        IpMask     As IP_MASK_STRING
        dwContext  As Long
    End TypePrivate Type IP_ADAPTER_INFO
      dwNext                As Long
      ComboIndex            As Long  '保留
      sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3))        As Byte
      sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
      dwAddressLength       As Long
      sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1))       As Byte
      dwIndex               As Long
      uType                 As Long
      uDhcpEnabled          As Long
      CurrentIpAddress      As Long
      IpAddressList         As IP_ADDR_STRING
      GatewayList           As IP_ADDR_STRING
      DhcpServer            As IP_ADDR_STRING
      bHaveWins             As Long
      PrimaryWinsServer     As IP_ADDR_STRING
      SecondaryWinsServer   As IP_ADDR_STRING
      LeaseObtained         As Long
      LeaseExpires          As Long
    End Type
    Private Const NCBASTAT = &H33
    Private Const NCBNAMSZ = 16
    Private Const HEAP_ZERO_MEMORY = &H8
    Private Const HEAP_GENERATE_EXCEPTIONS = &H4
    Private Const NCBRESET = &H32Private Type NCB
      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 ' Reserved, must be 0
      ncb_event As Long
    End TypePrivate 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 TypePrivate Type NAME_BUFFER
      Name As String * NCBNAMSZ
      name_num As Integer
      name_flags As Integer
    End TypePrivate Type ASTAT
      adapt As ADAPTER_STATUS
      NameBuff(30) As NAME_BUFFER
    End TypePrivate 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 Netbios Lib "netapi32.dll" (pncb As NCB) As Byte
    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 LongPublic Function EthernetAddress(LanaNumber As Long) _
    As String  Dim udtNCB       As NCB
      Dim bytResponse As Byte
      Dim udtASTAT     As ASTAT
      Dim udtTempASTAT As ASTAT
      Dim lngASTAT     As Long
      Dim strOut       As String
      Dim x            As Integer  udtNCB.ncb_command = NCBRESET
      bytResponse = Netbios(udtNCB)
      udtNCB.ncb_command = NCBASTAT
      udtNCB.ncb_lana_num = LanaNumber
      udtNCB.ncb_callname = "* "
      udtNCB.ncb_length = Len(udtASTAT)
      lngASTAT = HeapAlloc(GetProcessHeap(), _
    HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length)  strOut = ""
      If lngASTAT Then
        udtNCB.ncb_buffer = lngASTAT
        bytResponse = Netbios(udtNCB)
        CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT)
         With udtASTAT.adapt
          For x = 0 To 5
            strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2)
          Next x
        End With
        HeapFree GetProcessHeap(), 0, lngASTAT
      End If
      EthernetAddress = strOut
    End Function Public Function LocalIPAddress() As String
       Dim cbRequired  As Long
       Dim buff()      As Byte
       Dim Adapter     As IP_ADAPTER_INFO
       Dim AdapterStr  As IP_ADDR_STRING
       Dim ptr1        As Long
       Dim sIPAddr     As String
       Dim found       As Boolean
       Dim iFound As Integer
       iFound = 0
       sIPAddr = ""
       Dim sReturn As String
       sReturn = ""
       Call GetAdaptersInfo(ByVal 0&, cbRequired)
       If cbRequired > 0 Then
          ReDim buff(0 To cbRequired - 1) As Byte
          If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
            '获取存放在buff()中的数据的指针
             ptr1 = VarPtr(buff(0))
             Do While (ptr1 <> 0)
               '将第一个网卡的数据转换到IP_ADAPTER_INFO结构中
                CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
                With Adapter
                  'IpAddress.IpAddr成员给出了DHCP的IP地址
                   sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))
                    If Len(sIPAddr) > 0 Then
                      iFound = iFound + 1
                      sReturn = sReturn & "第" & iFound & "个网卡的iP是:" & sIPAddr & vbCrLf
                      found = True
                     ' Exit Do
                   End If
                   ptr1 = .dwNext
                End With  'With Adapter
            '不再有网卡时,ptr1的值为0
             Loop  'Do While (ptr1 <> 0)
          End If  'If GetAdaptersInfo
       End If  'If cbRequired > 0
      '返回结果字符串
       LocalIPAddress = sReturn
    End FunctionFunction TrimNull(item As String)
        Dim pos As Integer
        pos = InStr(item, Chr$(0))
        If pos Then
            TrimNull = Left$(item, pos - 1)
        Else: TrimNull = item
        End If
    End FunctionPrivate Sub Command1_Click()
    Debug.Print LocalIPAddress
    End Sub
      

  4.   

    不知道是哪句API呢?怀疑楼上没有看题。