VB中获取电脑外网IP的源代码

大家知道每个能上网的电脑都拥有一个自己的IP，如果你是位于局域网呢，那么你的ip可能是192.168.***.***或者10.***.***.***之类的，这样的IP外网是无法访问的，只能在同一个网段之间互访。而这时在自己电脑的CMD上ipconfig /all看见自己的ip就是内网IP，而我们是以外网IP访问网络的，那么我们怎么获取外网IP呢？这需要我们访问一些专门的网站来获取。这里我收集了几个，拿来共享。
http://members.3322.org/dyndns/getip
http://www.ip138.com/ip2city.asp
http://www.ip168.com/IpInfo.asp?sType=0
http://www.net.cn/static/customercare/yourIP.asp

而在编程时我们可以使用多个网址来确保自己的程序显示IP正确，当一个不能反馈IP时就试着从另外一个网站获取。
给段代码供参考

程序代码

    
'获取公网IP
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
         ByVal sAgent As String, ByVal lAccessType As Long, _
         ByVal sProxyName As String, ByVal sProxyBypass As String, _
         ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" ( _
         ByVal hInternetSession As Long, ByVal sUrl As String, _
         ByVal sHeaders As String, ByVal lHeadersLength As Long, _
         ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" ( _
         ByVal hFile As Long, ByVal sBuffer As String, _
         ByVal lNumBytesToRead As Long, _
         lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
         ByVal hInet As Long) As Integer
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Function GetSub() As String
     Dim wburl$, wburl2$, X1, X2, X3, X4
     On Error GoTo err
     wburl = " http://www.ip138.com/ip2city.asp"
     wburl = GetUrlFile(wburl)
     If InStr(1, wburl, "无法找到该页") = 0 Then
         X1 = InStr(1, wburl, "[")
         X2 = InStr(1, wburl, "]")
         X1 = Mid(wburl, X1, X2 - X1)
         X1 = Replace(X1, "[", "")
         X1 = Replace(X1, " ", "")
         X1 = Replace(X1, vbCrLf, "")
         GetSub = X1
         Exit Function
     End If
     wburl2 = " http://www.net.cn/static/customercare/yourIP.asp"
     wburl2 = GetUrlFile(wburl2)
     If InStr(1, wburl2, "无法找到该页") = 0 Then
         X3 = InStr(1, wburl2, "<h2>")
         X4 = InStr(1, wburl2, "</h2>")
         X3 = Mid(wburl2, X3, X4 - X3)
         X3 = Replace(X3, "<h2>", "")
         X3 = Replace(X3, " ", "")
         X3 = Replace(X3, vbCrLf, "")
         GetSub = X3
         Exit Function
     Else
         GetSub = "127.0.0.1"
     End If
err:
     GetSub = "127.0.0.1"
End Function
Private Function GetUrlFile(stUrl As String) As String
     Dim lgInternet As Long, lgSession As Long
     Dim stBuf As String * 1024
     Dim inRes As Integer
     Dim lgRet As Long
     Dim stTotal As String
     stTotal = vbNullString
     lgSession = InternetOpen("VBTagEdit", 1, vbNullString, vbNullString, 0)
     If lgSession Then
         lgInternet = InternetOpenUrl(lgSession, stUrl, vbNullString, _
                 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
         If lgInternet Then
             Do
                 inRes = InternetReadFile(lgInternet, stBuf, 1024, lgRet)
                 stTotal = stTotal & Mid$(stBuf, 1, lgRet)
             Loop While (lgRet <> 0)
         End If
         inRes = InternetCloseHandle(lgInternet)
     End If
     GetUrlFile = stTotal
End Function

使用方法：
在form中调用GetSub就行了
List1.AddItem ("公网IP:" & GetSub + "..")