获取外网IP的几种方法

来源:互联网 发布:淘宝店铺背景设置 编辑:程序博客网 时间:2024/05/15 01:11

  获取外网IP的几种方法 收藏
测试了几种方法,其实质是一样的,还是觉得第一种最好,最简单.下面分别列出来:

第一种:用XML

    Set h = CreateObject("Microsoft.XMLHTTP")
    h.Open "GET", "http://www.ip138.com/ip2city.asp", False
    h.Send
    If h.ReadyState = 4 Then s = StrConv(h.Responsebody, vbUnicode)
    If InStr(s, "[") > 0 And InStr(s, "]") > 0 Then MsgBox Split(Split(s, "[")(1), "]")(0) Else MsgBox "IP地址获取失败"

第二种:用inet控件

    Dim WWIP As String, Tmp As Long
    WWIP = Inet1.OpenURL("http://www.ip138.com/ip2city.asp")
    Tmp = InStr(1, WWIP, "[")
    If Tmp > 0 Then
        MsgBox Mid(WWIP, Tmp + 1, InStr(Tmp + 1, WWIP, "]") - Tmp - 1)
    Else
        MsgBox "IP地址获取失败"
    End If

第三种:用纯API

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 lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetReadFile Lib "Wininet.dll" (ByVal hFile As Long, sBuffer As Any, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "Wininet.dll" (ByVal hInet As Long) As Integer
Private Const OnceLen = 2048
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000

'打开URL函数
Function OpenURL(ByVal sURL As String) As String
    Dim hOpen As Long, hFile As Long, RetLen As Long, Buffer() As Byte, szBuffer As String
    hOpen = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    hFile = InternetOpenUrl(hOpen, sURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
    If hFile <> 0 Then
        Do
            ReDim Buffer(OnceLen - 1)
            InternetReadFile hFile, ByVal VarPtr(Buffer(0)), OnceLen, RetLen
            DoEvents
            If RetLen = 0 Then Exit Do
            If RetLen < OnceLen Then ReDim Preserve Buffer(RetLen - 1)
            szBuffer = szBuffer & CStr(Buffer)
        Loop
        InternetCloseHandle hFile
    End If
    InternetCloseHandle hOpen
    OpenURL = StrConv(szBuffer, vbUnicode)
End Function

Private Sub Command1_Click()
    Dim s As String
    s = OpenURL("http://www.ip138.com/ip2city.asp")
    If InStr(s, "[") > 0 And InStr(s, "]") > 0 Then MsgBox Split(Split(s, "[")(1), "]")(0) Else MsgBox "IP地址获取失败"
End Sub

第四种:用"InternetExplorer.Application"对象

    Dim objIE As Object
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = False
    objIE.Navigate "http://www.ip138.com/ip2city.asp"
    Do While objIE.Busy
        DoEvents
    Loop
    MsgBox objIE.Document.body.innertext
    Set objIE = Nothing
 

第五种:用WebBrowser控件

不推荐,略

参见原帖:

http://www.vbgood.com/thread-73675-1-1.html


本文来自CSDN博客,转载请标明出处:http://blog.csdn.net/asftrhgjhkjlkttttttt/archive/2010/12/28/6101944.aspx

原创粉丝点击