Détection ip sans ocx avec l'api wininet via une page php

Télécharger le projet
Commenter

Description

En réponse au codes-sources de TheSaib "ADRESSE IP PAR L'API WINSOCK" http://www.vbfrance.com/article.aspx?Val=7140
      • Version février 2003, prend en charge la détection en synchrone ou asynchrone***
      • Modification mars 2003, Option supplementaire avec OpenUrl sur la détection en mode synchrone***


Cette exemple trouve l'IP externe via un modem/router, passerelle, serveur proxy ou toutes autres systèmes de connexion car il utilise une page en PHP qui me renvoie mon IP.

J'utilise l'API wininet avec une selection du type de détection synchrone ou asynchrone.
L'avantage de la détection asynchrone est la possibilite d'un réglage du timeout sur la requête.
En mode synchrone, le mode time out n'est pas ajustable et le gros problème c'est que durant la détection, la requête garde les resources. Durant cette phase de détection en mode synchrone, l'application parait figé mais en réalité fonctionne.

Ce code fait partie d'un de mes programme de détection de mon IP à Internet.
J'ai juste mis la partie de détection car le programme original est beaucoup plus important car il prend en charge la redirection de mes clients depuis internet et les rediriges sur mon serveur Web que j'héberge chez moi.

Source / Exemple : 


'*********************************************************
'*********************************************************
'****Détection de votre IP à Internet par Nocturne 2002***
'**Rev. mars 2003, prend en charge le type de détection**
'******************synchrone/asynchrone******************
'********************API WinInet**************************
'*********************************************************
'*********************************************************
'Attention avec vos Firewall, il faut autoriser le passage

Option Explicit

Private WComptVariableTemps As Integer
Private Retour_Ip As String

Private Const INTERNET_FLAG_ASYNC = &H10000000 'Les requêtes sont effectuées en asynchrones.
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0 'Récupère la configuration par défaut (base de registre).
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_FLAG_RELOAD = &H80000000

Private 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
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _
    ByVal hInternetSession As Long, _
    ByVal sServerName As String, _
    ByVal nServerPort As Integer, _
    ByVal sUsername As String, _
    ByVal sPassword As String, _
    ByVal lService As Long, _
    ByVal lFlags As Long, _
    ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" ( _
    ByVal hHttpSession As Long, _
    ByVal sVerb As String, _
    ByVal sObjectName As String, _
    ByVal sVersion As String, _
    ByVal sReferer As String, _
    ByVal something As Long, _
    ByVal lFlags As Long, _
    ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" ( _
    ByVal hHttpRequest As Long, _
    ByVal sHeaders As String, _
    ByVal lHeadersLength As Long, _
    ByVal sOptional As String, _
    ByVal lOptionalLength As Long) As Long
Private 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
Private Declare Function InternetReadFile Lib "wininet.dll" ( _
    ByVal hFile As Long, _
    ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, _
    lNumberOfBytesRead As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" ( _
    ByVal hInet As Long) As Integer

Private Sub Command1_Click()

Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = True
Command3.SetFocus
Combo1.Enabled = False
Text1.Enabled = False
Text2.Enabled = False
Option1(0).Enabled = False
Option1(1).Enabled = False
Option2(0).Enabled = False
Option2(1).Enabled = False

Call Start_Detection_ip

WComptVariableTemps = 0

Timer1.Enabled = True
Timer1.Interval = 10000 ' 10 secondes

End Sub

Private Sub Start_Detection_ip()

Dim tampon As String * 15
Dim Inet_API_Open, Inet_API_ConnServ, Open_Requete As Long
Dim Nbr_Char As Long
Dim dwTimeOut As Long
Dim Etat_Connexion, PassDetection As Boolean
Dim DureePause As Integer
Dim DebutTime As Long

Label1.Caption = "Détection de votre IP à Internet"
PassDetection = False

Debut_Detection_Ip:

Etat_Connexion = True
DoEvents

InternetCloseHandle Inet_API_Open
InternetCloseHandle Inet_API_ConnServ
InternetCloseHandle Open_Requete

Inet_API_Open = 0
Inet_API_ConnServ = 0
Open_Requete = 0

