Tu comunidad de Seguridad Informatica

Para ver Todo el contenido del foro es necesario estar Registrado!
Antes de comentar o Aportar es Obligado Leer Las: Reglas | Rules
Ya Esta Disponible al publico "LeProject" el Videojuego del Foro Click Aquí Para Ver el Post.
Pitbull Security Labs "Extras" Esta Disponible! [ENTRA]

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

avatar
Moderadores
Moderadores

Ver perfil de usuario
el Jue Jun 02, 2011 3:43 pm
Código:
Option Explicit

'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' MODULO      : mGeoIP                              |||
' FECHA      : 28/10/2010 00:38                    |||
' AUTOR      : Fakedo0r                            |||
' CORREO      : [Tienes que estar registrado y conectado para ver este vínculo]                  |||
' CREDITOS    : JhonJhon_123                        |||
' DESCRIPCION : Localizar IP                        |||
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------

'==============================================================================
' --- APIS
'==============================================================================
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
'==============================================================================
' --- CONSTANTES
'==============================================================================
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
'==============================================================================
' --- TYPES
'==============================================================================
Public Type GeoDatos

    Country  As String
    City      As String
   
End Type
'==============================================================================
' --- FUNCION INET
'==============================================================================
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
'==============================================================================
' --- FUNCION LOCALIZAR IP
'==============================================================================
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 = ": </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

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.