Indetectables

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