Código
Option Explicit '-------------------------------------------- ' Autor : SquX ' Nombre : mIP ' Funcion : Optener el IP publico '-------------------------------------------- Private Const INTERNET_OPEN_TYPE_DIRECT As Integer = 1 Private Const INTERNET_OPEN_TYPE_PROXY As Integer = 3 Private Const INTERNET_FLAG_RELOAD As Long = &H80000000 Private Const INTERNET_FLAG_NO_CACHE_WRITE As Long = &H4000000 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 Public Function sIP() As String sIP = Dividir(Code("http://www.ip-adress.com"), "<h2>My IP address is: ", "</h2>") End Function Public Function Code(sURL As String) As String ' // Basado en ejemplo en recursosvisualbasic.com.ar Dim sBuff As String * 100 Dim sOpen As Long Dim sFile As Long Dim sRet As Long sOpen = InternetOpen("SquX", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0) If sOpen <> 0 Then sFile = InternetOpenUrl(sOpen, sURL, vbNullString, ByVal 0&, INTERNET_FLAG_NO_CACHE_WRITE, ByVal 0&) If sFile <> 0 Then Do Call InternetReadFile(sFile, sBuff, 100, sRet) Code = Code & Mid$(sBuff, 1, sRet) If sRet = 0 Then Exit Do End If Loop Call InternetCloseHandle(sFile) Call InternetCloseHandle(sOpen) End If End If End Function Public Function Dividir(Texto As String, Delimitador1 As String, Delimitador2 As String) As String Dim sData() As String sData() = Split(Texto, Delimitador1) sData() = Split(sData(1), Delimitador2) Dividir = sData(0) End Function
Uso:
Código
Option Explicit Private Const MB_ICONINFORMATION As Long = &H40& Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long Private Sub Form_Load() Call MessageBox(Me.hwnd, "Mi ip es: " & sIP, "IP", MB_ICONINFORMATION) End Sub
Espero criticas