Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0535: IP (eigene und remote) auslesen

 von 

Beschreibung 

Dieser Tipp liest die eigene IP und die des Einwahlrechners (remote) aus.

Schwierigkeitsgrad:

Schwierigkeitsgrad 3

Verwendete API-Aufrufe:

RtlMoveMemory (CopyMemory), RasEnumConnectionsA (RasEnumConnections), RasGetProjectionInfoA (RasGetProjectionInfo)

Download:

Download des Beispielprojektes [3,22 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'--- Anfang Projektdatei IP (eigene und remote) auslesen.vbp  ---
'--- Anfang Formular "Form1" alias IP (eigene und remote) auslesen.frm  ---
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Textfeld "Text2"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
'
'Autor:  Helge Rex   helge@activevb.de
'
'Auslesen der lokale Internet-Adresse (IP) und die Adresse
'des Einwahlrechners (Remote)

Option Explicit
 
'   API, zum Ermitteln des Handles zur aktiven DFÜ-Verbindung
Private Declare Function RasEnumConnections Lib "rasapi32.dll" _
    Alias "RasEnumConnectionsA" ( _
        lpRasCon As Any, _
        lpcb As Long, _
        lpcConnections As Long _
) As Long
 
'   API, mit der die zugangsdaten ermittelt werden
Private Declare Function RasGetProjectionInfo Lib "rasapi32.dll" _
    Alias "RasGetProjectionInfoA" ( _
        ByVal hRasConn As Long, _
        ByVal rasProjectionType As Long, _
        lpProjection As Any, _
        lpcb As Long _
) As Long
 
'   Eine kleine Speicherschieber-Funktion
Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" ( _
        Destination As Any, _
        Source As Any, _
        ByVal Length As Long _
        )
 
'   Ein paar Konstanten
Private Const RAS_MaxEntryName = 256
Private Const RAS_MaxDeviceType = 16
Private Const RAS_MaxDeviceName = 32
 
'   Datentyp für die DFÜ-Verbindungen
Private Type RASType
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS_MaxEntryName) As Byte
    szDeviceType(RAS_MaxDeviceType) As Byte
    szDeviceName(RAS_MaxDeviceName) As Byte
End Type
 
'   Struktur für das TCP/IP-Protokoll
Private Type VBRASPPPIP
    dwSize As Long
    dwError As Long
    szClientIp As String
    szServerIp As String
End Type
 
'   helper function
Private Sub BytesToString(strToCopyTo As String, AbPosition As Byte, Laenge As Long)
    '   Speicher reservieren
    Dim strTemp As String
    Dim lngLen As Long
    
    '   Speicher zum Hineinkopieren bereitstellen
    strTemp = String(Laenge + 1, 0)
    
    '   Daten kopieren
    CopyMemory ByVal strTemp, AbPosition, Laenge
    
    '   Länge bis zum NullChar ermitteln
    lngLen = InStr(strTemp, Chr$(0)) - 1
    
    '   Rückgabe setzen
    strToCopyTo = Left$(strTemp, lngLen)
End Sub
 
Private Function VBRasGetRASPPPIP(hRasConn As Long, udtRASIP As VBRASPPPIP) As Long
    '    Speicher reservieren
    Dim Buffer() As Byte
    Dim Result As Long
    Dim StructSize As Long
    
    '   Größe der UDT festlegen
    StructSize = 40&
    
    '   Speicher für die API vorbereiten
    ReDim Buffer(StructSize - 1)
    
    '   Größe der UDT in die UDT kopieren
    CopyMemory Buffer(0), StructSize, 4
    
    '   IP-Adressen ermitteln
    Result = RasGetProjectionInfo(hRasConn, &H8021&, Buffer(0), StructSize)
    
    '   Rückgabe setzen
    VBRasGetRASPPPIP = Result
    
    '   War der Aufruf erfolgreich?
    If Result = 0 Then
        '   Ja, alle Daten kopieren
        With udtRASIP
            '   Größe der UDT kopieren
            CopyMemory .dwSize, Buffer(0), 4
            
            '   Fehlercode kopieren
            CopyMemory .dwError, Buffer(4), 4
            
            '   locale IP kopieren
            BytesToString .szClientIp, Buffer(8), 16
                        
            '   remote IP kopieren
            BytesToString .szServerIp, Buffer(24), 16
        End With
    End If
