Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 18:57:33
17.04.2024 16:56:58
Anzeige
Archiv - Navigation
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
936to940
936to940
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

IP Adresse ermitteln

IP Adresse ermitteln
27.12.2007 15:54:09
SteffenS
Hallo Zusammen,
ich habe mal im Forum gesucht und folgendes Makro für die Ermittlung der IP Adresse gefunden:
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Const MAX_IP = 5 'To make a buffer... i dont think you have more than 5 ip on your pc..
Type IPINFO
dwAddr As Long ' IP address
dwIndex As Long ' interface index
dwMask As Long ' subnet mask
dwBCastAddr As Long ' broadcast address
dwReasmSize As Long ' assembly size
unused1 As Integer ' not currently used
unused2 As Integer '; not currently used
End Type
Type MIB_IPADDRTABLE
dEntrys As Long 'number of entries in the table
mIPInfo(MAX_IP) As IPINFO 'array of IP address entries
End Type
Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type

Public Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long
CopyMemory myByte(0), longAddr, 4
For Cnt = 0 To 2
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function



Public Sub Start()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
Dim IPtext As String
On Error GoTo END1
GetIpAddrTable ByVal 0&, Ret, True
If Ret 


Leider kommt bei mir dort nur 0.0.0.0 raus.
Was mache ich falsch?
Danke im Voraus.
Steffen Schmerler

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: IP Adresse ermitteln
27.12.2007 16:10:00
Christian
Hallo Steffen,
wenn du in der Commandline "ipconfig" eingibst - kommt da denn eine andere Adresse als 0.0.0.0?
Gruß
Christian

beides geht nicht
27.12.2007 16:24:00
SteffenS
Hallo Ihr Beiden,
wenn ich ipconfig eingebe dann bekomme ich meine IP angezeigt.
Bei der Beispielmappe steht da, dass keine aktive Internetverbindung existieren würde.
Aber auch dies ist nicht fall.
An was kann dies liegen?
Danke im Voraus
Steffen Schmerler

Anzeige
AW: beides geht nicht
27.12.2007 16:57:00
Christian
Hallo,
der Code von Sepp bring bei mir auch kein Ergebnis - ist wohl für DFÜ-Verbindung ausgelegt - das geht zumindest aus den Kommentaren hervor.
der Code von dir läuft bei mir und zeigt meine Adresse (privates Netz hinter DSL-Router) an.
Das sind noch ein paar Haken drin, es werden zB nur die ersten 3 Octets angezeigt, aber das sind Kleinigkeiten.
Warum das bei dir nicht läuft - keine Idee - da versteh ich zu wenig von APIs (evt. Rechteproblem?).
Aber was spricht dagegen, ipconfig in der shell auszuführen und sich die IP-Adresse daraus zu holen (siehe code).
Gruß
Christian
Code-Ansatz ohne weitere Fehlerabfangung u.ä.:

Option Explicit
Sub IP()
Dim sTxt$, sTmp$, sIP$, iFile%
Const TMPFILE = "D:\ip.txt"      'anpassen
sTxt = Shell("cmd /c ipconfig >" & TMPFILE, 0)
iFile = FreeFile
Open TMPFILE For Input As #iFile
Do While Not EOF(iFile)
Line Input #iFile, sTmp
If InStr(sTmp, "IP-Adresse") > 0 Then
sIP = Trim(Split(sTmp, ":")(1))
Exit Do
End If
Loop
Close #iFile
Kill TMPFILE
MsgBox sIP
End Sub


Anzeige
AW: beides geht nicht
27.12.2007 18:17:00
anton
Hallo,
noch eine Variante:

Sub eigene_IP_Adresse()
  Set objShell = CreateObject("WScript.Shell")  
  Set objExec = objShell.Exec("ping " & Environ("COMPUTERNAME"))
  strpingresults = LCase(objExec.StdOut.ReadAll)  
  zeilen = Split(strpingresults, vbCrLf)
  For i = 0 To UBound(zeilen)  
    If InStr(zeilen(i), "antwort") Then  
      strIP = Mid(zeilen(i), 13)
      strIP = Left(strIP, InStr(strIP, ":") - 1)
      [A1].Value = strIP
      Exit For  
    End If  
    Set objShell = Nothing  
  Next
End Sub  

mfg Anton

Anzeige
@Anton
27.12.2007 18:57:00
Christian
Hi Anton,
die Idee ist gut - insbesondere, das Result gleich nach StandardOut auszugeben und nicht wie bei meinem Ansatz erst noch ein temp. File zu erzeugen. Bei meinem Code müsste man wahrscheinlich auch noch ein "Sleep 1000" einbauen um sicher zu sein, dass das File geschrieben wurde.
Aber statt dem ping könntest du ja auch gleich ipconfig ausführen à la:

Option Explicit
Sub IpAddress()
Dim oShell As Object, oExec As Object
Dim i&, sIP$, vResult
Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec("ipconfig")
vResult = Split(oExec.StdOut.ReadAll, vbCrLf)
For i = 0 To UBound(vResult)
If InStr(vResult(i), "IP-Adresse") > 0 Then
sIP = Trim(Split(vResult(i), ":")(1))
Exit For
End If
Next
Set oShell = Nothing
Set oExec = Nothing
MsgBox sIP
End Sub

was mich noch stört ist, dass die Shell aufgeht. Haste dazu 'ne Lösung?
Grüße
Christian

Anzeige
SUPER
28.12.2007 12:59:36
SteffenS
der letzte Code hat einwandfrei funktioniert.
Endlich klappt das mit der IP Adresse.
DANKE
Steffen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige