怎么用Winsock1获取本机外网IP

Question

Private Sub Command1_Click()
Dim winIP As Object
Set winIP = CreateObject("MSWinsock.Winsock")
MsgBox "本机IP:" & winIP.LocalIP
End Sub显示的不是我电脑的外网！！！我要显示外网IP！

Answer 1

http://dev.csdn.net/article/28/28374.shtm

Answer 2

http://dev.csdn.net/article/28/28374.shtm

Answer 3

Option Explicit
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End TypePrivate Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End TypePrivate Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End TypePrivate Type IP_ADAPTER_INFO
dwNext As Long
ComboIndex As Long 'reserved
sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
dwAddressLength As Long
sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
dwIndex As Long
uType As Long
uDhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
bHaveWins As Long
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End 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 Long
Private Sub Form_Load()
Command1.Caption = "获取外网IP"
Text1.Text = LocalIPAddress()
Text2.Text = ""End SubPrivate Sub Command1_Click()
Text2.Text = GetPublicIP()End Sub
Private Function GetPublicIP()
Dim sSourceUrl As String
Dim sLocalFile As String
Dim hfile As Long
Dim buff As String
Dim pos1 As Long
Dim pos2 As Long
sSourceUrl = "http://vbnet.mvps.org/resources/tools/getpublicip.shtml" '这里也可以使用'http://pchelplive.com/ip.php这一个连接
sLocalFile = App.Path & "\" & "ip.txt"Call DeleteUrlCacheEntry(sSourceUrl)If DownloadFile(sSourceUrl, sLocalFile) Thenhfile = FreeFile
Open sLocalFile For Input As #hfile
buff = Input$(LOF(hfile), hfile)
Close #hfile
pos1 = InStr(buff, "var ip =")If pos1 Thenpos1 = InStr(pos1 + 1, buff, "'", vbTextCompare) + 1
pos2 = 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 Function
Private 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 Long
Dim buff() As Byte
Dim ptr1 As Long
Dim sIPAddr As String
Dim 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 Then
ptr1 = 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 With
LoopEnd If
End IfLocalIPAddress = sIPAddrEnd Function
Private Function TrimNull(startstr As String) As StringTrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))End Function

Answer 4

'添加 WinSock1  Command1Option Explicit
Dim aa$
Private Sub Form_Load()
   Winsock1.Protocol = 0
   Winsock1.RemoteHost = "www.abcbit.com"
   Winsock1.RemotePort = 80
End SubPrivate Sub Command1_Click()
   Winsock1.Connect '开始提取数据
End SubPrivate Sub Winsock1_Connect()
   Dim strCommand$, strWebPage$
   strWebPage = "http://www.abcbit.com/ip.php?style=4&color=ff00ff"
   strCommand = "GET " + strWebPage + " HTTP/1.0" + vbCrLf
   strCommand = strCommand + "Accept: */*" + vbCrLf
   strCommand = strCommand + "Accept: text/html" + vbCrLf
   strCommand = strCommand + vbCrLf
   Winsock1.SendData strCommand '发送命令
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
   Dim S$, P&, P1&
   '开始下载，收到数据时，发生DataarriVal事件
   On Error Resume Next
   Dim webData$
   Winsock1.GetData webData, vbString
   S = webData '取得相关的网页文件
   P = InStr(S, "<font color=""ff00ff"">")
   P1 = InStr(P, S, "</font>")
   aa = "您的IP是:" & Mid(S, P + 21, P1 - P - 21) & vbCrLf & Chr(10)
   P = InStr(P1, S, "<font color=""ff00ff"">")
   P1 = InStr(P, S, "</font>")
   aa = aa & "您的地址是:" & Mid(S, P + 21, P1 - P - 21)
   MsgBox aa
End SubPrivate Sub Winsock1_close() '当下载完成时发生。
   Winsock1.Close '关闭 Winsock
End Sub