Die Community zu .NET und Classic VB.

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

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

 von Helge Rex

Schwierigkeitsgrad:

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  ---

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.