Ping-Befehl aus Excel-Tabelle

[Hans Meier]

Hallo,

Ich verwalte eine IP-Liste mit mehrern Hundert IP's. Nun
wollte ich eine zusätzliche Spalte erzeugen, indem man
einen Link/Button anklicken kann. Dieser Link soll den
Ping-Befehl auslösen der z.B. einen Ping für das Feld A1
(das Feld A1 enthält die IP)auslöst.

Ist sowas überhaupt möglich?

MfG Hans Meier

[Helma Spona]

Hallo Hans

Ist sowas überhaupt möglich?

Ich denke schon. Versuch es mal mit einer VBA-Funktion die den PING
mit Shell. ausführt. Sollte eigentlich gehen.

--
Helma Spona
http://www.s-v-g.net
http://www.helma-spona.de

[Michael Schwimmer]

>"Hans Meier" <senn...@gmx.de> schrieb im Newsbeitrag
news:62a001c1dee6$c7198f70$a4e62ecf@tkmsftngxa06...

>Ich verwalte eine IP-Liste mit mehrern Hundert IP's. Nun
>wollte ich eine zusätzliche Spalte erzeugen, indem man
>einen Link/Button anklicken kann. Dieser Link soll den
>Ping-Befehl auslösen der z.B. einen Ping für das Feld A1
>(das Feld A1 enthält die IP)auslöst.

Hallo Hans,
wie Helma schon sagt, via Shell einen Ping abgesetzt und die
Ausgabe in eine Textdatei umgeleitet. Hab ich aber noch nicht
probiert.
Man kann auch mittels einiger API-Funktionen einen
Ping absetzen. Das ist aber sehr viel mehr Aufwand.

Von meiner Homepage kannst du dir als Beispiel eine
Excel-Datei herunterladen. Es ist nichts geschützt.

http://schwimmer.bei.t-online.de/ unter Excel/VBA

Hier etwas Code:

Public Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const AF_INET As Long = 2
Private Type Hostent
hName As Long
hAliases As Long
hAddrType As Integer
hLen As Integer
hAddrList As Long
End Type

Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Private Type IP_OPTION_INFORMATION
TTL As Byte
Tos As Byte
Flags As Byte
OptionsSize As Long
OptionsData As String * 128
End Type

Private Type IP_ECHO_REPLY
Address(0 To 3) As Byte
Status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
data As Long
Options As IP_OPTION_INFORMATION
End Type

Private Declare Function gethostbyaddr _
Lib "WSOCK32" _
(szHost As Any, _
ByVal dwHostLen As Integer, _
dwSocketType As Integer) As Long

Private Declare Function GetHostByName _
Lib "wsock32.dll" Alias "gethostbyname" _
(ByVal Hostname As String) As Long

Private Declare Function WSAStartup _
Lib "WSOCK32" _
(ByVal wVersionRequired As Long, _
lpWSAdata As WSAdata) As Long

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

Private Declare Sub CopyMemory _
Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, _
ByVal hpvSource As Long, _
ByVal cbCopy As Long)

Private Declare Function inet_addr _
Lib "WSOCK32" _
(ByVal cp As String) As Long
Private Declare Function IcmpCreateFile _
Lib "icmp.dll" _
() As Long

Private Declare Function IcmpCloseHandle _
Lib "icmp.dll" _
(ByVal HANDLE As Long) As Boolean

Private Declare Function IcmpSendEcho _
Lib "ICMP" _
(ByVal IcmpHandle As Long, _
ByVal DestAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Integer, _
RequestOptns As IP_OPTION_INFORMATION, _
ReplyBuffer As IP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal TimeOut As Long) _
As Boolean

Private Type LngIP
LngIP As Long
End Type

Private Type IP
Byte4 As Byte
Byte3 As Byte
Byte2 As Byte
Byte1 As Byte
End Type

Sub test()
Dim Hoststring As String
Hoststring = "t-online.de"
MsgBox "IP als Long " & Lng_IP_von_Hostname(Hoststring)
MsgBox Hoststring
MsgBox Hostname_von_IP(Hoststring)
MsgBox "Antwort nach " + _
CStr(VbaPingen(Hoststring)) + " ms"
End Sub

Public Function VbaPingen(HostIp As String) As Long
Dim hlngFile As Long
Dim OptInfo As IP_OPTION_INFORMATION
Dim EchoReply As IP_ECHO_REPLY
Dim LngHostIP As Long
Dim strRequestData As String
Dim lngTimeout As Long
'String IP nach Long umwandeln
LngHostIP = Lng_IP_von_IP(HostIp)
If Not Initialisierung() Then Exit Function
strRequestData = String(32, "x")
lngTimeout = 3000
hlngFile = IcmpCreateFile()
OptInfo.TTL = 255
If IcmpSendEcho(hlngFile, LngHostIP, _
strRequestData, Len(strRequestData), _
OptInfo, EchoReply, Len(EchoReply) + 8, _
lngTimeout) Then
With EchoReply
VbaPingen = .RoundTripTime
' MsgBox "RoundTripTime " & CStr(.RoundTripTime)
' MsgBox "LngHostIP " & CStr(LngHostIP)
' MsgBox "Adress " & CStr(.Address)
' MsgBox "Data " & CStr(.data)
' MsgBox "DataSize " & CStr(.DataSize)
' MsgBox "Status " & CStr(.Status)
' MsgBox "TTL " & CStr(.Options.TTL)
End With
End If
IcmpCloseHandle hlngFile
WSACleanup
End Function

Private 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

Private Function Lng_IP_von_IP(ByVal strIP As String) As Long
Dim IP As IP, LIP As LngIP
On Error Resume Next
IP.Byte4 = CLng(Left$(strIP, InStr(1, strIP, ".") - 1))
strIP = Right$(strIP, Len(strIP) - InStr(1, strIP, "."))
IP.Byte3 = CLng(Left$(strIP, InStr(1, strIP, ".") - 1))
strIP = Right$(strIP, Len(strIP) - InStr(1, strIP, "."))
IP.Byte2 = CLng(Left$(strIP, InStr(1, strIP, ".") - 1))
strIP = Right$(strIP, Len(strIP) - InStr(1, strIP, "."))
IP.Byte1 = CLng(strIP)
LSet LIP = IP
Lng_IP_von_IP = LIP.LngIP
End Function

Public Function Lng_IP_von_Hostname(Hoststring As String) As Long
'Wenn Hoststring als Referenz übergeben wurde, dann
'wird IP als Hoststring in gewohnter Notation
'zurückgegeben (192.168.100.2)
Dim strHostname As String * 256
Dim lp_to_Hostent As Long
Dim IP_von_Hostname As String
Dim udtHost As Hostent
Dim LngIP As Long
Dim buffer(1 To 4) As Byte
Dim a As Long
On Error Resume Next
If Not Initialisierung() Then Exit Function
strHostname = Hoststring & vbNullChar
Hoststring = ""
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
CopyMemory Lng_IP_von_Hostname, LngIP, 4
For a = 1 To 4
Hoststring = Hoststring _
& buffer(a) & "."
Next
Hoststring = Left$(Hoststring, Len(Hoststring) - 1)
End With
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

MfG
Michael