Option Explicit

 

 

Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Long

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" (ByRef hInet 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 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 Const INTERNET_OPEN_TYPE_DIRECT     As Long = 1

Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000

Private Const HTTP_QUERY_CONTENT_LENGTH     As Long = 5

Public Type GeoDatos

 

    Country   As String

    City      As String

   

End Type

Private Function DescargaWeb(URL As String) As String

 

    Dim Gestor          As Long

    Dim GestorURL       As Long

    Dim BytesTotal      As Long

    Dim LenBufferSize   As Long

    Dim Buffer          As String

    Dim Agente          As String

    Dim Data            As String

    Dim BufferSize      As String

    Dim Res             As Integer

   

    Agente = "By Fakedo0r"

   

    Gestor = InternetOpen(Agente, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)

    GestorURL = InternetOpenUrl(Gestor, URL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)

   

    Buffer = String(1024, Chr(0))

   

    BufferSize = Space(1024)

    LenBufferSize = Len(BufferSize)

   

    If HttpQueryInfo(GestorURL, HTTP_QUERY_CONTENT_LENGTH, ByVal BufferSize, LenBufferSize, 0) <> 0 Then

        BufferSize = Left(BufferSize, LenBufferSize)

    End If

   

    If Gestor <> 0 Then

   

        Res = InternetReadFile(GestorURL, Buffer, 1024, BytesTotal)

       

        If Res <> 0 Then

       

            Data = Buffer

           

            Do While BytesTotal <> 0

           

                Res = InternetReadFile(GestorURL, Buffer, 1024, BytesTotal)

               

                If Res <> 0 Then

               

                    Data = Data & Mid(Buffer, 1, BytesTotal)

                   

                End If

               

                DoEvents

               

            Loop

           

        End If

       

    End If

   

    InternetCloseHandle Gestor

    InternetCloseHandle GestorURL

   

    DescargaWeb = Data

 

End Function

Public Function GeoIPInfo(IP As String) As GeoDatos

 

    Dim URL         As String

    Dim Datos       As String

    Dim sDatos()    As String

   

    Dim Part1       As String

    Dim Part2       As String

    Dim Part3       As String

    Dim Pos1        As String

   

    Dim Nombre      As String

    Dim Final       As String

    Dim Data        As Variant

    Dim aDatos      As GeoDatos

   

    URL = "http://www.geoipview.com/?q="

    URL = URL & IP

   

    Datos = DescargaWeb(URL)

   

    Part1 = "align=absmiddle alt=" & Chr(34) & "" & Chr(34) & "></td>"

    Pos1 = InStr(1, Datos, Part1)

    Datos = Mid$(Datos, Pos1 + Len(Part1), Len(Datos))

   

    Part1 = "</TABLE>"

    Pos1 = InStr(1, Datos, Part1)

    Datos = Left$(Datos, Pos1 - 1)

   

    sDatos = Split(Datos, "<TR><TD class=" & Chr(34) & "show1" & Chr(34) & " nowrap>")

   

    For Each Data In sDatos

   

        Part1 = ":&nbsp;</td><td class=" & Chr(34) & "show2" & Chr(34) & ">"

        Part2 = "</td>"

        Pos1 = InStr(1, Data, Part1)

       

        If Pos1 = 0 Then GoTo Error

       

        Nombre = Left$(Data, Pos1 - 1)

        Part3 = Mid$(Data, Pos1 + Len(Part1), Len(Data))

        Final = Split(Part3, Part2)(0)

                                                               

        Select Case Nombre

       

            Case "Country"

           

                aDatos.Country = Final

               

            Case "City"

           

                aDatos.City = Final

               

        End Select

   

Error:

   

    Next

   

    GeoIPInfo = aDatos

 

End Function