Crea tu propio Ip-Checker [VB+PHP]

[Karcrack]

Bueno, como dice el titulo con el siguiente metodo puedes obtener tu Ip externa como si del DynDNS se tratara. Lo primero sera subir el fichero *.PHP a un servidor que sea compatible con el PHP.



PHP:

Código (php) [Seleccionar] Expandir

/* Esta es una pequeña funcion que devuleve la IP
   Actual siempre y cuando se navege desde el navegador 'karcrack'
*/
<?PHP
$Nav = $_SERVER['HTTP_USER_AGENT'];
if ($Nav == "karcrack")
{
echo $_SERVER['REMOTE_ADDR'];
}
else
{
echo '127.0.0.1';
}
?>

Esta funcion comprueba que el navegador con el que se navega sea 'karcrack', por supuesto esto se puede modificar



VB:

Código (vb) [Seleccionar] Expandir

'Esto se pone siempre xD
Option Explicit
'Se declara el Objecto.
Public WinHttp As Object
'Se declaran las constantes para la configuracion del WinHttp
Public Const WinHttpRequestOption_EnableHttp1_1 As Long = 17
Public Const WinHttpRequestOption_EnableHttpsToHttpRedirects As Long = 12
Public Const WinHttpRequestOption_EnableRedirects As Long = 6
Public Const WinHttpRequestOption_UserAgentString As Long = 0
Public Const HTTPREQUEST_PROXYSETTING_DIRECT As Long = 1

'Esta funcion configura el WinHttp con las opciones mas habituales...
Public Sub SetHTTPLib()
    'Se vacia el objecto.
    Set WinHttp = Nothing
    'Se carga el objecto
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    With WinHttp
        'Permite la version del protocolo http 1.1
        .Option(WinHttpRequestOption_EnableHttp1_1) = True
        'Permite la redireccion de https:// a http://
        .Option(WinHttpRequestOption_EnableHttpsToHttpRedirects) = True
        'Permite las demas redirecciones
        .Option(WinHttpRequestOption_EnableRedirects) = True
        'Modifica el Navegador, para que nuestro script PHP sepa que somos notros :D
        .Option(WinHttpRequestOption_UserAgentString) = "karcrack"
        'Desactiva el proxy.
        .SetProxy HTTPREQUEST_PROXYSETTING_DIRECT
    End With
End Sub

Public Function ObIP(ByVal URL As String) As String
    Call SetHTTPLib
    With WinHttp
        'Se conecta.
        .Open "GET", URL
        'Pide la IP
        .Send
        'La obtiene
        ObIP = .ResponseText
    End With
End Function

Bueno, aqui esta todo bien explicado... la funcion se llama de esta forma:

Código (vb) [Seleccionar] Expandir

msgbox ObIp ("URL_DONDE_ESTA_EL_SCRIPT_EN_PHP")



Saludos

[krackwar]

Gracias , por el aporte.

Otro metodo de la api guide es:

Código (vb) [Seleccionar] Expandir

'In a form
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    MsgBox "IP-address: " + GetIPAddress
End Sub


Código (vb) [Seleccionar] Expandir

'In a module
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Public Const SOCKET_ERROR As Long = -1
Public Const WSADESCRIPTION_LEN = 257
Public Const WSASYS_STATUS_LEN = 129
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets As Integer
    wMaxUDPDG As Integer
    dwVendorInfo As Long
End Type
Type WSADataInfo
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSADESCRIPTION_LEN
    szSystemStatus As String * WSASYS_STATUS_LEN
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As String
End Type
Public Type HOSTENT
    hName As Long
    hAliases As Long
    hAddrType As Integer
    hLen As Integer
    hAddrList As Long
