Bonjour,
Je chercheve à obtenir via VBA, le nom de domaine d'une adresse IP.
Merci pour votre aide.
Cordialement.
Bonjour,
Je chercheve à obtenir via VBA, le nom de domaine d'une adresse IP.
Merci pour votre aide.
Cordialement.
Bonjour,
Je chercheve à obtenir via VBA, le nom de domaine d'une adresse IP.
Merci pour votre aide.
Cordialement.
Bonjour.
En cherchant (bien), j'ai trouvé le code suivant :
Note : la macro originale est en allemand. J'ai traduit les intitulés des
InputBox qui vont bien. En cas d'erreur, tu te retrouveras avec des libellés
germaniques. La macro à exécuter est "Test".
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1
Public Const WSADESCRIPTION_LEN = 257
Public Const WSASYS_STATUS_LEN = 129
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type
Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type
Private Const AF_INET As Long = 2
Private Declare Function WSAStartupInfo Lib "WSOCK32" _
Alias "WSAStartup" (ByVal wVersionRequested As Integer, _
lpWSADATA As WSAData) As Long
Private Declare Function WSACleanup Lib "WSOCK32" _
() As Long
Private Declare Function WSAStartup Lib "WSOCK32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSAData) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32" _
(szHost As Any, ByVal dwHostLen As Integer, _
dwSocketType As Integer) As Long
Private Declare Function inet_addr Lib "WSOCK32" _
(ByVal cp As String) As Long
Private Declare Function gethostbyname Lib "WSOCK32" _
(ByVal szHost As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (hpvDest As Any, _
ByVal hpvSource As Long, ByVal cbCopy As Long)
Sub test()
Dim Testhost As String
Dim IP As String
Testhost = InputBox("Entre ton adresse", _
"IP abfragen", "t-online.de")
If Testhost = "" Then Exit Sub
IP = IP_von_Hostname(Testhost)
If IP = "" Then
MsgBox "Kann Hostname nicht auflösen"
Exit Sub
End If
Testhost = Hostname_von_IP(IP)
If Testhost = "" Then
MsgBox "Kann IP nicht auflösen"
Exit Sub
End If
MsgBox Testhost, , "Hostname de" & IP
End Sub
Public Function IP_von_Hostname(ByVal Hoststring As String) _
As String
Dim strHostname As String * 256
Dim lp_to_Hostent As Long
Dim udtHost As HOSTENT
Dim lngIP As Long
Dim buffer(1 To 4) As Byte
Dim a As Long
If Not Initialisierung() Then Exit Function
strHostname = Hoststring & vbNullChar
lp_to_Hostent = gethostbyname(strHostname)
If lp_to_Hostent = 0 Then
WSACleanup
Exit Function
End If
With udtHost
CopyMemory udtHost, lp_to_Hostent, Len(udtHost)
CopyMemory lngIP, .hAddrList, 4
CopyMemory buffer(1), lngIP, 4
For a = 1 To 4
IP_von_Hostname = IP_von_Hostname _
& buffer(a) & "."
Next
End With
IP_von_Hostname = Left$(IP_von_Hostname, _
Len(IP_von_Hostname) - 1)
WSACleanup
End Function
Public Function Hostname_von_IP(ByVal IP_String As String) _
As String
Dim lngNetwByteOrder As Long
Dim lp_to_Hostent As Long
Dim udtHost As HOSTENT
Dim buffer(1 To 4) As Byte
If Not Initialisierung() Then Exit Function
lngNetwByteOrder = inet_addr(IP_String)
CopyMemory buffer(1), VarPtr(lngNetwByteOrder), 4
lp_to_Hostent = gethostbyaddr(buffer(1), 4, AF_INET)
If lp_to_Hostent = 0 Then WSACleanup: Exit Function
CopyMemory udtHost, lp_to_Hostent, Len(udtHost)
Hostname_von_IP = String(256, 0)
CopyMemory ByVal Hostname_von_IP, udtHost.hName, 255
Hostname_von_IP = Left$(Hostname_von_IP, _
InStr(1, Hostname_von_IP, vbNullChar) - 1)
WSACleanup
End Function
Public Function Initialisierung() As Boolean
Dim udtWSAData As WSAData
If WSAStartup(MIN_SOCKETS_REQD, udtWSAData) = SOCKET_ERROR Then
Initialisierung = False
Exit Function
End If
Initialisierung = True
End Function
Kordialement.
Daniel
"Tony" a écrit dans le message de news:Bonjour,
Je chercheve à obtenir via VBA, le nom de domaine d'une adresse IP.
Merci pour votre aide.
Cordialement.
Bonjour.
En cherchant (bien), j'ai trouvé le code suivant :
Note : la macro originale est en allemand. J'ai traduit les intitulés des
InputBox qui vont bien. En cas d'erreur, tu te retrouveras avec des libellés
germaniques. La macro à exécuter est "Test".
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1
Public Const WSADESCRIPTION_LEN = 257
Public Const WSASYS_STATUS_LEN = 129
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type
Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type
Private Const AF_INET As Long = 2
Private Declare Function WSAStartupInfo Lib "WSOCK32" _
Alias "WSAStartup" (ByVal wVersionRequested As Integer, _
lpWSADATA As WSAData) As Long
Private Declare Function WSACleanup Lib "WSOCK32" _
() As Long
Private Declare Function WSAStartup Lib "WSOCK32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSAData) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32" _
(szHost As Any, ByVal dwHostLen As Integer, _
dwSocketType As Integer) As Long
Private Declare Function inet_addr Lib "WSOCK32" _
(ByVal cp As String) As Long
Private Declare Function gethostbyname Lib "WSOCK32" _
(ByVal szHost As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (hpvDest As Any, _
ByVal hpvSource As Long, ByVal cbCopy As Long)
Sub test()
Dim Testhost As String
Dim IP As String
Testhost = InputBox("Entre ton adresse", _
"IP abfragen", "t-online.de")
If Testhost = "" Then Exit Sub
IP = IP_von_Hostname(Testhost)
If IP = "" Then
MsgBox "Kann Hostname nicht auflösen"
Exit Sub
End If
Testhost = Hostname_von_IP(IP)
If Testhost = "" Then
MsgBox "Kann IP nicht auflösen"
Exit Sub
End If
MsgBox Testhost, , "Hostname de" & IP
End Sub
Public Function IP_von_Hostname(ByVal Hoststring As String) _
As String
Dim strHostname As String * 256
Dim lp_to_Hostent As Long
Dim udtHost As HOSTENT
Dim lngIP As Long
Dim buffer(1 To 4) As Byte
Dim a As Long
If Not Initialisierung() Then Exit Function
strHostname = Hoststring & vbNullChar
lp_to_Hostent = gethostbyname(strHostname)
If lp_to_Hostent = 0 Then
WSACleanup
Exit Function
End If
With udtHost
CopyMemory udtHost, lp_to_Hostent, Len(udtHost)
CopyMemory lngIP, .hAddrList, 4
CopyMemory buffer(1), lngIP, 4
For a = 1 To 4
IP_von_Hostname = IP_von_Hostname _
& buffer(a) & "."
Next
End With
IP_von_Hostname = Left$(IP_von_Hostname, _
Len(IP_von_Hostname) - 1)
WSACleanup
End Function
Public Function Hostname_von_IP(ByVal IP_String As String) _
As String
Dim lngNetwByteOrder As Long
Dim lp_to_Hostent As Long
Dim udtHost As HOSTENT
Dim buffer(1 To 4) As Byte
If Not Initialisierung() Then Exit Function
lngNetwByteOrder = inet_addr(IP_String)
CopyMemory buffer(1), VarPtr(lngNetwByteOrder), 4
lp_to_Hostent = gethostbyaddr(buffer(1), 4, AF_INET)
If lp_to_Hostent = 0 Then WSACleanup: Exit Function
CopyMemory udtHost, lp_to_Hostent, Len(udtHost)
Hostname_von_IP = String(256, 0)
CopyMemory ByVal Hostname_von_IP, udtHost.hName, 255
Hostname_von_IP = Left$(Hostname_von_IP, _
InStr(1, Hostname_von_IP, vbNullChar) - 1)
WSACleanup
End Function
Public Function Initialisierung() As Boolean
Dim udtWSAData As WSAData
If WSAStartup(MIN_SOCKETS_REQD, udtWSAData) = SOCKET_ERROR Then
Initialisierung = False
Exit Function
End If
Initialisierung = True
End Function
Kordialement.
Daniel
"Tony" <Tony@discussions.microsoft.com> a écrit dans le message de news:
BFBED0D9-81DE-45FE-90F8-617A94C81144@microsoft.com...
Bonjour,
Je chercheve à obtenir via VBA, le nom de domaine d'une adresse IP.
Merci pour votre aide.
Cordialement.
Bonjour.
En cherchant (bien), j'ai trouvé le code suivant :
Note : la macro originale est en allemand. J'ai traduit les intitulés des
InputBox qui vont bien. En cas d'erreur, tu te retrouveras avec des libellés
germaniques. La macro à exécuter est "Test".
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const SOCKET_ERROR As Long = -1
Public Const WSADESCRIPTION_LEN = 257
Public Const WSASYS_STATUS_LEN = 129
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type
Public Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type
Private Const AF_INET As Long = 2
Private Declare Function WSAStartupInfo Lib "WSOCK32" _
Alias "WSAStartup" (ByVal wVersionRequested As Integer, _
lpWSADATA As WSAData) As Long
Private Declare Function WSACleanup Lib "WSOCK32" _
() As Long
Private Declare Function WSAStartup Lib "WSOCK32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSAData) As Long
Private Declare Function gethostbyaddr Lib "WSOCK32" _
(szHost As Any, ByVal dwHostLen As Integer, _
dwSocketType As Integer) As Long
Private Declare Function inet_addr Lib "WSOCK32" _
(ByVal cp As String) As Long
Private Declare Function gethostbyname Lib "WSOCK32" _
(ByVal szHost As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (hpvDest As Any, _
ByVal hpvSource As Long, ByVal cbCopy As Long)
Sub test()
Dim Testhost As String
Dim IP As String
Testhost = InputBox("Entre ton adresse", _
"IP abfragen", "t-online.de")
If Testhost = "" Then Exit Sub
IP = IP_von_Hostname(Testhost)
If IP = "" Then
MsgBox "Kann Hostname nicht auflösen"
Exit Sub
End If
Testhost = Hostname_von_IP(IP)
If Testhost = "" Then
MsgBox "Kann IP nicht auflösen"
Exit Sub
End If
MsgBox Testhost, , "Hostname de" & IP
End Sub
Public Function IP_von_Hostname(ByVal Hoststring As String) _
As String
Dim strHostname As String * 256
Dim lp_to_Hostent As Long
Dim udtHost As HOSTENT
Dim lngIP As Long
Dim buffer(1 To 4) As Byte
Dim a As Long
If Not Initialisierung() Then Exit Function
strHostname = Hoststring & vbNullChar
lp_to_Hostent = gethostbyname(strHostname)
If lp_to_Hostent = 0 Then
WSACleanup
Exit Function
End If
With udtHost
CopyMemory udtHost, lp_to_Hostent, Len(udtHost)
CopyMemory lngIP, .hAddrList, 4
CopyMemory buffer(1), lngIP, 4
For a = 1 To 4
IP_von_Hostname = IP_von_Hostname _
& buffer(a) & "."
Next
End With
IP_von_Hostname = Left$(IP_von_Hostname, _
Len(IP_von_Hostname) - 1)
WSACleanup
End Function
Public Function Hostname_von_IP(ByVal IP_String As String) _
As String
Dim lngNetwByteOrder As Long
Dim lp_to_Hostent As Long
Dim udtHost As HOSTENT
Dim buffer(1 To 4) As Byte
If Not Initialisierung() Then Exit Function
lngNetwByteOrder = inet_addr(IP_String)
CopyMemory buffer(1), VarPtr(lngNetwByteOrder), 4
lp_to_Hostent = gethostbyaddr(buffer(1), 4, AF_INET)
If lp_to_Hostent = 0 Then WSACleanup: Exit Function
CopyMemory udtHost, lp_to_Hostent, Len(udtHost)
Hostname_von_IP = String(256, 0)
CopyMemory ByVal Hostname_von_IP, udtHost.hName, 255
Hostname_von_IP = Left$(Hostname_von_IP, _
InStr(1, Hostname_von_IP, vbNullChar) - 1)
WSACleanup
End Function
Public Function Initialisierung() As Boolean
Dim udtWSAData As WSAData
If WSAStartup(MIN_SOCKETS_REQD, udtWSAData) = SOCKET_ERROR Then
Initialisierung = False
Exit Function
End If
Initialisierung = True
End Function
Kordialement.
Daniel
"Tony" a écrit dans le message de news:Bonjour,
Je chercheve à obtenir via VBA, le nom de domaine d'une adresse IP.
Merci pour votre aide.
Cordialement.
