PD: Pueden cambiar el idioma de el valor que retorna.
PD1: Devuelve la dirección de la Bandera en .ICO por lo que pueden modificarla y hacer que descargue la imagen y la ponga en un picturebox
Código: Seleccionar todo
Option Explicit
'*********************************************************************************************************************
'* Función : mGEOTools *
'* Fecha : 15/05/2010 : 11:020 *
'* Autor : Skyweb07 * [email protected] *
'* Referencias : http://geotool.servehttp.com/ *
'* Próposito : Obtener información de una IP determinada, obteniendo los datos de un servidor remoto *
'* Comentarios : Si a los de la página web se les ocurre cambiar su código pues habria que cambiar el code *
'* Modo de uso : msgbox Initialize.Pais *
'**********************************************************************************************************************
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 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 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 InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Private Const GEOTOOLWEB As String = "http://geotool.servehttp.com/?lang=[IDIOMA]&ip="
Type IPTOOL
Servidor As String
Continente As String
Pais As String
Region As String
Ciudad As String
IP As String
ISP As String
Bandera As String
HoraLocal As String
Latitud As String
Longitud As String
End Type
Enum Idioma
[ES] = 0
[EN] = 1
[FR] = 2
[IT] = 3
[ES-ARG] = 4
[PT] = 5
End Enum
Public Function Initialize(Optional ByVal vIP As String, Optional ByVal vIdioma As Idioma = 0) As IPTOOL
Dim IP As IPTOOL
Dim vData As String
vData = GET_(Replace$(GEOTOOLWEB, "[IDIOMA]", Idioma(vIdioma)) & vIP)
With IP
.Servidor = Back(Textbetween(vData, "<!-- Hostname {{{2 -->", "</b></a>"), ">")
.Continente = Back(Textbetween(vData, "<!-- Countinent {{{2 -->", "</b></a>"), ">")
.Pais = Back(Textbetween(vData, "<!-- Country {{{2 -->", "</b></a>"), ">")
.Region = Trim_(Mid$(Textbetween(Back(Textbetween(vData, "<!-- Region {{{2 -->", "<!-- Localtime {{{2 -->"), "left"), "eft", "</td>"), 5, 100))
.Ciudad = Trim_(Mid$(Textbetween(Back(Textbetween(vData, "<!-- City {{{2 -->", "<!-- Latitude {{{2 -->"), "left"), "eft", "</td>"), 5, 100))
.IP = Back(Textbetween(vData, "!-- IP Address {{{2 -->", "</b></a>"), ">")
.ISP = Trim_(Mid$(Textbetween(Back(Textbetween(vData, "<!-- ISP {{{2 -->", "<!-- Countinent {{{2 -->"), "left"), ">", "</td>"), 5, 100))
.Bandera = Textbetween(vData, "favicon.change(" & Chr$(34), Chr$(34))
.HoraLocal = Back(Textbetween(vData, "localtime", "</span>"), ">")
.Latitud = Trim_(Mid$(Textbetween(Back(Textbetween(vData, "<!-- Latitude {{{2 -->", "<!-- IP Address {{{2 -->"), "left"), "eft", "</td>"), 5, 100))
.Longitud = Trim_(Mid$(Textbetween(Back(Textbetween(vData, "<!-- Longitude {{{2 -->", "<!-- IP Address prompt and form {{{2 -->"), "left"), "eft", "</td>"), 5, 100))
End With
Initialize = IP
End Function
Private Function GET_(ByVal hURL As String, Optional ByVal hUserAgent As String = "[$KYW€B PRODUCTION$]") As String
Dim hInternet As Long
Dim hOpenurl As Long
Dim hBuffer As String * 1024
Dim hComplete As String
Dim hReturn As Long
hInternet = InternetOpen(hUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hInternet <> 0 Then
hOpenurl = InternetOpenUrl(hInternet, hURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
If hOpenurl <> 0 Then
Do
InternetReadFile hOpenurl, hBuffer, 1024, hReturn
hComplete = hComplete & Left$(hBuffer, hReturn)
If hReturn = 0 Then Exit Do
DoEvents
Loop
GET_ = hComplete
End If
End If
InternetCloseHandle hInternet
InternetCloseHandle hOpenurl
End Function
Private Function Idioma(ByVal vIndex As Long) As String
Select Case vIndex
Case 0: Idioma = "es"
Case 1: Idioma = "en"
Case 2: Idioma = "fr"
Case 3: Idioma = "it"
Case 4: Idioma = "es-AR"
Case 5: Idioma = "pt-PT"
End Select
End Function
Private Function Trim_(ByVal hData As String) As String
Trim_ = Trim$(Replace$(hData, Chr$(0), vbNullString))
End Function
Private Function Back(ByVal hData As String, ByVal Char As String) As String
If InStrRev(hData, Char) <> 0 Then Back = Right$(hData, Len(hData) - InStrRev(hData, Char))
End Function
Private Function Textbetween(ByVal hData As String, ByVal hDelimit1 As String, ByVal hDelimit2 As String) As String
On Error Resume Next
Textbetween = Left$(Mid$(hData, InStr(hData, hDelimit1) + Len(hDelimit1)), InStr(Mid$(hData, InStr(hData, hDelimit1) + Len(hDelimit1)), hDelimit2) - 1)
End Function
