OVH Cloud OVH Cloud

IP

5 réponses
Avatar
Gizmo
Bonjour,
En VBA,comment r=E9cup=E9rer son IP internet derri=E8re un=20
routeur ?
Merci
Gizmo

5 réponses

Avatar
Raymond [mvp]
Bonjour.

tu devrais trouver ta vie sur la page:
http://www.mvps.org/accessfr/apis/api0067.htm et pages connexes.

--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum


"Gizmo" a écrit dans le message de
news:1775e01c44943$8903f170$
Bonjour,
En VBA,comment récupérer son IP internet derrière un
routeur ?
Merci
Gizmo
Avatar
Gizmo
Merci pour cette info mais je recherche l'adresse IP Internet et non pas
Local.



"Raymond [mvp]" a écrit dans le message de
news:
Bonjour.

tu devrais trouver ta vie sur la page:
http://www.mvps.org/accessfr/apis/api0067.htm et pages connexes.

--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum


"Gizmo" a écrit dans le message de
news:1775e01c44943$8903f170$
Bonjour,
En VBA,comment récupérer son IP internet derrière un
routeur ?
Merci
Gizmo




Avatar
Gyu DETIENNE
Salut Raymond,

Le code proposé ne pourra par répondre à la demande faite.
En effet, si le PC est derrière un routeur, le code ne
retournera que l'adresse IP locale du PC, mais pas
l'adresse IP publique du routeur.

Ce code aurait fonctionné seulement si le PC était
directement connecté à Internet, dans ce cas la collection
aurait retourné l'adresse locale et publique. Ce n'est
pas le cas ici.

Je n'ai pas directement la solution , mais on pourrait
jeter un oeil ici en faisant une recherche adéquate:

http://vbnet.mvps.org/
http://www.planet-source-code.com/vb/default.asp?lngWId=1

Guy

-----Message d'origine-----
Bonjour.

tu devrais trouver ta vie sur la page:
http://www.mvps.org/accessfr/apis/api0067.htm et pages
connexes.


--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum


"Gizmo" a écrit
dans le message de

news:1775e01c44943$8903f170$
Bonjour,
En VBA,comment récupérer son IP internet derrière un
routeur ?
Merci
Gizmo


.



Avatar
Logipro
Bonjour,

Voici le code pour récupérer ton adresse IP d'internet, le principe que
j'utilise et de télécharger une page Web qui affiche ton adresse IP, ensuite
je fait qu'extraire l'adresse IP contenu dedans.

Usage : ?MonIP()
Retour : Adresse IP


Salutation

Robert Simard
Logipro



'// ***** Dans un module standard **********
Option Compare Database
Option Explicit

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

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

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

Public Declare Function InternetGetConnectedState _
Lib "wininet.dll" (ByRef lpdwFlags As Long, _
ByVal dwReserved As Long) As Long

Private Const ERROR_SUCCESS As Long = 0

Public Function GetHTMLFromURL(sUrl As String) As String
Dim S 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

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

bDoLoop = True

While bDoLoop
sReadBuffer = vbNullString
bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer),
lNumberOfBytesRead)
S = S & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend

If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
If hOpen <> 0 Then InternetCloseHandle (hOpen)

GetHTMLFromURL = S

End Function

Public Function IsConnected() As Boolean

On Error GoTo err
IsConnected = InternetGetConnectedState(0&, 0&)

Exit Function

err:
IsConnected = True

End Function


Public Function MonIP() As String
Dim strHTML As String
Dim StringPosition As Long
Dim FindString As String

If IsConnected = False Then
MsgBox "Vous devez être connecter à Internet pour récupérer votre adress
IP.", vbInformation, "Adresse IP"
End If

strHTML = GetHTMLFromURL("http://www.showip.com")
FindString = "Your IP address is <b><big><big>"

StringPosition = InStr(1, strHTML, _
FindString, vbTextCompare)
MonIP = Left(Mid(strHTML, StringPosition + Len(FindString)), 13)

End Function




"Gizmo" a écrit dans le message de
news:1775e01c44943$8903f170$
Bonjour,
En VBA,comment récupérer son IP internet derrière un
routeur ?
Merci
Gizmo
Avatar
Anor
Bonjour,

Logipro wrote:
| Bonjour,
|
| Voici le code pour récupérer ton adresse IP d'internet, le principe
| que j'utilise et de télécharger une page Web qui affiche ton adresse
| IP, ensuite je fait qu'extraire l'adresse IP contenu dedans.
|

| "Gizmo" a écrit dans le message
| de news:1775e01c44943$8903f170$
| Bonjour,
| En VBA,comment récupérer son IP internet derrière un
| routeur ?
| Merci
| Gizmo


J'ai un code vba pour récupérer les adresses IP d'un poste.
Il suffit peut être de les passer dans un tableau et de récupérer la dernière
qui ne serait pas la première ?

Pour tester en pas à pas indépendant :
commencer par exécuter le code formload, puis le command1click.

Sinon on peut aussi générer un fichier txt avec le shell ipconfig > fichier.txt,
et extraire les adresses IP....
pb : il faudrait simuler les différences :
1 - sans carte réseau
2 - avec 1 carte réseau
3 - avec 2 cartes réseau local
4 - déconnecté
5 - etc...

Donc contentons nous de cette fonction par exemple ....

<CODE>
Option Compare Database
Option Explicit

Declare Function WSAStartup Lib "wsock32.dll" _
(ByVal wVersionRequired As Integer, _
ByRef lpWSAData As WSADATA) As Long

Declare Function WSACleanup Lib "wsock32.dll" () _
As Long

