怎么用Winsock1获取本机外网IP

Private Sub Command1_Click()
Dim winIP As Object
Set winIP = CreateObject("MSWinsock.Winsock")
MsgBox "本机IP:" & winIP.LocalIP
End Sub

显示的不是我电脑的外网！！！

我要显示外网IP！
--------------------编程问答-------------------- 我要显示外网IP！ --------------------编程问答-------------------- 我要显示外网IP！ --------------------编程问答-------------------- 我要显示外网IP！ --------------------编程问答-------------------- 学习中 --------------------编程问答-------------------- http://dev.csdn.net/article/28/28374.shtm --------------------编程问答-------------------- http://dev.csdn.net/article/28/28374.shtm --------------------编程问答-------------------- 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 Type

Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type

Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type

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

Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
(pTcpTable As Any, _
pdwSize As Long) As Long

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

Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long

Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Sub Form_Load()
Command1.Caption = "获取外网IP"
Text1.Text = LocalIPAddress()
Text2.Text = ""

End Sub

Private 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) Then

hfile = FreeFile
Open sLocalFile For Input As #hfile
buff = Input$(LOF(hfile), hfile)
Close #hfile
pos1 = InStr(buff, "var ip =")

If pos1 Then

pos1 = InStr(pos1 + 1, buff, "'", vbTextCompare) + 1
pos2 = InStr(pos1 + 1, buff, "'", vbTextCompare) '- 1

GetPublicIP = Mid$(buff, pos1, pos2 - pos1)
Else

GetPublicIP = "(unable to parse IP)"

End If

Kill sLocalFile

Else

GetPublicIP = "(unable to access shtml page)"

End If

End Function
Private Function DownloadFile(ByVal sURL As String, _
ByVal sLocalFile As String) As Boolean

DownloadFile = URLDownloadToFile(0, sURL, sLocalFile, 0, 0) = ERROR_SUCCESS

End Function

Private Function LocalIPAddress() As String

Dim cbRequired As Long
Dim buff() As Byte
Dim ptr1 As Long
Dim sIPAddr As String
Dim Adapter As IP_ADAPTER_INFO

Call GetAdaptersInfo(ByVal 0&, cbRequired)

If cbRequired > 0 Then

ReDim buff(0 To cbRequired - 1) As Byte

If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then


ptr1 = VarPtr(buff(0))

Do While (ptr1 <> 0)

CopyMemory Adapter, ByVal ptr1, LenB(Adapter)

With Adapter

sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))

If Len(sIPAddr) > 0 Then Exit Do

ptr1 = .dwNext

End With


Loop

End If
End If

LocalIPAddress = sIPAddr

End Function


Private Function TrimNull(startstr As String) As String

TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))

End Function


--------------------编程问答-------------------- '添加 WinSock1  Command1

Option Explicit
Dim aa$
Private Sub Form_Load()
   Winsock1.Protocol = 0
   Winsock1.RemoteHost = "www.abcbit.com"
   Winsock1.RemotePort = 80
End Sub

Private Sub Command1_Click()
   Winsock1.Connect '开始提取数据
End Sub

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

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

Private Sub Winsock1_close() '当下载完成时发生。
   Winsock1.Close '关闭 Winsock
End Sub

补充：VB ,  网络编程