很基础的东东，怎样获得本机IP

Public Const IP_SUCCESS As Long = 0
Public Const MAX_WSADescription As Long = 256
Public Const MAX_WSASYSStatus As Long = 128
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1Public Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To MAX_WSADescription) As Byte
   szSystemStatus(0 To MAX_WSASYSStatus) As Byte
   wMaxSockets As Long
   wMaxUDPDG As Long
   dwVendorInfo As Long
End TypePrivate Declare Function gethostbyname Lib "wsock32" _
  (ByVal hostname As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (xDest As Any, _
   xSource As Any, _
   ByVal nbytes As Long)Private Declare Function lstrlenA Lib "kernel32" _
  (lpString As Any) As LongPublic Declare Function WSAStartup Lib "wsock32" _
   (ByVal wVersionRequired As Long, _
    lpWSADATA As WSADATA) As Long

Public Declare Function WSACleanup Lib "wsock32" () As Long
Public Function SocketsInitialize() As Boolean   Dim WSAD As WSADATA
   Dim success As Long

   SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS

End Function
Public Sub SocketsCleanup()

   If WSACleanup() <> 0 Then
       MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
   End If

End Sub
Public Function GetIPFromHostName(ByVal sHostName As String) As String  'converts a host name to an IP address.   Dim nbytes As Long
   Dim ptrHosent As Long
   Dim ptrName As Long
   Dim ptrAddress As Long
   Dim ptrIPAddress As Long
   Dim sAddress As String

   sAddress = Space$(4)   ptrHosent = gethostbyname(sHostName & vbNullChar)   If ptrHosent <> 0 Then     'assign pointer addresses and offset

     'The Address is offset 12 bytes from the start of
     'the HOSENT structure. Note: Here we are retrieving
     'only the first address returned. To return more than
     'one, define sAddress as a string array and loop through
     'the 4-byte ptrIPAddress members returned. The last
     'item is a terminating null. All addresses are returned
     'in network byte order.
      ptrAddress = ptrHosent + 12

     'get the IP address
      CopyMemory ptrAddress, ByVal ptrAddress, 4
      CopyMemory ptrIPAddress, ByVal ptrAddress, 4
      CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4      GetIPFromHostName = IPToText(sAddress)   End If

End Function
Private Function IPToText(ByVal IPAddress As String) As String   IPToText = CStr(Asc(IPAddress)) & "." & _
              CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
              CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
              CStr(Asc(Mid$(IPAddress, 4, 1)))

End Function

alicky(周松) 的思路是好的，无需孔件，直接调用api,但按试了下，不灵耶。
俺的电脑名称是"acer",ip是在dhcp服务器上自动获取的（192.168.0.123)
我试了下：
MsgBox GetIPFromHostName("Acer")
MsgBox GetIPFromHostName("Localhost")
都得不到ip地址。
；-（

Private 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 Long
End TypePrivate 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 Long
End Type
Private Declare Function gethostbyaddr Lib "WSOCK32.DLL" (addr As Any, ByVal _
byteslen As Integer, addrtype As Integer) As Long
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 gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, _
        ByVal hpvSource&, ByVal cbCopy&)
Private Declare Function GetComputerNameSys Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function hibyte(ByVal wParam As Integer)    '获得整数的高位
   hibyte = wParam \ &H100 And &HFF&
End FunctionFunction lobyte(ByVal wParam As Integer)    '获得整数的低位
   lobyte = wParam And &HFF&
End FunctionFunction 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 没有反应."
      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版本 " & sLowByte & "." & sHighByte
      sMsg = sMsg & " 不被winsock.dll支持 "
      MsgBox sMsg
      End
   End If

   If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
      sMsg = "这个系统需要的最少Sockets数为 "
      sMsg = sMsg & Trim$(str$(MIN_SOCKETS_REQD))
      MsgBox sMsg
      End
   End If

End FunctionSub SocketsCleanup()
   Dim lReturn As Long

   lReturn = WSACleanup()

   If lReturn <> 0 Then
      MsgBox "Socket错误 " & Trim$(str$(lReturn)) & " occurred in Cleanup "
      End
   End If
End Sub
Sub Form_Load()
    '初始化Socket
    SocketsInitialize
    Dim str As String
    str = getip(GetComputerName)         '
    If str = "" Then
        MsgBox "主机名不能被解释"
    Else
        MsgBox str
    End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
    '清除Socket
    SocketsCleanup
End Sub
Private Function getip(name As String) As String
   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

   hostent_addr = gethostbyname(name)

   If hostent_addr = 0 Then
      getip = ""                     '主机名不能被解释
      Exit Function
   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)

   getip = ip_addressEnd Function
'取得计算机名
Public Function GetComputerName() As String
    Dim strTempString As String
    strTempString = String(80, 0)
    Call GetComputerNameSys(strTempString, 80)
    GetComputerName = Left(strTempString, InStr(1, strTempString, Chr(0)) - 1)
End Function

Public Const MAX_WSADescription As Long = 256
Public Const MAX_WSASYSStatus As Long = 128
Public Const ERROR_SUCCESS       As Long = 0
Public Const WS_VERSION_REQD     As Long = &H101
Public Const WS_VERSION_MAJOR    As Long = WS_VERSION_REQD
\ &H100 And &HFF&
Public Const WS_VERSION_MINOR    As Long = WS_VERSION_REQD
And &HFF&
Public Const MIN_SOCKETS_REQD    As Long = 1
Public Const SOCKET_ERROR        As Long = -1Public Type HOSTENT
   hName      As Long
   hAliases   As Long
   hAddrType  As Integer
   hLen       As Integer
   hAddrList  As Long
End TypePublic Type WSADATA
   wVersion      As Integer
   wHighVersion  As Integer
   szDescription(0 To MAX_WSADescription)   As Byte
   szSystemStatus(0 To MAX_WSASYSStatus)    As Byte
   wMaxSockets   As Integer
   wMaxUDPDG     As Integer
   dwVendorInfo  As Long
End TypePublic Declare Function WSAGetLastError Lib "wsock32" ()
As LongPublic Declare Function WSAStartup Lib "wsock32" _
  (ByVal wVersionRequired As Long, _
   lpWSADATA As WSADATA) As Long

Public Declare Function WSACleanup Lib "wsock32" () As LongPublic Declare Function gethostname Lib "wsock32" _
  (ByVal szHost As String, _
   ByVal dwHostLen As Long) As Long

Public Declare Function gethostbyname Lib "wsock32" _
  (ByVal szHost As String) As Long

Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (hpvDest As Any, _
   ByVal hpvSource As Long, _
   ByVal cbCopy As Long)
Public Function GetIPAddress() As String   Dim sHostName    As String * 256
   Dim lpHost    As Long
   Dim HOST      As HOSTENT
   Dim dwIPAddr  As Long
   Dim tmpIPAddr() As Byte
   Dim i         As Integer
   Dim sIPAddr  As String

   If Not SocketsInitialize() Then
      GetIPAddress = ""
      Exit Function
   End If

  'gethostname returns the name of the local host into
  'the buffer specified by the name parameter. The host
  'name is returned as a null-terminated string. The
  'form of the host name is dependent on the Windows
  'Sockets provider - it can be a simple host name, or
  'it can be a fully qualified domain name. However, it
  'is guaranteed that the name returned will be
successfully
  'parsed by gethostbyname and WSAAsyncGetHostByName.  'In actual application, if no local host name has been
  'configured, gethostname must succeed and return a token
  'host name that gethostbyname or WSAAsyncGetHostByName
  'can resolve.
   If gethostname(sHostName, 256) = SOCKET_ERROR Then
      GetIPAddress = ""
      MsgBox "Windows Sockets error " &
Str$(WSAGetLastError()) & _
              " has occurred. Unable to successfully get
Host Name."
      SocketsCleanup
      Exit Function
   End If

  'gethostbyname returns a pointer to a HOSTENT structure
  '- a structure allocated by Windows Sockets. The HOSTENT
  'structure contains the results of a successful search
  'for the host specified in the name parameter.  'The application must never attempt to modify this
  'structure or to free any of its components. Furthermore,
  'only one copy of this structure is allocated per thread,
  'so the application should copy any information it needs
  'before issuing any other Windows Sockets function calls.  'gethostbyname function cannot resolve IP address strings
  'passed to it. Such a request is treated exactly as if an
  'unknown host name were passed. Use inet_addr to convert
  'an IP address string the string to an actual IP address,
  'then use another function, gethostbyaddr, to obtain the
  'contents of the HOSTENT structure.
   sHostName = Trim$(sHostName)
   lpHost = gethostbyname(sHostName)

   If lpHost = 0 Then
      GetIPAddress = ""
      MsgBox "Windows Sockets are not responding. " & _
              "Unable to successfully get Host Name."
      SocketsCleanup
      Exit Function
   End If

  'to extract the returned IP address, we have to copy
  'the HOST structure and its members
   CopyMemory HOST, lpHost, Len(HOST)
   CopyMemory dwIPAddr, HOST.hAddrList, 4

  'create an array to hold the result
   ReDim tmpIPAddr(1 To HOST.hLen)
   CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen

  'and with the array, build the actual address,
  'appending a period between members
   For i = 1 To HOST.hLen
      sIPAddr = sIPAddr & tmpIPAddr(i) & "."
   Next

  'the routine adds a period to the end of the
  'string, so remove it here
   GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)

   SocketsCleanup

End Function
Public Function GetIPHostName() As String    Dim sHostName As String * 256

    If Not SocketsInitialize() Then
        GetIPHostName = ""
        Exit Function
    End If

    If gethostname(sHostName, 256) = SOCKET_ERROR Then
        GetIPHostName = ""
        MsgBox "Windows Sockets error " &
Str$(WSAGetLastError()) & _
                " has occurred.  Unable to successfully
get Host Name."
        SocketsCleanup
        Exit Function
    End If

    GetIPHostName = Left$(sHostName, InStr(sHostName, Chr
(0)) - 1)
    SocketsCleanupEnd Function
Public Function HiByte(ByVal wParam As Integer) As Byte

  'note: VB4-32 users should declare this function As
Integer
   HiByte = (wParam And &HFF00&) \ (&H100)

End Function
Public Function LoByte(ByVal wParam As Integer) As Byte  'note: VB4-32 users should declare this function As
Integer
   LoByte = wParam And &HFF&    End Function
Public Sub SocketsCleanup()    If WSACleanup()<> ERROR_SUCCESS Then
        MsgBox "Socket error occurred in Cleanup."
    End If

End SubPublic Function SocketsInitialize() As Boolean   Dim WSAD As WSADATA
   Dim sLoByte As String
   Dim sHiByte As String

   If WSAStartup(WS_VERSION_REQD, WSAD)<> ERROR_SUCCESS
Then
      MsgBox "The 32-bit Windows Socket is not responding."
      SocketsInitialize = False
      Exit Function
   End If


   If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        MsgBox "This application requires a minimum of " &
_
                CStr(MIN_SOCKETS_REQD) & " supported
sockets."

        SocketsInitialize = False
        Exit Function
    End If


   If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
     (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
      HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then

      sHiByte = CStr(HiByte(WSAD.wVersion))
      sLoByte = CStr(LoByte(WSAD.wVersion))

      MsgBox "Sockets version " & sLoByte & "." & sHiByte
& _
             " is not supported by 32-bit Windows Sockets."

      SocketsInitialize = False
      Exit Function

   End If


  'must be OK, so lets do it
   SocketsInitialize = True

End Function
'--end block--'

这个还用写那么多代码啊？直接用winsock的localIP属性啊winsock1.localIP就是楼主想要的

模块里面
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Public Const SOCKET_ERROR As Long = -1
Public Const WSADESCRIPTION_LEN = 257
Public Const WSASYS_STATUS_LEN = 129
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Integer
    wMaxUDPDG As Integer
    dwVendorInfo As Long
End Type
Type WSADataInfo
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSADESCRIPTION_LEN
    szSystemStatus As String * WSASYS_STATUS_LEN
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As String
End Type
Public Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLen As Integer
    hAddrList As Long
End Type
Declare Function WSAStartupInfo Lib "WSOCK32" Alias "WSAStartup" (ByVal wVersionRequested As Integer, lpWSADATA As WSADataInfo) As Long
Declare Function WSACleanup Lib "WSOCK32" () As Long
Declare Function WSAGetLastError Lib "WSOCK32" () As Long
Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long
Declare Function gethostname Lib "WSOCK32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Declare Function gethostbyname Lib "WSOCK32" (ByVal szHost As String) As Long
Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public Function GetIPAddress() As String
    Dim sHostName As String * 256
    Dim lpHost As Long
    Dim HOST As HOSTENT
    Dim dwIPAddr As Long
    Dim tmpIPAddr() As Byte
    Dim I As Integer
    Dim sIPAddr As String
    If Not SocketsInitialize() Then
        GetIPAddress = ""
        Exit Function
    End If
    If gethostname(sHostName, 256) = SOCKET_ERROR Then
        GetIPAddress = ""
        MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."
        SocketsCleanup
        Exit Function
    End If
    sHostName = Trim$(sHostName)
    lpHost = gethostbyname(sHostName)
    If lpHost = 0 Then
        GetIPAddress = ""
        MsgBox "Windows Sockets are not responding. " & "Unable to successfully get Host Name."
        SocketsCleanup
        Exit Function
    End If
    CopyMemoryIP HOST, lpHost, Len(HOST)
    CopyMemoryIP dwIPAddr, HOST.hAddrList, 4
    ReDim tmpIPAddr(1 To HOST.hLen)
    CopyMemoryIP tmpIPAddr(1), dwIPAddr, HOST.hLen
    For I = 1 To HOST.hLen
        sIPAddr = sIPAddr & tmpIPAddr(I) & "."
    Next
    GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
    SocketsCleanup
End Function
Public Function GetIPHostName() As String
    Dim sHostName As String * 256
    If Not SocketsInitialize() Then
        GetIPHostName = ""
        Exit Function
    End If
    If gethostname(sHostName, 256) = SOCKET_ERROR Then
        GetIPHostName = ""
        MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."
        SocketsCleanup
        Exit Function
    End If
    GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)
    SocketsCleanup
End Function
Public Function HiByte(ByVal wParam As Integer)
    HiByte = wParam \ &H100 And &HFF&
End Function
Public Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF&
End Function
Public Sub SocketsCleanup()
    If WSACleanup() <> ERROR_SUCCESS Then
        MsgBox "Socket error occurred in Cleanup."
    End If
End Sub
Public Function SocketsInitialize() As Boolean
    Dim WSAD As WSAData
    Dim sLoByte As String
    Dim sHiByte As String
    If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
        MsgBox "The 32-bit Windows Socket is not responding."
        SocketsInitialize = False
        Exit Function
    End If
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        MsgBox "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD) & " supported sockets."
        SocketsInitialize = False
        Exit Function
    End If
    If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
        sHiByte = CStr(HiByte(WSAD.wVersion))
        sLoByte = CStr(LoByte(WSAD.wVersion))
        MsgBox "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."
        SocketsInitialize = False
        Exit Function
    End If
    'must be OK, so lets do it
    SocketsInitialize = True
End FunctionPrivate Sub Form_Load()
MsgBox GetIPAddress()
MsgBox GetIPHostName()
End Sub
我刚试过，win2000下没问题

调试易

很基础的东东，怎样获得本机IP

解决方案 »