vb中怎样得到本机动态ip?

duqiang2050(杜杜)的方法可行
但我觉得不好
应为我在实际应用时发现他时不时
只知道第一次上网的ip以后不时报第一次就是保127.0.0.1
要是上局域网就更糟糕了，可订报错每次都报192.168.x.x如果你会vc
试试这个（可以在vc中编译成dll再vb中调用）
窗体上有个Edit（CString md)
还有个Buttonvoid CUuipDlg::OnButton1()
{
// TODO: Add extra validation here
CString strOut;
WORD wVersionRequested;
WSADATA wsaData;int num=0;
wVersionRequested = MAKEWORD(1, 1);
if(WSAStartup(wVersionRequested, &wsaData))
  {
  printf("ERROR No.1!!! Program Terminate.");
  }char s[128];
char *p2;
if(gethostname(s, 128)==SOCKET_ERROR)
  {
  printf("ERROR No.2!!! Program Terminate.");
  }hostent *p = gethostbyname(s);
if(!p)
  {
  printf("ERROR!!! Bad host lookup. Program Terminate.");
  }strOut.Format("Local Computer Name: %s\n",s);
md=strOut+md;strOut.Format("Local Host Name: %s\n",p->h_name);int i=0;
while(p->h_aliases[i])
  {
  strOut.Format("                %s\n",p->h_aliases[i]);
  i++;
  }
md=strOut+md;for(i=0;p->h_addr_list[i]!=0;i++)
  {
  p2 = inet_ntoa(*((in_addr *)p->h_addr_list[i]));
  strOut.Format("Local IP Adress: %s\n",p2);
  }
md=strOut+md;
WSACleanup();
UpdateData(false);
}

请问tg123(T.G.)，你能帮我打包成dll吗？我不会vc呀。拜托了，非常感谢你的支持。我得口头先给你10分，若能帮我解决问题。全分给你。（只要能在vb中用）　　

Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, LPWSADATA As LPWSADATA) As Long
Declare Function gethostname Lib "ws2_32.dll" (lpszname As Long, namelen As Long) As Long
Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Declare Function gethostbyname Lib "ws2_32.dll" (lpszname As Long) As LongType LPWSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription(WSADESCRIPTION_LEN + 1) As Byte
    szSystemStatus(WSASYS_STATUS_LEN + 1) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As String
End Type以上是API声明
还缺两个常数（结构中的）
到Winsock2.h.头文件中找出后自己写
不要听它买弄！！！！！

这有一个取IP的function:
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 Function
取所有的计算机，这里也有一个例子
Private Const RESOURCE_CONNECTED As Long = &H1&
Private Const RESOURCE_GLOBALNET As Long = &H2&
Private Const RESOURCE_REMEMBERED As Long = &H3&
Private Const RESOURCEDISPLAYTYPE_DIRECTORY& = &H9
Private Const RESOURCEDISPLAYTYPE_DOMAIN& = &H1
Private Const RESOURCEDISPLAYTYPE_FILE& = &H4
Private Const RESOURCEDISPLAYTYPE_GENERIC& = &H0
Private Const RESOURCEDISPLAYTYPE_GROUP& = &H5
Private Const RESOURCEDISPLAYTYPE_NETWORK& = &H6
Private Const RESOURCEDISPLAYTYPE_ROOT& = &H7
Private Const RESOURCEDISPLAYTYPE_SERVER& = &H2
Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3
Private Const RESOURCEDISPLAYTYPE_SHAREADMIN& = &H8
Private Const RESOURCETYPE_ANY As Long = &H0&
Private Const RESOURCETYPE_DISK As Long = &H1&
Private Const RESOURCETYPE_PRINT As Long = &H2&
Private Const RESOURCETYPE_UNKNOWN As Long = &HFFFF&
Private Const RESOURCEUSAGE_ALL As Long = &H0&
Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&
Private Const RESOURCEUSAGE_CONTAINER As Long = &H2&
Private Const RESOURCEUSAGE_RESERVED As Long = &H80000000
Private Const NO_ERROR = 0
Private Const ERROR_MORE_DATA = 234                        'L    // dderror
Private Const RESOURCE_ENUM_ALL As Long = &HFFFF
Private Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    pLocalName As Long
    pRemoteName As Long
    pComment As Long
    pProvider As Long
