VB2013，VB点虐 外网IP获取问题！

直接对服务器请求。（该服务器要有相对的功能,连线后控件属性即包含，可设置自动回报）

创新互联公司专业为企业提供台安网站建设、台安做网站、台安网站设计、台安网站制作等企业网站建设、网页设计与制作、台安企业网站模板建站服务，10年台安做网站经验，不只是建网站，更提供有价值的思路和整体网络服务。

找一个网页，内容含有显示浏览者ip的网址。抓该网页的内容分析获取外网的字串。

提供一个安全网址给你：

是APNIC亚洲数据中心的首页 的子页

vb 如何获取外网ip

vb 如何获取外网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 = ""

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 = ""

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 + "..")。

VB点虐 2015 如何获取外网IP并保存到软件目录下的IP.txt文件

Private Sub WebBrowser1_DocumentCompleted(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted

Dim str As String

str = Me.WebBrowser1.Document.Body.InnerHtml

Dim a As Integer = 0

Dim b As Integer = 0

a = InStr(str, "[")

b = InStr(str, "]")

TextBox1.Text = Mid(str, a + 1, b - a - 1)

End Sub

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

Me.WebBrowser1.Navigate("

)

End Sub

End Class

网页上显示的有点问题，form1_load 中代码是：Me.WebBrowser1.Navigate("")

原理：访问查IP网页后，获取网页上显示的本机外网ip地址

vb 如何获取外网ip？

vb中从域名得到IP及从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 = 128

Private Type HOSTENT

hname As Long

hAliases As Long

hAddrType As Integer

hLength As Integer

hAddrList As Long

End 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 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)

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

Function 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 Function

Sub 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

End Sub

Private 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_address

End Function

Private Sub Command1_click()

Dim str As String

str = getip(Text1.Text)

If str = "" Then

Text2.Text = "主机名不能被解释"

Else

Text2.Text = str

End If

End Sub

Private Function getname(addrstr As String) As String

Dim hostent_addr As Long

Dim host As HOSTENT

Dim addr(0 To 50) As Byte

Dim addrs As String

Dim hname(1 To 50) As Byte

Dim str As String

Dim i As Integer, j As Integer

Dim temp_int As Integer

Dim byt As Byte

str = Trim$(addrstr)

i = 0

j = 0

Do

temp_int = 0

i = i + 1

Do While Mid$(str, i, 1) = "0" And Mid$(str, i, 1) = "9" And i = Len(str)

temp_int = temp_int * 10 + Mid$(str, i, 1)

i = i + 1

Loop

If temp_int = 255 Then

addr(j) = temp_int

j = j + 1

End If

Loop Until Mid$(str, i, 1) "." Or i Len(str) Or temp_int 255

If temp_int 255 Then

getname = "地址非法"

Exit Function

End If

hostent_addr = gethostbyaddr(addr(0), j, 2)

If hostent_addr = 0 Then

getname = "此地址无法解析"

Exit Function

End If

RtlMoveMemory host, hostent_addr, LenB(host)

RtlMoveMemory hname(1), host.hname, 50

j = 51

For i = 1 To 50

If hname(i) = 0 Then

j = i

End If

If i = j Then

hname(i) = 32

End If

Next i

getname = Trim$(StrConv(hname, vbUnicode))

End Function

Private Sub Command2_Click()

Dim name As String

name = getname(Text2.Text)

If name = "" Then

name = "此地址没有域名"

End If

Text1.Text = name

End Sub

当前名称：vb点虐 获取外网ip vbnet如何调用api函数
标题网址：http://myzitong.com/article/ddsogpj.html