If Option1(0).Value = True Then 'Type de connexion Synchrone ou Asynchrone
    Inet_API_Open = InternetOpen("", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
Else
    Inet_API_Open = InternetOpen("", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, INTERNET_FLAG_ASYNC)
End If

If CBool(Inet_API_Open) = True Then
    Screen.MousePointer = 11
    If Option2(0).Value = True Then
        Open_Requete = InternetOpenUrl(Inet_API_Open, "http://" & Text2.Text & "/" & Text1.Text, vbNullString, 0, &H80000000, 0)
    Else
        Inet_API_ConnServ = InternetConnect(Inet_API_Open, Text2.Text, 80, vbNullString, "HTTP/1.0", INTERNET_SERVICE_HTTP, 0, 0)
    End If
    If Inet_API_ConnServ > 0 Or Open_Requete > 0 Then
        
        If Option2(1).Value = True Then Open_Requete = HttpOpenRequest(Inet_API_ConnServ, "GET", Text1.Text, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
        
        If CBool(Open_Requete) = True Or Open_Requete > 0 Then
            'Screen.MousePointer = 11
            If Option2(1).Value = True Then HttpSendRequest Open_Requete, vbNullString, 0, vbNullString, 0
            
            If Option1(0).Value = True And Option2(1).Value = True Then 'Type de connexion Synchrone ou Asynchrone
                Retour_Ip = ""
                Call PauseTime(1) 'Pause 1 sec
                InternetReadFile Open_Requete, tampon, Len(tampon), Nbr_Char
                'Call PauseTime(1)
                Retour_Ip = Retour_Ip & Mid$(tampon, 1, Nbr_Char)
            Else
                Nbr_Char = 0
                DureePause = CInt(Combo1.Text)   ' Défini la durée.
                If Option2(0) = True Then DureePause = 24
                DebutTime = Timer   ' Défini l'heure de début.
                Retour_Ip = ""
                If (DebutTime + DureePause) < 86400 Then 'Test pour éviter le depassement de 60s*60min*24hrs, c'est à dire 86400 secondes, 1 jour
                    Do While Nbr_Char = 0 And Timer < (DebutTime + DureePause)
                        tampon = ""
                        InternetReadFile Open_Requete, tampon, Len(tampon), Nbr_Char
                        'Lecture de la page dans le buffer
                        Retour_Ip = Retour_Ip & Mid$(tampon, 1, Nbr_Char)
                        DoEvents   ' Donne le contrôle à d'autres processus.
                    Loop
                Else 'Transition entre aujourd'hui et demain
                    'Cette boucle permet d'attendre que le timer se positionne à 0 soit 00 hrs 00 min 00 secondes
                    Do While Timer > DureePause 'Mise en attente pour arriver à minuit
                        DoEvents
                    Loop
                    'Le Timer est donc maintenant à 0 soit 00:00:00
                    '(PauseTime - (86400 - Start)) permet de réinitialiser le temps restant à la pause par rapport au temps déjà écoulé
                    Do While Nbr_Char = 0 And Timer < (DureePause - (86400 - DebutTime))
                        tampon = ""
                        InternetReadFile Open_Requete, tampon, Len(tampon), Nbr_Char
                        'Lecture de la page dans le buffer (par bloc de 15)
                        Retour_Ip = Retour_Ip & Mid$(tampon, 1, Nbr_Char)
                        DoEvents   ' Donne le contrôle à d'autres processus.
                    Loop
                End If
            End If
            'Screen.MousePointer = 0
        Else
            Etat_Connexion = False
            Label1.Caption = "Retour information sur les IP - Délais dépassé"
        End If
        InternetCloseHandle Open_Requete
    Else
        Etat_Connexion = False
        Label1.Caption = "Echec de connexion avec le server distant"
    End If
    InternetCloseHandle Inet_API_ConnServ
    Screen.MousePointer = 0
Else
    Etat_Connexion = False
    Label1.Caption = "Echec d'ouverture de connexion avec internet"
End If

InternetCloseHandle Inet_API_Open

If Etat_Connexion = True Then
    If Trim(Retour_Ip) = "" Or Len(Trim(Retour_Ip)) < 8 Then
        If PassDetection = False Then PassDetection = True: Label1.Caption = "Détection IP, 2ème passage...": GoTo Debut_Detection_Ip '2ème passage
    Else
        Label1.Caption = "Votre IP : " & Retour_Ip & "     Détection dans 60 sec."
    End If
End If

End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()

If Trim(Retour_Ip) = "" Or Len(Trim(Retour_Ip)) < 8 Then
    Label1.Caption = "Détection IP erreur, détection -->STOP"
Else
    Label1.Caption = "Votre IP : " & Retour_Ip & "     Détection -->STOP"
End If

Timer1.Enabled = False
Timer1.Interval = 0

Command1.Enabled = True
Command1.SetFocus
Command2.Enabled = True
Command3.Enabled = False
Combo1.Enabled = True
Text1.Enabled = True
Text2.Enabled = True
Option1(0).Enabled = True
Option1(1).Enabled = True

If Option1(1).Value = True Then
    Option2(1).Enabled = True
Else
    Option2(0).Enabled = True
    Option2(1).Enabled = True
End If

End Sub

Private Sub Form_Load()

Option1(1).Value = True
Option2(1).Value = True
Option2(0).Enabled = False

Combo1.AddItem "10"
Combo1.AddItem "11"
Combo1.AddItem "12"
Combo1.AddItem "13"
Combo1.AddItem "14"
Combo1.AddItem "15"
Combo1.AddItem "16"
Combo1.AddItem "17"
Combo1.AddItem "18"
Combo1.AddItem "19"
Combo1.AddItem "20"
Combo1.AddItem "21"
Combo1.AddItem "22"
Combo1.AddItem "23"
Combo1.AddItem "24"
Combo1.AddItem "25"
Combo1.AddItem "26"
Combo1.AddItem "27"
Combo1.AddItem "28"
Combo1.AddItem "29"
Combo1.AddItem "30"
Combo1.AddItem "31"
Combo1.AddItem "32"
Combo1.AddItem "33"
Combo1.AddItem "34"
Combo1.AddItem "35"

Combo1.ListIndex = 12

Label1.Caption = "None"
Text2.Text = "detectip.free.fr" 'http://detectip.free.fr
Text1.Text = "ip_check.php"
Label2.Caption = "Time Out en secondes : "
Label2.Alignment = 1
Combo1.Visible = True

Command3.Enabled = False

Label5.Caption = StrConv((Format(Date, "dddd d mmmm yyyy")), vbProperCase) & " " & Format(Time, "hh:mm:ss")

Timer2.Enabled = True
Timer2.Interval = 1000 '1 sec

End Sub

Private Sub Option1_Click(Index As Integer)
If Option1(1).Value = True Then
    Label2.Caption = "Time Out en secondes : "
    Label2.Alignment = 1
    Combo1.Visible = True
    Option2(1).Value = True
    Option2(0).Enabled = False
Else
    Label2.Caption = "Time Out système par défaut "
    Label2.Alignment = 2
    Combo1.Visible = False
    Option2(0).Value = True
    Option2(0).Enabled = True
End If
End Sub

Private Sub Timer1_Timer()

WComptVariableTemps = WComptVariableTemps + 1

If Trim(Retour_Ip) = "" Or Len(Trim(Retour_Ip)) < 8 Then
    Label1.Caption = "Détection IP erreur, détection dans " & (6 - WComptVariableTemps) * 10 & " sec."
Else
    Label1.Caption = "Votre IP : " & Retour_Ip & "     Détection dans " & (6 - WComptVariableTemps) * 10 & " sec."
End If

If WComptVariableTemps = 6 Then ' Détection toutes les minutes
    Call Start_Detection_ip
    WComptVariableTemps = 0
End If

If Trim(Retour_Ip) = "" Or Len(Trim(Retour_Ip)) < 8 Then
    Label1.Caption = "Détection IP erreur, détection dans " & (6 - WComptVariableTemps) * 10 & " sec."
Else
    Label1.Caption = "Votre IP : " & Retour_Ip & "     Détection dans " & (6 - WComptVariableTemps) * 10 & " sec."
End If

End Sub

Private Sub PauseTime(ByVal SecondToWait As Integer)
Dim TimeStart As Long

'PauseTime = 2   ' Durée de la pause en secondes.
TimeStart = Timer   ' Récuperation de l'heure de début de la pause en secondes.
If (TimeStart + SecondToWait) < 86400 Then 'Test pour éviter le depassement de 60s*60min*24hrs, c'est à dire 86400 secondes, 1 jour
    Do While Timer < TimeStart + SecondToWait
        DoEvents 'Donne le contrôle à d'autres processus
    Loop
Else 'Transition entre aujourd'hui et demain
    'Cette boucle permet d'attendre que le timer se positionne à 0 soit 00 hrs 00 min 00 secondes
    Do While Timer > SecondToWait '1 'Mise en attente pour arriver à minuit
        DoEvents
    Loop
    'Le Timer est donc maintenant à 0 soit 00:00:00
    '(SecondToWait - (86400 - TimeStart)) permet de réinitialiser le temps restant à la pause par rapport au temps déja écoulé
    Do While Timer < (SecondToWait - (86400 - TimeStart))
        DoEvents
    Loop
End If

End Sub

Private Sub Timer2_Timer()
Label5.Caption = StrConv((Format(Date, "dddd d mmmm yyyy")), vbProperCase) & " " & Format(Time, "hh:mm:ss")
End Sub

Conclusion :


Pour tester cette exemple vous pouvez garder l'Url http://detectip.free.fr avec le nom de la page : ip_check.php qui est configuré par défaut.

Bonne prog à tous, Nocturne.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_Nocturne)