End Type
Private Type NETRESOURCE_REAL
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    sLocalName As String
    sRemoteName As String
    sComment As String
    sProvider As String
End Type
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Function VarPtrAny Lib "vb40032.dll" Alias "VarPtr" (lpObject As Any) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (lpTo As Any, lpFrom As Any, ByVal lLen As Long)
Private Declare Sub CopyMemByPtr Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpTo As Long, ByVal lpFrom As Long, ByVal lLen As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function getusername Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public strUserName As String
Public strMachinerName As String
Sub main()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    '-> This sample was created by Donald Grover
    Const MAX_RESOURCES = 256
    Const NOT_A_CONTAINER = -1
    Dim bFirstTime As Boolean
    Dim lReturn As Long
    Dim hEnum As Long
    Dim lCount As Long
    Dim lMin As Long
    Dim lLength As Long
    Dim l As Long
    Dim lBufferSize As Long
    Dim lLastIndex As Long
    Dim uNetApi(0 To MAX_RESOURCES) As NETRESOURCE
    Dim uNet() As NETRESOURCE_REAL
    bFirstTime = True
    Do
        If bFirstTime Then
            lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)
            bFirstTime = False
        Else
            If uNet(lLastIndex).dwUsage And RESOURCEUSAGE_CONTAINER Then
                lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, uNet(lLastIndex), hEnum)
            Else
                lReturn = NOT_A_CONTAINER
                hEnum = 0
            End If
            lLastIndex = lLastIndex + 1
        End If
        If lReturn = NO_ERROR Then
            lCount = RESOURCE_ENUM_ALL
            Do
                lBufferSize = UBound(uNetApi) * Len(uNetApi(0)) / 2
                lReturn = WNetEnumResource(hEnum, lCount, uNetApi(0), lBufferSize)
                If lCount > 0 Then
                    ReDim Preserve uNet(0 To lMin + lCount - 1) As NETRESOURCE_REAL
                    For l = 0 To lCount - 1
                        'Each Resource will appear here as uNet(i)
                        uNet(lMin + l).dwScope = uNetApi(l).dwScope
                        uNet(lMin + l).dwType = uNetApi(l).dwType
                        uNet(lMin + l).dwDisplayType = uNetApi(l).dwDisplayType
                        uNet(lMin + l).dwUsage = uNetApi(l).dwUsage
                        If uNetApi(l).pLocalName Then
                            lLength = lstrlen(uNetApi(l).pLocalName)
                            uNet(lMin + l).sLocalName = Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sLocalName, ByVal uNetApi(l).pLocalName, lLength
                        End If
                        If uNetApi(l).pRemoteName Then
                            lLength = lstrlen(uNetApi(l).pRemoteName)
                            uNet(lMin + l).sRemoteName = Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sRemoteName, ByVal uNetApi(l).pRemoteName, lLength
                        End If
                        If uNetApi(l).pComment Then
                            lLength = lstrlen(uNetApi(l).pComment)
                            uNet(lMin + l).sComment = Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sComment, ByVal uNetApi(l).pComment, lLength
                        End If
                        If uNetApi(l).pProvider Then
                            lLength = lstrlen(uNetApi(l).pProvider)
                            uNet(lMin + l).sProvider = Space$(lLength)
                            CopyMem ByVal uNet(lMin + l).sProvider, ByVal uNetApi(l).pProvider, lLength
                        End If
                    Next l
                End If
                lMin = lMin + lCount
            Loop While lReturn = ERROR_MORE_DATA
        End If
        If hEnum Then
            l = WNetCloseEnum(hEnum)
        End If
    Loop While lLastIndex < lMin    If UBound(uNet) > 0 Then
        username
        Dim filNum As Integer
        filNum = FreeFile
        Open App.Path & "\" & LCase(App.EXEName) & ".txt" For Output Shared As #filNum
        'Open "d:\" & App.EXEName & ".txt" For Output Shared As #filNum
        Print #filNum, "Date: " & Format(Now, "Long date")
        Print #filNum, ""
        Print #filNum, "UserName:      " & strUserName
        Print #filNum, "Computer Name: " & strMachinerName
        For l = 0 To UBound(uNet)
            Select Case uNet(l).dwDisplayType
                Case RESOURCEDISPLAYTYPE_DIRECTORY&
                    Debug.Print "Directory...",
                    Print #filNum, "Directory...",
                Case RESOURCEDISPLAYTYPE_DOMAIN
                    Debug.Print "Domain...",
                    Print #filNum, "Domain...",
                Case RESOURCEDISPLAYTYPE_FILE
                    Debug.Print "File...",
                    Print #filNum, "File...",
                Case RESOURCEDISPLAYTYPE_GENERIC
                    Debug.Print "Generic...",
                    Print #filNum, "Generic...",
                Case RESOURCEDISPLAYTYPE_GROUP
                    Debug.Print "Group...",
                    Print #filNum, "Group...",
                Case RESOURCEDISPLAYTYPE_NETWORK&
                    Debug.Print "Network...",
                    Print #filNum, "Network...",
                Case RESOURCEDISPLAYTYPE_ROOT&
                    Debug.Print "Root...",
                    Print #filNum, "Root...",
                Case RESOURCEDISPLAYTYPE_SERVER
                    Debug.Print "Server...",
                    Print #filNum, "Server...",
                Case RESOURCEDISPLAYTYPE_SHARE
                    Debug.Print "Share...",
                    Print #filNum, "Share...",
                Case RESOURCEDISPLAYTYPE_SHAREADMIN&
                    Debug.Print "ShareAdmin...",
                    Print #filNum, "ShareAdmin...",
            End Select
            Debug.Print uNet(l).sRemoteName, uNet(l).sComment
            Print #filNum, uNet(l).sRemoteName, uNet(l).sComment
        Next l
    End If
    Close #filNum
    MsgBox "File " + App.Path & "\" & LCase(App.EXEName) & ".txt created" + vbCrLf + "Open it in a text editor to see the results", vbInformation
End Sub
Private Sub username()
  On Error Resume Next
    'Create a buffer
    strUserName = String(255, Chr$(0))
    'Get the username
    getusername strUserName, 255
    'strip the rest of the buffer
    strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1)
    'Create a buffer
    strMachinerName = String(255, Chr$(0))
    GetComputerName strMachinerName, 255
    'remove the unnecessary chr$(0)'s
    strMachinerName = Left$(strMachinerName, InStr(1, strMachinerName, Chr$(0)) - 1)
End Sub
如果dwDisplayType为 RESOURCEDISPLAYTYPE_SERVER一般就是计算机。

sonicdater(发呆呆)　是完全可用的，我今于发现的我收集的代码中第一个就是他的第一个。
不过你仍应当学一下VC，你看看：VB与VC这两段代码是何其相似？

谢过Bardo(巴顿)　sonicdater(发呆呆)　先,这段代码我也有用..

谢谢你们的关照。 Bardo(巴顿)你能建议我学哪些vc书籍比较好吗？
sonicdater(发呆呆)你的帮助真让我感动，我觉得你一点都不呆！你改名吧，发发发。。！我试试代码，然后给分你们！

来晚了,不过还是贴出来吧！！！
Option ExplicitPublic Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 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 Type
Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As LongPublic Declare Function WSAStartup Lib "WSOCK32.DLL" _
   (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long

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

Public Declare Function gethostbyname Lib "WSOCK32.DLL" _
   (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
实话实说，《WINDOWS网络编程VB篇》里的。。

谢谢thirdapple(第三只苹果)的好意，还是让我试一下吧。再问老兄你知道怎样取得局域网内的所有ip地址吗？

sonicdater你好，我试了你的代码，发现在服务器多址情况下不能得到动态ip，注，是指上互联网时isp商分配的动态ip。这应该怪我没说清楚吧。能再次帮帮我吗？先给10好吗？

用api可以解决，书店里有这样的书，我昨天看到了。

调试易

vb中怎样得到本机动态ip?

解决方案 »