Connaitre son ip externe ( internet )

Description

Bon changé completement la méthode suite à la remarque de YoYoGoTT.
La détection se fait maintenant via une page php.

Source / Exemple :


Dans un module :

Option Explicit

Dim VbString, IP As String
Dim StrEnd, a As Integer

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3

Public Const scUserAgent = "VB OpenUrl"
Public Const INTERNET_FLAG_RELOAD = &H80000000

Sub GetIp(URL As String)

        Dim hOpen As Long
        Dim hOpenUrl As Long
        Dim bDoLoop As Boolean
        Dim bRet As Boolean
        Dim sReadBuffer As String * 2048
        Dim lNumberOfBytesRead As Long
        Dim sBuffer As String

        hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
        hOpenUrl = InternetOpenUrl(hOpen, URL, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)

        bDoLoop = True
        While bDoLoop
                sReadBuffer = vbNullString
                bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
                sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
                If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
        Wend
        
        VbString = sBuffer
        
        VbString = Mid(VbString, InStr(VbString, "IP Address:") + 12, 20)
        StrEnd = InStr(VbString, "<br>") - 2

        For a = 1 To StrEnd
            IP = IP + Mid(VbString, a, 1)
        Next
        
        FrmMyIP.TxtIP.Text = IP
        
        IP = ""
        
        If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
        If hOpen <> 0 Then InternetCloseHandle (hOpen)

End Sub

Dans une Form avec une TextBox (TxtIP) et un bouton de commande (CmdOK) :

Private Sub CmdOK_Click()
End
End Sub

Private Sub Form_Load()

Call GetIp("http://checkip.dyndns.org/")

End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Conclusion :


Si qqu'un veut cependant l'ancienne source, envoyez moi un message.

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.