End Function
 
Private Function GetDFUEHandle() As Long
    '   Speicher reservieren
    Dim RAS(0 To 255) As RASType
    Dim StructSize As Long
    Dim DFUECount As Long
    Dim Result As Long
 
    '   Größe der Struktur festlegen
    RAS(0).dwSize = 412
    
    '   Größe der gesamten Abfrage festlegen
    StructSize = (UBound(RAS) - LBound(RAS) + 1) * RAS(0).dwSize
    
    '   Die DFÜ-Verbindungen abfragen
    Result = RasEnumConnections(RAS(0), StructSize, DFUECount)
 
    '   Wurde eine DFÜ-Verbindung gefunden?
    If (DFUECount <> 0) Then
        '   Ja, Handle zurückgeben
        GetDFUEHandle = RAS(0).hRasCon
    Else
        '   Nein, Nix zurückgeben
        GetDFUEHandle = 0
    End If
End Function
 
Private Sub Command1_Click()
    '   Dialog schließen
    Unload Me
End Sub
 
Private Sub Form_Load()
    '   Label und Textbox (eigene IP) beschriften
    Me.Text1.Text = vbNullString
    Me.Text1.Locked = True
    
    '   Label und Textbox (remote IP) beschriften
    Me.Text2.Text = vbNullString
    Me.Text2.Locked = True
    
    '   Timer setzen (5 Sekunden)
    Me.Timer1.Interval = 5000
    Me.Timer1.Enabled = True
    
    ' Gleich aufrufen
    Timer1_Timer
End Sub
 
Private Sub Timer1_Timer()
    '   Speicher reservieren
    Dim RASIP As VBRASPPPIP
    Dim RASHandle As Long
    
    '   Handle der Verbindung ermitteln
    RASHandle = GetDFUEHandle
    
    '   Wurde ein Handle gefunden?
    If (RASHandle <> 0) Then
        '   Ja, IPs abfragen
        Call VBRasGetRASPPPIP(RASHandle, RASIP)
        
        '   IPs mitteilen
        Me.Text1.Text = RASIP.szClientIp
        Me.Text2.Text = RASIP.szServerIp
    Else
        '   Nicht verbunden
        Me.Text1.Text = vbNullString
        Me.Text2.Text = vbNullString
    End If
End Sub



'--- Ende Formular "Form1" alias IP (eigene und remote) auslesen.frm  ---
'--- Ende Projektdatei IP (eigene und remote) auslesen.vbp  ---

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Hannes Biehl am 17.05.2006 um 16:20

Diese VB Funktion ist toll. Leider komme ich mangels ausreichenden Wissens immer noch nicht weiter. Wie kann ich diese Funktion in html einbinden um einen Button mit dem link auf die ausgelesene eigene IP belegen zu können. Das Ergenis Ihrer Function war im Clipboard folgendes:

http://84.188.231.125:1713/IPAusl.vb%20(1)

Mein Problem ist folgendes:

Ich möchte den File-Server von HFS betreiben und diesen von meiner zur Zeit zu erstellenden Home-Page aus aufrufen lassen. Dazu ist es notwendig jeweils meine gültige IP
dem Aufrufenden zu übermitteln. Ich möchte jedoch diese dynamische IP jeweils bei Aufruf der Home-Page abfragen und den link am button für den File-Server jeweils updaten, so dass der Aufrufende jeweils meine richtige IP zum Aufruf im link stehen hat.

Habe schon rumgebastelt wie ein wilder aber mein Wissen reicht einfach nicht aus. Leider hat html nicht die Variablen zur Verfügung wie Basic oder andere Sprachen.
Wenn Sie mir da helfen könnnten, wäre ich sehr dankbar.

In VB wäre es einfacher aber leider wird die Home-Page in html erstellt.

Mit freundlichen Grüssen

Hannes Biehl

Kommentar von Poet am 16.03.2004 um 15:39

Vielen Dank, so was hab ich schon lange gesucht

Kommentar von Olivier am 26.02.2003 um 13:10

Hat geklappt, danke!