End Type
Declare Function WSAStartupInfo Lib "WSOCK32" Alias "WSAStartup" (ByVal wVersionRequested As Integer, lpWSADATA As WSADataInfo) As Long
Declare Function WSACleanup Lib "WSOCK32" () As Long
Declare Function WSAGetLastError Lib "WSOCK32" () As Long
Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long
Declare Function gethostname Lib "WSOCK32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Declare Function gethostbyname Lib "WSOCK32" (ByVal szHost As String) As Long
Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public Function GetIPAddress() As String
    Dim sHostName As String * 256
    Dim lpHost As Long
    Dim HOST As HOSTENT
    Dim dwIPAddr As Long
    Dim tmpIPAddr() As Byte
    Dim I As Integer
    Dim sIPAddr As String
    If Not SocketsInitialize() Then
        GetIPAddress = ""
        Exit Function
    End If
    If gethostname(sHostName, 256) = SOCKET_ERROR Then
        GetIPAddress = ""
        MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."
        SocketsCleanup
        Exit Function
    End If
    sHostName = Trim$(sHostName)
    lpHost = gethostbyname(sHostName)
    If lpHost = 0 Then
        GetIPAddress = ""
        MsgBox "Windows Sockets are not responding. " & "Unable to successfully get Host Name."
        SocketsCleanup
        Exit Function
    End If
    CopyMemoryIP HOST, lpHost, Len(HOST)
    CopyMemoryIP dwIPAddr, HOST.hAddrList, 4
    ReDim tmpIPAddr(1 To HOST.hLen)
    CopyMemoryIP tmpIPAddr(1), dwIPAddr, HOST.hLen
    For I = 1 To HOST.hLen
        sIPAddr = sIPAddr & tmpIPAddr(I) & "."
    Next
    GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
    SocketsCleanup
End Function
Public Function GetIPHostName() As String
    Dim sHostName As String * 256
    If Not SocketsInitialize() Then
        GetIPHostName = ""
        Exit Function
    End If
    If gethostname(sHostName, 256) = SOCKET_ERROR Then
        GetIPHostName = ""
        MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."
        SocketsCleanup
        Exit Function
    End If
    GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)
    SocketsCleanup
End Function
Public Function HiByte(ByVal wParam As Integer)
    HiByte = wParam \ &H100 And &HFF&
End Function
Public Function LoByte(ByVal wParam As Integer)
    LoByte = wParam And &HFF&
End Function
Public Sub SocketsCleanup()
    If WSACleanup() <> ERROR_SUCCESS Then
        MsgBox "Socket error occurred in Cleanup."
    End If
End Sub
Public Function SocketsInitialize() As Boolean
    Dim WSAD As WSAData
    Dim sLoByte As String
    Dim sHiByte As String
    If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
        MsgBox "The 32-bit Windows Socket is not responding."
        SocketsInitialize = False
        Exit Function
    End If
    If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        MsgBox "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD) & " supported sockets."
        SocketsInitialize = False
        Exit Function
    End If
    If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
        sHiByte = CStr(HiByte(WSAD.wVersion))
        sLoByte = CStr(LoByte(WSAD.wVersion))
        MsgBox "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."
        SocketsInitialize = False
        Exit Function
    End If
    'must be OK, so lets do it
    SocketsInitialize = True
End Function


[‭‭‭‭jackl007]

Este codigo hace lo mismo, pero mas simple, se usa un php que ya lo ha subido alguien...
esto me lo paso leandroA hace un tiempo atras ....

Código (vb) [Seleccionar] Expandir



Option Explicit
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

Private Function GetIp() As String
Dim hOpen As Long, hFile As Long, sBuffer As String * 36, Ret As Long
    hOpen = InternetOpen("miip", 1, vbNullString, vbNullString, 0)
    hFile = InternetOpenUrl(hOpen, "http://www.flavionet.com/ipcheckjs.php", vbNullString, ByVal 0&, &H80000000, ByVal 0&)
    InternetReadFile hFile, sBuffer, 36, Ret
    InternetCloseHandle hFile
    InternetCloseHandle hOpen
    Dim V As Variant
    V = Split(sBuffer, Chr(34))
    GetIp = V(1)
End Function

Private Sub Form_Load()
MsgBox GetIp
End Sub


[seba123neo]

hay 3 millones de codigos para saber la ip