Declare Function gethostbyname Lib "wsock32.dll" _
(ByVal name As String) As Long
Declare Function gethostname Lib "wsock32.dll" _
(ByVal name As String, _
ByVal namelen As Long) As Long

Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal length As Long)

Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
(ByVal lpString As String) As Long

Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription As String * 257
szSystemStatus As String * 129
iMaxSockets As Long
iMaxUdpDg As Long
lpVendorInfo As Long
End Type

Type HOSTENT
hname As Long
haliases As Long
haddrtype As Integer
hlength As Integer
haddrlist As Long
End Type

'WSAStartup Rückgabe-Konstanten
Const WSAEFAULT = 10014 'Die übergebene Struktur ist keine gültige WSADATA-Struktur
Const WSAEINPROGRESS = 10036 'Eine Winsock 1.1 Blocking operation ist noch nicht beendet
Const WSAEPROCLIM = 10067 'Das limit der verfügbaren Winsocksitzungen ist erreicht
Const WSASYSNOTREADY = 10091 'Das Netzwerk ist nicht bereit für eine Netzwerkkuminikation
Const WSAVERNOTSUPPORTED = 10092 'Die angebene WInsockversion wird nicht unterstützt

'HOSTENT haddrtype-Konstanten
Const AF_12844 = 25 'IEEE 1284.4 WG AF Protokoll
Const AF_APPLETALK = 16 'Appletalk Protokoll
Const AF_ATM = 22 'Native ATM services Protokoll
Const AF_BAN = 21 'Banyan Protokoll
Const AF_CCITT = 10 'Eines der CCITT Protokolle
Const AF_CHAOS = 5 'Eines der MIT CHAOS Protokolle
Const AF_CLUSTER = 24 'Microsoft Wolfpack Protokoll
Const AF_DATAKIT = 9 'Eines der Datakit Protokolle
Const AF_DECnet = 12 'DECnet Protokoll
Const AF_DLI = 13 'Direct Data Link interface
Const AF_ECMA = 8 'ein European Computer Manufacturers Protokoll
Const AF_FIREFOX = 19 'ein FireFox Protokoll
Const AF_HYLINK = 15 'NSC Hyperchannel Protokoll
Const AF_IMPLINK = 3 'Arpanet IMP Adresse
Const AF_INET = 2 'Internet Protokoll (UDP/IP oder TCP/IP).
Const AF_INET6 = 23 'Internet oder andere inter-network Adressen die IPv6 Adressen benutzten
Const AF_IPX = 6 'Eines der IPX Protokolle wie IPX oder SPX
Const AF_ISO = 7 'eines der ISO Protokolle
Const AF_LAT = 14 'LAT Protokoll
Const AF_NETBIOS = 17 'NetBIOS Protokoll
Const AF_NS = 6 'Eines der Xerox NS prtokolle die IPX beinhalten
Const AF_PUP = 4 'eine PUP Protokoll Adresse
Const AF_SNA = 11 'IBM SNA Protokoll
Const AF_UNIX = 1 'Ein Unix-typ local-to-host pipe oder portal.
Const AF_UNKNOWN1 = 20 'Ein unbekanntes Protokoll
Const AF_VOICEVIEW = 18 'VoiceView Protokoll

Dim DataWSA As WSADATA
Dim IpAddress() As Byte
Dim strHostName As String

'Aktuellen Host-Namen ermitteln und in das Textfeld übertragen

Sub Form_Load()

Dim RetVal As Long, HostName As String * 256

'Starten einer Winsocksitzung
RetVal = WSAStartup(&H202, DataWSA)
If RetVal <> 0 Then Exit Sub

RetVal = gethostname(HostName, Len(HostName))
If RetVal <> 0 Then
strHostName = "www.microsoft.com"
Else
strHostName = Left$(HostName, InStr(1, HostName, vbNullChar) - 1)
End If
End Sub


'IP-Adresse einer Internet- oder Intranet-Adresse ermitteln

Sub Command1_Click()
Dim RetVal As Long, pHost As Long, HostInfo As HOSTENT
Dim pIP As Long, IP As String, i As Long, j As Long, HostName As String

'Informationen des Host ermitteln
pHost = gethostbyname(strHostName)
If pHost = 0 Then
msgbox "Der Host unter der angegebenen Adresse wurde nicht gefunden"
Exit Sub
Else
MoveMemory HostInfo, ByVal pHost, Len(HostInfo)
End If

HostName = Space(255)
lstrcpy HostName, HostInfo.hname

'Alle IP-Adrssen des Host ermitteln
Do
'Pointer der nächsten IP Adresse aus der IP-Adressen Liste ermitteln
ReDim IpAddress(HostInfo.hlength - 1)
MoveMemory pIP, ByVal HostInfo.haddrlist + j, 4
If pIP = 0 Then Exit Do

'IP Adresse in das Array Kopieren
MoveMemory IpAddress(0), ByVal pIP, HostInfo.hlength

'IP Adresse auswerten
For i = LBound(IpAddress) To UBound(IpAddress)
IP = IP & CStr(IpAddress(i)) & "."
Next i
IP = Left$(IP, Len(IP) - 1)
IP = IP & " , "
j = j + 4
Loop
IP = Left$(IP, Len(IP) - 3)

'IP Addresse ausgeben
msgbox "Die IP Adressen lauten: " & IP, , "Host: " & Left$(HostName, InStr(1, HostName,
vbNullChar) - 1)
End Sub

Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call WSACleanup
End Sub
</CODE>


--
à+
Arnaud
--------------------------------------------------
Conseils d'utilisation : http://users.skynet.be/mpfa/
Site Perso : http://memoaccess.free.fr
/Réponses souhaitées sur ce forum, merci/
--------------------------------------------------