Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

RAS IP-Adresse ermitteln

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Windows-spezifische Fragen
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
oldirty



Anmeldungsdatum: 04.08.2005
Beiträge: 65

BeitragVerfasst am: 16.10.2006, 22:28    Titel: RAS IP-Adresse ermitteln Antworten mit Zitat

Hallo,

habe einen Code von vbarchiv "versucht" nach FreeBasic zu portieren:
Code:

'Quelle:
'http://www.vbarchiv.net/archiv/tipp_details.php?pid=1169

'Beschreibung
'
'Mit nachfolgendem Tipp lässt sich die eigene Internet-IP-Adresse, sowie die IP-Adresse Ihres Internet-Providers ermitteln. Hierzu wird zunächst nach einer aktiven Internet-Verbindung gesucht und das Handle ermitteln. Anhand des Verbindungs-Handles werden dann über die API-Funktion RasGetProjectionInfo die erweiterten Infos zur IP-Adresse ermittelt.
'
'Fügen Sie nachfolgenden Code am besten in ein Modul:

#include "windows.bi"
Option Explicit
screen 18

declare Function RAS_GetIP(ByRef sIPAddress As String, _
  ByRef sServerIPAddress As String) As Integer
declare Function TrimNull(ByVal sString As String) As String

Type RASCONN
  dwSize As Long
  hRasConn As Long
  szEntryName(256) As Byte
  szDeviceType(16) As Byte
  szDeviceName(128) As Byte
End Type

Enum RASPROJECTION
  RASP_Amb = &H10000
  RASP_PppNbf = &H803F&
  RASP_PppIpx = &H802B&
  RASP_PppIp = &H8021&
  RASP_Slip = &H20000
End Enum

Type RASPPPIP
  dwSize As Long
  dwError As Long
  szIpAddress As String * 16
  szServerIpAddress As String * 16
End Type

' eigene IP-Adresse und optional Server-IP-Adresse
' der aktiven Internet-Verbindung ermitteln
Function RAS_GetIP(ByRef sIPAddress As String, _
  ByRef sServerIPAddress As String) As Integer
Dim RasEnumConnections as Function (lpRasCon As Any, lpcb As Long,_
          lpcConnections As Long) As Long
Dim RasGetProjectionInfo as Function (ByVal hRasCon As Long, _
          ByVal RasProjectionType As Long, lpProjection As Any, _
          lpcb As Long) As Long
         
Dim dfue_library As any ptr
dfue_library = DyLibLoad("rasapi32.dll")
RasEnumConnections = DyLibSymbol(dfue_library, "RasEnumConnectionsA")
RasGetProjectionInfo = DyLibSymbol(dfue_library, "RasGetProjectionInfoA")
  Dim lpRasConn(255) As RASCONN
  Dim lpcConnections As Long
  Dim lpcb As Long
  Dim Buffer() As Byte
  Dim nBufSize As Long
  Dim nResult As Long
  Dim oRASInfo As RASPPPIP
  dim as integer result
 
  ' Prüfen, ob eine aktive DFÜ-Verbindung besteht
  lpRasConn(0).dwSize = 412
  lpcb = 256 * lpRasConn(0).dwSize
  RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
  If lpcConnections > 0 Then
    ' Infos zur aktiven DFÜ-Verbindung ermitteln
    oRASInfo.dwSize = sizeof(oRASInfo)
    result = RasGetProjectionInfo(lpRasConn(0).hRasConn, RASP_PppIp, oRASInfo, oRASInfo.dwSize)
    print result
    if result = 0 then
    ' eigene IP-Adressse
      sIPAddress = TrimNull(oRASInfo.szIpAddress)

      ' Server-IP-Adresse des Internet-Providers
      sServerIPAddress = TrimNull(oRASInfo.szServerIpAddress)
      RAS_GetIP = True
    End If
  End If
End Function
' Hilfsfunktion

Function TrimNull(ByVal sString As String) As String
  TrimNull = RTrim$(sString)
End Function

'Beispiel für den Aufruf:
  Dim sIPAddress As String
  Dim sServerIPAddress As String

  If RAS_GetIP(sIPAddress, sServerIPAddress) Then
    print "Eigene IP-Adresse: " & sIPAddress
    print "Server IP-Adresse: " & sServerIPAddress
  Else
    print "keine aktive Internetverbindung vorhanden!"
    print "Oder Fehler"
  End If
sleep


Leider bekomme ich trotz aktiver DFUE-Verbindung keine Angaben. Fehler liegt irgendwo bei result = RasGetProjectionInfo(lpRasConn(0).hRasConn, RASP_PppIp, oRASInfo, oRASInfo.dwSize)

Result liefert den Rückgabewert 632
Ausgelesen mit GetLastError erhalte ich als Erklärung: Überlappender E/A-Vorgang wird verarbeitet

Wenn ich den Original-VBCode in VBasic teste, erhalte ich zumindest die Server-IP.

Vielleicht kann jemand helfen.

Danke

OlDirty
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
ytwinky



Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch

BeitragVerfasst am: 16.10.2006, 23:31    Titel: Antworten mit Zitat

Hi oldirty,
LogFile hat Folgendes geschrieben:
Command executed:
"D:\Sprachen\FreeBASIC\fbc.exe" "D:\Sprachen\FreeBasic\bas\Ras.Bas"

Compiler output:
D:/Sprachen/FreeBasic/bas/Ras.Bas(51) : warning level 0: Suspicious pointer assignment
D:/Sprachen/FreeBasic/bas/Ras.Bas(52) : warning level 0: Passing pointer to scalar, at parameter 1 of DYLIBSYMBOL()
D:/Sprachen/FreeBasic/bas/Ras.Bas(53) : warning level 0: Passing pointer to scalar, at parameter 1 of DYLIBSYMBOL()

Results:
Compilation successful
Generated executable: D:\Sprachen\FreeBasic\bas\Ras.exe

System:
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 0.16 for win32 (target:win32)
OS: Windows XP (build 2600, Service Pack 2)
..wundert mich, daß du dazu nix gesagt hast..
..kannst du das fehlerfrei kompilieren?
Als Ergebnis meldet er dann 632 und die Fehlermeldung für fehlende Verbindung grinsen
Vllt. mag er mein Modem nicht lachen
Ich kann mir gut vorstellen, daß hier die Warnungen des Compilers beachtet werden müssen..
Haste schon beim Autor Bescheid gesagt?
Gruß
ytwinky
_________________
v1ctor hat Folgendes geschrieben:
Yeah, i like INPUT$(n) as much as PRINT USING..
..also ungefähr so, wie ich GOTO..
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
oldirty



Anmeldungsdatum: 04.08.2005
Beiträge: 65

BeitragVerfasst am: 17.10.2006, 07:22    Titel: Antworten mit Zitat

Seltsam, bei mir wird kein Fehler angezeigt.

Muss mal meine Einstellungen bei FBIDE überprüfen. (vermute -lang deprecated). (Verwende 0.17 CVS von ca. Ende September) Werde es heute abend mal testen.

Mal sehen, wenn ich die pointer-warnings überarbeite.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Windows-spezifische Fragen Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz