Accueil > > > CONNAITRE SON IP EXTERNE ( INTERNET )
CONNAITRE SON IP EXTERNE ( INTERNET )
Information sur la source
Description
Bon changé completement la méthode suite à la remarque de YoYoGoTT. La détection se fait maintenant via une page php.
Source
- 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
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.
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
[FRAMEWORK 4] LES TASKS ET LE THREAD UI[FRAMEWORK 4] LES TASKS ET LE THREAD UI par fathi
Je viens de passer quelques temps au TechDay's et j'ai pu voir pas mal de session intéressante. Par contre une chose m'a un peu étonné lors de certaines de ces sessions qui abordaient les améliorations du framework .NET (donc le 4.5) : en gros, bea...
Cliquez pour lire la suite de l'article par fathi WORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBEWORKFLOW FOUNDATION 3 A UN PIED DANS LA TOMBE par JeremyJeanson
Depuis déjà un an, je conseille vivement les utilisateurs de Workflow Foundation 3 à migrer vers la version 4. L'information qui va suivre ne devrait donc pas trop prendre au dépourvu les personnes qui m'ont suivi. Je profite de ce poste, pour faire le re...
Cliquez pour lire la suite de l'article par JeremyJeanson TECHDAYS PARIS 2012 : NOUVELLES TENDANCES DU POSTE DE TRAVAIL - BRING YOUR OWN PCTECHDAYS PARIS 2012 : NOUVELLES TENDANCES DU POSTE DE TRAVAIL - BRING YOUR OWN PC par ROMELARD Fabrice
Speakers: Thierry Rapatout, Antoine Petit et Xavier Trebbia Cette session entre dans le cadre des RDV Décideurs des TechDays 2012, elle est liée à la consumérisation de l'IT et la mise en place du "DeskTop as a Service" dans de plus en ...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2012 : SYSTEM CENTER SERVICE MANAGER 2012 VUE D'ENSEMBLETECHDAYS PARIS 2012 : SYSTEM CENTER SERVICE MANAGER 2012 VUE D'ENSEMBLE par ROMELARD Fabrice
Speakers: Julien Marechal, Gautier Confiant, Sébastien MEYER La session débute par le positionnement de la solution System Center par rapport aux concepts d'organisation ITIL. Le portail du catalogue de se...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2012 : PLEINIèRE SECOND JOURTECHDAYS PARIS 2012 : PLEINIèRE SECOND JOUR par ROMELARD Fabrice
Après une première journée dédiée aux développeurs, cette seconde journée est dédiée au monde des entreprises et de ses applications. Ainsi, cette pleinière est dédiée à faire un 360 de l'évolution des applications Business aux demandes ac...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Forum
VB6 + GRAPHVIZVB6 + GRAPHVIZ par nouirayosra
Cliquez pour lire la suite par nouirayosra
Logiciels
Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning COLLECTOR PLUS (3.00B)COLLECTOR PLUS (3.00B)COLLECTOR PLUS version 3.00B est un logiciel utilisant une base de données alimentée par :
- L... Cliquez pour télécharger COLLECTOR PLUS PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V7.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO LettresFaciles 2011 (8.0.0.1)LETTRESFACILES 2011 (8.0.0.1)LettresFaciles est un logiciel facilitant la création et la rédaction de lettres types.
Son inte... Cliquez pour télécharger LettresFaciles 2011
|