begin process at 2012 02 13 12:14:32
  Trouver un code source :
 
dans
 
[ Dernières recherches ]
Accueil > 

Code

 > 

API

 > DÉTECTION IP SANS OCX AVEC L'API WININET VIA UNE PAGE PHP

DÉTECTION IP SANS OCX AVEC L'API WININET VIA UNE PAGE PHP


 Information sur la source

Note :
7 / 10 - par 3 personnes
7,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :API Niveau :Initié Date de création :21/01/2003 Date de mise à jour :15/03/2003 14:58:54 Vu / téléchargé :7 609 / 678
Auteur : Nocturne

Ecrire un message privé
Site perso
Ce membre participe au partage de revenus publicitaires
Commentaire sur cette source (12)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
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

  • '*********************************************************
  • '*********************************************************
  • '****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 
'*********************************************************
'*********************************************************
'****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.  

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources du même auteur

AJOUTER UNE LIGNE DANS UN FICHIER - API
Source avec Zip Source avec une capture INFO-BULLE PERSONNALISÉE, MULTILIGNES AVEC QQ OPTONS
Source avec Zip Source avec une capture INFORMATION DISQUE DUR
RETROUVE LA DATE DE CRÉATION D'UN FICHIER - API
Source avec Zip Source avec une capture ECHANGE DE MESSAGES WINDOWS ENTRE DEUX APPLICATIONS
Toutes les sources de Nocturne

 Sources de la même categorie

Source avec Zip Source .NET (Dotnet) .NET DEPENDENCY VIEWER : ARBRE DES DÉPENDANCES D'UN ASSEMBLY... par ShareVB
Source avec Zip Source .NET (Dotnet) UTILITAIRE SKYDRIVE par MasterShadows
Source avec Zip ROTATION RAPIDE D'IMAGE par trex70
Source avec Zip Source avec une capture ENUMERATION DES PORTS TCP ET IDENTIFCATION DU PROCESS (PID) ... par Renfield
Source avec Zip Source avec une capture MOUSE SPEED AND WEIGHT : RETOUR DE FORCE VIRTUEL ! par ScSami
Toutes les sources de la catégorie API

Commentaires et avis

Commentaire de Nocturne le 21/01/2003 22:51:30

Pour info fonctionne sous Windows98 et 2000.
Je l'ai pas testé en XP.

Commentaire de Rock le 22/01/2003 23:12:47

Vraiment tres interressant comme source.
Je vais etudier tous ca maintenant.
encore bravo

Commentaire de Nocturne le 23/01/2003 00:23:27

Merci Rock
En plus ce prog fonctionne 24h/24
A+

Commentaire de nanette261 le 29/01/2003 09:43:57

Je vois que tu t'y connais en IP.
J'aimerais savoir si à partir de mon poste, je peux utiliser des adresse IP différente pour des connections HTTP.
Le but est que le serveur qui recoit (User et Password) ne puissent pas vérifier la meme IP pour une autre connection.

Commentaire de slayer le 05/02/2003 23:49:13

sa marche sous xp , mais je ne comprent pas pourquoi sa ne marche pas a tous les cous j'ai le message  "détection IP erreur" qui vient plus souvent que mon ip , meme en augmentent le time out !!!
je suis en rtc  , help me , que faire pour que sa fonctionne a tous les cous ????

autrement tres bonnes source ...

Commentaire de Nocturne le 06/02/2003 20:05:53

Merci slayer de ton message.
En effet, tu peux rencontrer le message "détection IP erreur"
cela signale que la reponse du serveur c'est faite trop tardivement. Cela peut-etre du au traffic sur internet trop important a ce moment la.

Le mieux est de mettre la valeur maxi du timeout.
De toute facon ce n 'est pas bien grave vue que 3 à 4 minutes plutard il redemarre une détection.
Je pense que ton IP ne change pas toutes les minutes.

A+

Commentaire de Nocturne le 08/02/2003 20:14:55

En reponse au message de slayer.
Tu peux essayer cette nouvelle version, j'ai rajouté la posibilité de faire une détection en mode synchrone.
Le zip, et ma source sont actualisé.

Commentaire de slayer le 09/02/2003 01:48:56

revue a ma maniere
http://www.vbfrance.com/article.aspx?Val=7472

Commentaire de slayer le 09/02/2003 01:54:31

Il est vraie que ta nouvelle méthode fais mouche a chaque fois, mais dommage que l'apli ce bloque quelque seconde.
Étudie ma méthode, tu verra, elle est très simple et apparemment et assez efficace.

Commentaire de Nocturne le 13/02/2003 09:34:13

Slayer,
Ta methode est bonne et court car tu utilises l'OCX Inet.
Il faut signaler que l'OCX Inet repose sur l'API wininet, donc je prefere utiliser l'API directement.
J'ai modifié ma source et ré-actualisé le ZIP. Maintenant en mode synchrone cela fonctionne.
A+

Commentaire de protect le 07/06/2004 19:25:17

Tu peut utiliser winsock qui est plus rapide...
mais bon code pour montrer comment utiliser wininet..
7/10

Commentaire de Nocturne le 07/06/2004 21:46:00

Je suis d'accord avec toi protect mais il y a deja des sources sur l OCX ou l'API Winsock alors je pense que mettre un autre exemple utilisant wininet, c est bien aussi.
Ca serait domage de remettre se qui existe deja.
a+

 Ajouter un commentaire

Nos sponsors


Sondage...

Comparez les prix


Apple iPhone 4 Noir (32 Go)
Entre 1290€ et 1333€

Visiter le guide achat

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

Photo Underwater View of the Ocean With LIght Shining Through the WavePhoto Photo aérienne de Saintes Maries de la Mer
Photo Offroad Vehicle on a Remote Beach in Hawaii 

Visiter la photothèque
 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 8,767 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales
Outils Convertisseur VB/C# Snippets et scripts Outils en ligne La ToolBox
Communauté Programmation Photographie Technologie Newsgroups Emploi Forum Blogs
Guide d'achat Téléphonie mobile Image et son Informatique Bureautique Jeux vidéo
Logiciels Internet & Réseau Développement Market Android Jeux & Loisirs Graphisme Multimédia Sécurité Pilotes
Loisirs Cartes virtuelles Vidéos droles Jeux en ligne Géoguide AndroLib (Android Market)