vb 如何获取外网ip

发布时间:2024-05-17 22:45 发布:上海旅游网

问题描述:

不要内网的,

按下command1在text1显示外网IP。。。

-------
如果有内网的那部分请帮我删了。只剩外网IP。。
能不能不连接到某写网页获取IP,而直接用什么什么API之类获取呢》?
大虾们?

问题解答:

那你是已知域名是吧?

那可以直接根据域名来获取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

Cookies:Response.Cookies(“cookiesName“)

如图效果:



代码:Private Const ERROR_SUCCESS As Long = 0Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8Private Type IP_ADDRESS_STRINGIpAddr(0 To 15) As ByteEnd TypePrivate Type IP_MASK_STRINGIpMask(0 To 15) As ByteEnd TypePrivate Type IP_ADDR_STRINGdwNext As LongIpAddress As IP_ADDRESS_STRINGIpMask As IP_MASK_STRINGdwContext As LongEnd TypePrivate Type IP_ADAPTER_INFOdwNext As LongComboIndex As Long 'reservedsAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As BytesDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As BytedwAddressLength As LongsIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As BytedwIndex As LonguType As LonguDhcpEnabled As LongCurrentIpAddress As LongIpAddressList As IP_ADDR_STRINGGatewayList As IP_ADDR_STRINGDhcpServer As IP_ADDR_STRINGbHaveWins As LongPrimaryWinsServer As IP_ADDR_STRINGSecondaryWinsServer As IP_ADDR_STRINGLeaseObtained As LongLeaseExpires As LongEnd TypePrivate Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _(pTcpTable As Any, _pdwSize As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" _Alias "RtlMoveMemory" _(dst As Any, _src As Any, _ByVal bcount As Long)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 LongPrivate Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _Alias "DeleteUrlCacheEntryA" _(ByVal lpszUrlName As String) As LongPrivate Declare Function lstrlenW Lib "kernel32" _(ByVal lpString As Long) As LongPrivate Sub Command2_Click()EndEnd SubPrivate Sub Form_Load()Command1.Caption = "获 取"Text1.Text = LocalIPAddress()Text2.Text = ""End SubPrivate Sub Command1_Click()Text2.Text = GetPublicIP()End SubPrivate Function GetPublicIP()Dim sSourceUrl As StringDim sLocalFile As StringDim hfile As LongDim buff As StringDim pos1 As LongDim pos2 As LongsSourceUrl = "http://vbnet.mvps.org/resources/tools/getpublicip.shtml"sLocalFile = "c:\ip.txt"Call DeleteUrlCacheEntry(sSourceUrl)If DownloadFile(sSourceUrl, sLocalFile) Thenhfile = FreeFileOpen sLocalFile For Input As #hfilebuff = Input$(LOF(hfile), hfile)Close #hfilepos1 = InStr(buff, "var ip =")If pos1 Thenpos1 = InStr(pos1 + 1, buff, "'", vbTextCompare) + 1pos2 = InStr(pos1 + 1, buff, "'", vbTextCompare) '- 1GetPublicIP = Mid$(buff, pos1, pos2 - pos1)ElseGetPublicIP = "(unable to parse IP)"End IfKill sLocalFileElseGetPublicIP = "(unable to access shtml page)"End IfEnd FunctionPrivate Function DownloadFile(ByVal sURL As String, _ByVal sLocalFile As String) As BooleanDownloadFile = URLDownloadToFile(0, sURL, sLocalFile, 0, 0) = ERROR_SUCCESSEnd FunctionPrivate Function LocalIPAddress() As StringDim cbRequired As LongDim buff() As ByteDim ptr1 As LongDim sIPAddr As StringDim Adapter As IP_ADAPTER_INFOCall GetAdaptersInfo(ByVal 0&, cbRequired)If cbRequired > 0 ThenReDim buff(0 To cbRequired - 1) As ByteIf GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Thenptr1 = VarPtr(buff(0))Do While (ptr1 0)CopyMemory Adapter, ByVal ptr1, LenB(Adapter)With AdaptersIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))If Len(sIPAddr) > 0 Then Exit Doptr1 = .dwNextEnd WithLoopEnd IfEnd IfLocalIPAddress = sIPAddrEnd FunctionPrivate Function TrimNull(startstr As String) As StringTrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))End Function

热点新闻