О том как узнать внешний IP

'Введем новую переменную
Dim HTMLCode As String 'переменная для хранения кода страницы
 
'{Пишем код в Событие,которое генерируется при нажатии на кнопку}
Private Sub Command1_Click()
    Winsock1.RemotePort = 80                     'устанавливаем порт сервера 80
    Winsock1.RemoteHost = "ippages.com"    'Хост
    Winsock1.Connect                               'Подключаемся
End Sub
 
'{=====Событие генерируется при закрытии Канала связи======}
Private Sub Winsock1_Close()            
Form1.Caption = "Not Connect" 'Просто сообщаем о том что не подключены
Winsock1.Close
End Sub
 
'{=====Событие генерируется при подключении======}
Private Sub Winsock1_Connect()      
   Form1.Caption = "Connected"      'Подключены
   'Посылаем запрос на сервер  выдающему наш IP
   Winsock1.SendData "GET " + "/simple/" + " HTTP/1.0" + Chr(10) + Chr(10)
End Sub
 
'{=====Событие генерируется когда нам приходят данные======}
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Winsock1.GetData HTMLCode                   'Получаем данные и помещаем их в переменную
    IP.Text = CutIP(HTMLCode)
End Sub
 
'А вот собственно и функция "вытягивания" IP  из HTML
Function CutIP(HTML As String) As String
Dim p1 As Integer
    p1 = InStr(HTML, "Content-Type: text/html")
    CutIP = Trim(Mid(HTML, p1 + 27, Len(HTML) - p1 - 23))
End Function

'добавляем глобальную переменную
Dim PocketLen  As Integer ' переменная для хранения размера страницы
 
...
'поменяем Хост
Winsock1.RemoteHost = "ip-whois.net"    'Хост
...
'поменяем запрос
Winsock1.SendData "GET " + "/ip.php" + " HTTP/1.0" + Chr(10) + Chr(10)
...
'перепишим код в событии которое возникает при получении данных
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Temp As String
   PocketLen = PocketLen + bytesTotal      'увеличиваем суммарный объем страницы
   Winsock1.GetData Temp                   'Получаем данные и помещаем их в переменную
   HTMLCode = HTMLCode + Temp              'Дописываем пакет к нашей страницы
   'страница весит около 7225 байт.Проверяем вся ли страница принята
   'и только тогда в Текстовое поле помещаем наш IP
   If PocketLen > 7000 Then IP.Text = CutIP(HTMLCode)
  'End If
End Sub
 
'Перепишим функцию GetIP
Function CutIP(HTML As String) As String     'В качестве параметра принимаем код страницы
Dim p1, p2 As Integer
    p1 = 1
    p1 = InStr(HTML, "Ваш IP:")              'ищем начало нужной строки с IP
    If p1 = 0 Then                           'если не нашли то сообщим о неудаче
    MsgBox "Не удалось получить IP"
    Else
    HTML = Mid(HTML, p1, Len(HTML) - p1)     'Скопируем выражение "Ваш IP:" и все что стоит после него
    p2 = InStr(HTML, "</h2>")                'Ищем конец по тегу
    'Возвращаемое значение функции и будет наш IP,на всякий случай сделал Trim
    CutIP = Trim(Mid(HTML, 8, p2 - 8))
    End If
End Function

Const scUserAgent = "IP_API_Loader"
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000
Const sURL = "http://www.ippages.com/simple/"
Private Declare Function InternetOpen Lib "wininet" 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 InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" 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 Sub Form_Load()
     Dim hOpen As Long, hFile As Long, sBuffer As String, Ret As Long
    'Сщздаем буфер для хранения информации
    sBuffer = Space(20)
    'Соединяемся с интернет
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    'Заходим на нужный сайт с определителем IP
    hFile = InternetOpenUrl(hOpen, sURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
    'Считываем первые 20 байт информации
    InternetReadFile hFile, sBuffer, 20, Ret
    'Закрываем соединения
    InternetCloseHandle hFile
    InternetCloseHandle hOpen
    'Отображаем Ip
    Me.AutoRedraw = True
    Me.Print "Ваш IP - " & sBuffer
End Sub