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:

VB->FB: Netzwerk-Karten informationen auslesen per Win-AP

 
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
Mae



Anmeldungsdatum: 04.06.2008
Beiträge: 26

BeitragVerfasst am: 04.06.2008, 18:53    Titel: VB->FB: Netzwerk-Karten informationen auslesen per Win-AP Antworten mit Zitat

Zusammenfassung:
Es geht darum via Win-API die Netzwerk-Karten informationen auszulesen wie es auch bei IPCONFIG gemacht wird.
Der VB-Code ist zu finden auf der BinaryWorld.net-WebSite: Code 3802

Hallo!

Ich bin neu hier und habe vorher mit VB6 gearbeitet.
Leider habe ich beim übersetzen des Codes so meine schwierigkeiten,
was auch daran liegt, das ich gar nicht weiß, wann und wie ich die Pointer richtig einzusetzen habe.
Hier also erst noch mal der Link von dem Original Code:
http://binaryworld.net/Main/CodeDetail.aspx?CodeId=3802

Und nun meine Übersetzungsversuch
System: XP SP2
Compiler: FBC 0.18.3
Compilation: Windows Console
IDE: KetilO FreeBASIC edit 1.0.5.9

Code:

#Include once "windows.bi"
 
Declare Sub ShowIPConfig()

Const MAX_HOSTNAME_LEN = 132
Const MAX_DOMAIN_NAME_LEN = 132
Const MAX_SCOPE_ID_LEN = 260
Const MAX_ADAPTER_NAME_LENGTH = 260
Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132
'Die folgende Zeile wurde schon irgendwo durch "windows.bi" richtig defieniert und wurde daher deaktiviert:
'Const ERROR_BUFFER_OVERFLOW = 111
Const MIB_IF_TYPE_ETHERNET = 6
Const MIB_IF_TYPE_TOKENRING = 9
Const MIB_IF_TYPE_FDDI = 15
Const MIB_IF_TYPE_PPP = 23
Const MIB_IF_TYPE_LOOPBACK = 24
Const MIB_IF_TYPE_SLIP = 28

Type IP_ADDR_STRING
    Next As Long
    IpAddress As String * 16
    IpMask As String * 16
    Context As Long
End Type

Type IP_ADAPTER_INFO
    Next As Long
    ComboIndex As Long
    AdapterName As String * MAX_ADAPTER_NAME_LENGTH
    Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
    AddressLength As Long
    Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
    Index As Long
    Type As Long
    DhcpEnabled As Long
    CurrentIpAddress As Long
    IpAddressList As IP_ADDR_STRING
    GatewayList As IP_ADDR_STRING
    DhcpServer As IP_ADDR_STRING
    HaveWins As Byte
    PrimaryWinsServer As IP_ADDR_STRING
    SecondaryWinsServer As IP_ADDR_STRING
    LeaseObtained As Long
    LeaseExpires As Long
End Type

Type FIXED_INFO
    HostName As String * MAX_HOSTNAME_LEN
    DomainName As String * MAX_DOMAIN_NAME_LEN
    CurrentDnsServer As Long
    DnsServerList As IP_ADDR_STRING
    NodeType As Long
    ScopeId  As String * MAX_SCOPE_ID_LEN
    EnableRouting As Long
    EnableProxy As Long
    EnableDns As Long
End Type

Declare Function GetNetworkParams Lib "IPHlpApi.dll" _
        (FixedInfo As Any Ptr, pOutBufLen As Long Ptr) As Long
Declare Function GetAdaptersInfo Lib "IPHlpApi.dll" _
        (IpAdapterInfo As Any Ptr, pOutBufLen As Long Ptr) As Long

'Die folgende Zeile löst einen Fehler aus.
'...ob sie bereits auch schon durch "windows.bi" deklariert wurde?
'Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
'        (Destination As Any Ptr, Source As Any Ptr, ByVal Length As Long)

'--- Hauptprogramm:
Call ShowIPConfig()
Sleep 50000
end

--- Unterprogramm(e):

Sub ShowIPConfig()
    Dim ErrorValue As Long
    Dim FixedInfoSize As Long
    Dim AdapterInfoSize As Long
    Dim i As Integer
    Dim PhysicalAddress As String
    Dim NewTime As Double '<-Date
    Dim AdapterInfo As IP_ADAPTER_INFO
    Dim AddrStr As IP_ADDR_STRING
    Dim FixedInfo As FIXED_INFO
    Dim Buffer As IP_ADDR_STRING
    Dim pAddrStr As Long Ptr
    Dim pAdapt As Long Ptr
    Dim Buffer2 As IP_ADAPTER_INFO
    Dim FixedInfoBuffer() As Byte
    Dim AdapterInfoBuffer() As Byte

    ' Get the main IP configuration information for this machine
    ' using a FIXED_INFO structure:
    FixedInfoSize = 0
    ErrorValue = GetNetworkParams(ByVal 0&, FixedInfoSize)
    If ErrorValue <> 0 Then
        If ErrorValue <> ERROR_BUFFER_OVERFLOW Then
            Print "GetNetworkParams sizing failed with error " & ErrorValue
            Exit Sub
        End If
    End If
   
    ReDim FixedInfoBuffer(0 To FixedInfoSize - 1)
    ErrorValue = GetNetworkParams(@FixedInfoBuffer(0), FixedInfoSize)
   
    If ErrorValue = 0 Then
        CopyMemory @FixedInfo, @FixedInfoBuffer(0), FixedInfoSize
        Print "Host Name: " & FixedInfo.HostName
        Print "DNS Servers: " & FixedInfo.DnsServerList.IpAddress
        pAddrStr = FixedInfo.DnsServerList.Next
        Do While pAddrStr <> 0
            CopyMemory @Buffer, ByVal pAddrStr, LenB(Buffer)
            Print "DNS Servers: " & Buffer.IpAddress
            pAddrStr = Buffer.Next
        Loop

        Select Case FixedInfo.NodeType
            Case 1
                Print "Node type: Broadcast"
            Case 2
                Print "Node type: Peer to peer"
            Case 4
                Print "Node type: Mixed"
            Case 8
                Print "Node type: Hybrid"
            Case Else
                Print "Node type: UNKNOWN"
        End Select

        Print "NetBIOS Scope ID: " & FixedInfo.ScopeId
        If FixedInfo.EnableRouting Then
            Print "IP Routing Enabled "
        Else
            Print "IP Routing not enabled"
        End If
        If FixedInfo.EnableProxy Then
            Print "WINS Proxy Enabled "
        Else
            Print "WINS Proxy not Enabled "
        End If
        If FixedInfo.EnableDns Then
            Print "NetBIOS Resolution Uses DNS "
        Else
            Print "NetBIOS Resolution Does not use DNS  "
        End If
    Else
        Print "GetNetworkParams failed with error " & errorValue
        Exit Sub
    End If

    ' Enumerate all of the adapter specific information using the
    ' IP_ADAPTER_INFO structure.
    ' Note:  IP_ADAPTER_INFO contains a linked list of adapter entries.

    AdapterInfoSize = 0
    ErrorValue = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
    If ErrorValue <> 0 Then
        If ErrorValue <> ERROR_BUFFER_OVERFLOW Then
            Print "GetAdaptersInfo sizing failed with error " & ErrorValue
            Exit Sub
        End If
    End If

    ReDim AdapterInfoBuffer(AdapterInfoSize - 1)

    ' Get actual adapter information
    ErrorValue = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
    If ErrorValue <> 0 Then
        Print "GetAdaptersInfo failed with error " & ErrorValue
        Exit Sub
    End If

    ' Allocate memory
    CopyMemory AdapterInfo, AdapterInfoBuffer(0), AdapterInfoSize
    pAdapt = AdapterInfo.Next
   
    Dim cnt As Integer
    Do
        cnt = cnt + 1
        Print String(100, "-")
        Print "Adapter [#" & cnt & "]"
        Print String(100, "-")
        CopyMemory Buffer2, AdapterInfo, AdapterInfoSize
        Select Case Buffer2.Type
            Case MIB_IF_TYPE_ETHERNET
                Print Space(5) & "Adapter name: Ethernet adapter "
            Case MIB_IF_TYPE_TOKENRING
                Print Space(5) & "Adapter name: Token Ring adapter "
            Case MIB_IF_TYPE_FDDI
                Print Space(5) & "Adapter name: FDDI adapter "
            Case MIB_IF_TYPE_PPP
                Print Space(5) & "Adapter name: PPP adapter"
            Case MIB_IF_TYPE_LOOPBACK
                Print Space(5) & "Adapter name: Loopback adapter "
            Case MIB_IF_TYPE_SLIP
                Print Space(5) & "Adapter name: Slip adapter "
            Case Else
                Print Space(5) & "Adapter name") & ": Other adapter "
        End Select
        Print Space(5) & "AdapterDescription: " & Buffer2.Description

        PhysicalAddress = ""
        For i = 0 To Buffer2.AddressLength - 1
            PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))
            If i < Buffer2.AddressLength - 1 Then
                PhysicalAddress = PhysicalAddress & "-"
            End If
        Next
        Print Space(5) & "Physical Address: " & PhysicalAddress

        If Buffer2.DhcpEnabled Then
            Print Space(5) & "DHCP Enabled "
        Else
            Print Space(5) & "DHCP disabled"
        End If

        Print Space(5) "IP Address: " & Buffer2.IpAddressList.IpAddress
        Print Space(5) "Subnet Mask: " & Buffer2.IpAddressList.IpMask
        pAddrStr = Buffer2.IpAddressList.Next
        Do While pAddrStr <> 0
            CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer)
            Print Space(5) & "IP Address: " & Buffer.IpAddress
            Print Space(5) & "Subnet Mask: " & Buffer.IpMask
            pAddrStr = Buffer.Next
            If pAddrStr <> 0 Then
                CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, LenB(Buffer2.IpAddressList)
            End If
        Loop

        Print Space(5) & "Default Gateway: " & Buffer2.GatewayList.IpAddress
        pAddrStr = Buffer2.GatewayList.Next
        Do While pAddrStr <> 0
            CopyMemory Buffer, Buffer2.GatewayList, LenB(Buffer)
            Print Space(5) & "IP Address: " & Buffer.IpAddress
            pAddrStr = Buffer.Next
            If pAddrStr <> 0 Then
                CopyMemory Buffer2.GatewayList, ByVal pAddrStr, LenB(Buffer2.GatewayList)
            End If
        Loop

        Print Space(5) & "DHCP Server: " & Buffer2.DhcpServer.IpAddress
        Print Space(5) & "Primary WINS Server: " & Buffer2.PrimaryWinsServer.IpAddress
        Print Space(5) & "Secondary WINS Server": " & Buffer2.SecondaryWinsServer.IpAddress

        ' Display time.
        NewTime = DateAdd("s", Buffer2.LeaseObtained, #1/1/1970#)
        Print Space(5) & "Lease Obtained: " & _
                CStr(Format(NewTime, "dddd, mmm d hh:mm:ss yyyy"))

        NewTime = DateAdd("s", Buffer2.LeaseExpires, #1/1/1970#)
        Print Space(5) & "Lease Expires: " & _
                CStr(Format(NewTime, "dddd, mmm d hh:mm:ss yyyy"))
        pAdapt = Buffer2.Next
        If pAdapt <> 0 Then
            CopyMemory AdapterInfo, ByVal pAdapt, AdapterInfoSize
        End If
    Loop Until pAdapt = 0
           
End Sub
 


Da sind noch jede menge Fehler drin.
Ich hoffe Ihr könnt mir helfen, die schnellstmöglich rauszubekommen?

Liebe Grüße
Mäx
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
volta



Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192

BeitragVerfasst am: 06.06.2008, 13:37    Titel: Antworten mit Zitat

Hi,
ob dabei alle Infos richtig ausgewertet werden kann ich nicht garantieren,
zumindest kompiliert der Code ohne Fehlermeldungen grinsen
Code:
#Include Once "windows.bi"
#Include Once "win/iphlpapi.bi"
#Include Once "vbcompat.bi"

'Sub main()
Dim As Integer erg, FixedInfoSize
Dim FixedInfo As FIXED_INFO
Dim pAddrStr As IP_ADDR_STRING Ptr
erg = GetNetworkParams(0, @FixedInfoSize)
If erg <> 0 Then
  If erg <> ERROR_BUFFER_OVERFLOW Then
    Print "GetNetworkParams sizing failed with error " & erg
    End 'Exit Sub
  End If
End If
erg = GetNetworkParams(@FixedInfo,@FixedInfoSize)
If erg = 0 Then
  Print "Host Name:  " & FixedInfo.HostName
  Print "Domain Name:  " & FixedInfo.DomainName 
  Print "DNS Servers:  " & FixedInfo.DnsServerList.IpAddress.String
  pAddrStr = FixedInfo.DnsServerList.Next

  Do While pAddrStr <> 0
    Print "DNS Servers:  " & pAddrStr->IpAddress.String
    pAddrStr = pAddrStr->Next
  Loop

  Select Case FixedInfo.NodeType
    Case 1
      Print "Node type: Broadcast"
    Case 2
      Print "Node type: Peer to peer"
    Case 4
      Print "Node type: Mixed"
    Case 8
      Print "Node type: Hybrid"
    Case Else
      Print "Unknown node type"
  End Select

  Print "NetBIOS Scope ID:  " & FixedInfo.ScopeId
  If FixedInfo.EnableRouting Then
    Print "IP Routing Enabled "
  Else
    Print "IP Routing not enabled"
  End If
  If FixedInfo.EnableProxy Then
    Print "WINS Proxy Enabled "
  Else
    Print "WINS Proxy not Enabled "
  End If
  If FixedInfo.EnableDns Then
    Print "NetBIOS Resolution Uses DNS "
  Else
    Print "NetBIOS Resolution Does not use DNS  "
  End If
Else
  Print "GetNetworkParams failed with error " & erg
  End 'Exit Sub
End If
Print "---------------"

' Enumerate all of the adapter specific information using the
' IP_ADAPTER_INFO structure.
' Note:  IP_ADAPTER_INFO contains a linked list of adapter entries.
Dim As Integer AdapterInfoSize, AdapterNr
Dim PhysicalAddress As String
erg = GetAdaptersInfo(0, @AdapterInfoSize)
If erg <> 0 Then
  If erg <> ERROR_BUFFER_OVERFLOW Then
    Print "GetAdaptersInfo sizing failed with error " & erg
    End 'Exit Sub
  End If
End If

AdapterNr=AdapterInfoSize / SizeOf(IP_ADAPTER_INFO)
Dim AdapterInfo (0 To AdapterNr-1) As IP_ADAPTER_INFO
' Get actual adapter information
erg = GetAdaptersInfo(@AdapterInfo(0), @AdapterInfoSize)
If erg <> 0 Then
  Print "GetAdaptersInfo failed with error " & erg
  End 'Exit Sub
End If
For i As Integer = 0 To AdapterNr-1
  With AdapterInfo(i)
    Select Case .Type
      Case MIB_IF_TYPE_ETHERNET
        Print "Adapter name: Ethernet adapter "
      Case MIB_IF_TYPE_TOKENRING
        Print "Adapter name: Token Ring adapter "
      Case MIB_IF_TYPE_FDDI
        Print "Adapter name: FDDI adapter "
      Case MIB_IF_TYPE_PPP
        Print "Adapter name: PPP adapter"
      Case MIB_IF_TYPE_LOOPBACK
        Print "Adapter name: Loopback adapter "
      Case MIB_IF_TYPE_SLIP
        Print "Adapter name: Slip adapter "
      Case Else
        Print "Adapter name: " & .AdapterName
    End Select
    Print "AdapterDescription: " & .Description
    PhysicalAddress = ""
    For j As Integer = 0 To .AddressLength - 1
      PhysicalAddress = PhysicalAddress & Hex(.Address(j))
      If j < .AddressLength - 1 Then
        PhysicalAddress = PhysicalAddress & "-"
      End If
    Next
    Print "Physical Address: " & PhysicalAddress
    Print "IP Address: " & .IpAddressList.IpAddress.String
    Print "Subnet Mask: " & .IpAddressList.IpMask.String'
    Print "Default Gateway: " & .GatewayList.IpAddress.String'
    If .DhcpEnabled Then
      Print "DHCP Enabled "
      Print "DHCP Server: " & .DhcpServer.IpAddress.String
      Print "Primary WINS Server: " & .PrimaryWinsServer.IpAddress.String
      Print "Secondary WINS Server: " & .SecondaryWinsServer.IpAddress.String
      ' Display time.
      Print "Lease Obtained: "; Format((.LeaseObtained / 86400) + 25569, "dd.mm.yyyy, hh:mm:ss")
      Print "Lease Expires : "; Format((.LeaseExpires / 86400) + 25569, "dd.mm.yyyy, hh:mm:ss")
    Else
      Print "DHCP disabled"
    End If
    Print "---------------"
    Sleep
  End With
Next
'End Sub

Print "Ende"
Sleep

EDIT/
kleine Änderungen (7.6.08 10:13)
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
Mae



Anmeldungsdatum: 04.06.2008
Beiträge: 26

BeitragVerfasst am: 08.06.2008, 09:08    Titel: Vielen Dank! Antworten mit Zitat

Herzlichen Dank!

Nun werd' ich mir das auch hinter die Ohren schreiben, welche BIs ich einbinden muß...

Danke!
Und liebe Grüße
Mäx
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Mae



Anmeldungsdatum: 04.06.2008
Beiträge: 26

BeitragVerfasst am: 10.06.2008, 14:27    Titel: ...doch noch Fragen... Antworten mit Zitat

Als ich versucht habe den Code für ein Tutorial zu kommentiern, bin ich noch auf ein paar Fragen gestoßen, die nun als Kommentare an entsprechender Stelle stehen:

Code:

' Code Modul für FreeBasicCompiler 0.18.3
'------------------------------------------------------------------------------
' getestet auf Windows XP mit FBC 0.18.3 von Maeex
'------------------------------------------------------------------------------
' FBC (0.18.3)
' #INCLUDE ONCE "windows.bi"
' #INCLUDE ONCE "win/iphlpapi.bi"
' #INCLUDE ONCE "vbcompat.bi"
'
' Dieses Modul fragt die Netzwerk-Konfiguration ab.
' Der Orignal Code kommt von dieser Site:
' http://binaryworld.net/Main/CodeDetail.aspx?CodeId=3802
' und wurde von VOLTA das erste mal fehlerfrei übersetzt - Danke VOLTA!
'                                                         Liebe Grüße Mäx
'------------------------------------------------------------------------------

SUB NetzwerkKarten()
   ' Diese Routine erfaßt Daten wie IPConfig aus Windows-API
   '-----------------------------------------------------------------------------

   ' 1. Variable deklaration:
   '--------------------------   
  DIM AS INTEGER Erg, FixedInfoSize      'RückgabeWert der API und Buffergröße
  DIM FixedInfo AS FIXED_INFO            'UDT wird deklariert in ipTypes.bi
                                         '...eingebunden über ipHlpApi.bi
 
  'DIM pAddrStr AS IP_ADDR_STRING Ptr    'Adress-Zeiger auf UDT
  Dim pAddrStr As PIP_ADDR_STRING
 
  ' 2. Speicher Buffer messen:
  '----------------------------
  'Welche Buffergröße wird benötigt für die Datenrückgabe?
  'Dazu einen Bufferüberlauf auslösen:
  Erg = GetNetworkParams(0, @FixedInfoSize)
  IF Erg <> 0 THEN
    IF Erg <> ERROR_BUFFER_OVERFLOW THEN
      PRINT "GetNetworkParams sizing failed with Error: " & Erg
      EXIT SUB
    END If
  Else
     'Nanu? Kein Bufferüberlauf? - vielleicht kein Netzwerk eingerichtet?
     PRINT "GetNetworkParams sizing failed: " & Erg
     Exit Sub 
  END If
 
  ' 3. Speicher reservieren
  'Warum hier jetzt nicht der DatenBuffer reserviert werden muß?
  'Kein ReDim, Relocate... oder so... ?
  'Wozu ist eigentlich in iptypes.bi noch der UDT "PFIXED_INFO" deklariert?
  'Vermutlich weil in FB richtig mit Zeigern arbeiten?
  'Der Block 2. könnte dann eigentlich wegfallen, wenn die Buffergröße
  'nicht für eine Speicherreservierung benuttz werden muß - mh? 
 
  ' 4. Informationen von API übergeben lassen:
  '--------------------------------------------
  'Informationen werden nun über die Zeiger in den Speicherbereich übertragen:
   Erg = GetNetworkParams(@FixedInfo,@FixedInfoSize)
   IF Erg = 0 THEN
     PRINT "Hostname:    " & FixedInfo.HostName
     PRINT "Domainname:  " & FixedInfo.DomainName
        
     'Die folgende Zeile liefert einen falschen Wert, da noch nicht
     'auf die richtige Adresse gezeigt wird - oder?
     'PRINT "DNS-Servers:  " & FixedInfo.DnsServerList.IpAddress.string
      
     pAddrStr = FixedInfo.DnsServerList.next 'Aber jetzt!
     Print "DNS-Server(s): "
     DO WHILE pAddrStr <> 0
       PRINT "  IP-Adresse:  " & pAddrStr->IpAddress.string
       PRINT "  IP-Mask:     " & pAddrStr->IPMask.string
       pAddrStr = pAddrStr->Next
     LOOP
   
     SELECT CASE FixedInfo.NodeType
       CASE 1
         PRINT "Node type: Broadcast"
       CASE 2
         PRINT "Node type: Peer to Peer"
       CASE 4
         PRINT "Node type: Mixed"
       CASE 8
         PRINT "Node type: Hybrid"
       CASE ELSE
         PRINT "Unknown Node type: " & FixedInfo.NodeType
     END SELECT
   
     PRINT "NetBIOS Scope Id.:  " & FixedInfo.ScopeId
     IF FixedInfo.EnableRouting THEN
       PRINT "IP Routing enabled "
     ELSE
       PRINT "IP Routing NOT enabled"
     END IF
     IF FixedInfo.EnableProxy THEN
       PRINT "WINS Proxy enabled "
     ELSE
       PRINT "WINS Proxy NOT enabled"
     END IF
     IF FixedInfo.EnableDns THEN
       PRINT "NetBIOS Resolution uses DNS"
     ELSE
       PRINT "NetBIOS Resolution does NOT use DNS"
     END IF
   ELSE 'Rückgabewert von API Aufruf zeigt Fehler:
     PRINT "GetNetworkParams failed with Error: " & Erg
     EXIT SUB
   END IF 
   
   Print
   Print "** Taste oder warten **"
   Print
   Sleep 50000

  ' 5. Aufzählen aller Netzwerk-Adapter mit ihren   
   '    spezifischen informationen (MAC-Adresse).
   ' Benutzt wird der IP_ADAPTER_INFO Datentyp (siehe iptypes.bi)
   ' der rekursiv verlinkt eine Liste erzeugen kann:
   DIM AS INTEGER AdapterInfoSize, AdapterNr
   Dim As String   PhysicalAddress, HexBlock

   ' 6. benötigte Buffergröße wieder duch einen Bufferüberlauf ermitteln:
   Erg = GetAdaptersInfo(0, @AdapterInfoSize)
   IF Erg <> 0 THEN
     IF Erg <> ERROR_BUFFER_OVERFLOW THEN
       PRINT "GetAdaptersInfo sizing failed with Error: " & erg
       EXIT SUB
     END If
   Else
    'Nanu? Kein Bufferüberlauf? - vielleicht keine Netzwerk-Adapter?
     PRINT "GetAdaptersInfo sizing failed: " & Erg
     Exit Sub        
   END IF
   
   'Anzahl der Adapter ableiten:
   AdapterNr=AdapterInfoSize / SIZEOF(IP_ADAPTER_INFO)
   
   'Buffer für Netzwerk-Adapter bereitstellen:
   'Soetwas in der art hätte ich in Block 3 auch erwartet...
   DIM AdapterInfo (0 TO AdapterNr-1) AS IP_ADAPTER_INFO
   
   '...und Informationen in den Buffer laden:
   Erg = GetAdaptersInfo(@AdapterInfo(0), @AdapterInfoSize)
   IF Erg <> 0 THEN 'Fehler bei API aufruf?
     PRINT "GetAdaptersInfo failed with Error: " & erg
     EXIT SUB
   END IF
   
   FOR i AS INTEGER = 0 TO AdapterNr-1
     WITH AdapterInfo(i)
        'Adapter-Type bzw. Adapter-Name ausgeben:
       SELECT CASE .TYPE
         CASE MIB_IF_TYPE_ETHERNET
           PRINT "Adapter Name: Ethernet adapter "
         CASE MIB_IF_TYPE_TOKENRING
           PRINT "Adapter Name: Token Ring adapter "
         CASE MIB_IF_TYPE_FDDI
           PRINT "Adapter Name: FDDI adapter "
         CASE MIB_IF_TYPE_PPP
           PRINT "Adapter Name: PPP adapter"
         CASE MIB_IF_TYPE_LOOPBACK
           PRINT "Adapter Name: Loopback adapter "
         CASE MIB_IF_TYPE_SLIP
           PRINT "Adapter Name: Slip adapter "
         CASE ELSE
           PRINT "Adapter Name: " & .AdapterName
       END SELECT
       'Adapter-Beschreibung:
       PRINT "AdapterDescription: " & .Description
       'MAC-Adresse in Hexidezimal schreibweise umformen:
       PhysicalAddress = ""
       FOR j AS INTEGER = 0 TO .AddressLength - 1
          HexBlock = Hex(.Address(j))
          While Len(HexBlock) < 2
             HexBlock = "0" & HexBlock
          Wend
         PhysicalAddress = PhysicalAddress & HexBlock
         IF j < .AddressLength - 1 THEN
           PhysicalAddress = PhysicalAddress & "-"
         END If
       Next        
       PRINT "Physical Address: " & PhysicalAddress
       'IP-Adresse:
       PRINT "IP Address: " & .IpAddressList.IpAddress.STRING
       PRINT "Subnet Mask: " & .IpAddressList.IpMask.STRING
       PRINT "Default Gateway: " & .GatewayList.IpAddress.STRING
       IF .DhcpEnabled THEN
         PRINT "DHCP Enabled "
         PRINT "DHCP Server: " & .DhcpServer.IpAddress.STRING
         PRINT "Primary WINS Server: " & .PrimaryWinsServer.IpAddress.STRING
         PRINT "Secondary WINS Server: " & .SecondaryWinsServer.IpAddress.STRING
         ' Display TIME.
         PRINT "Lease Obtained: "; FORMAT((.LeaseObtained / 86400) + 25569, "dd.mm.yyyy, hh:mm:ss")
         PRINT "Lease Expires : "; FORMAT((.LeaseExpires / 86400) + 25569, "dd.mm.yyyy, hh:mm:ss")
       ELSE
         PRINT "DHCP disabled"
       END IF
     END With 'AdapterInfo(i)
   Next
   Print
   Print "** Taste oder warten **"
   Print
   Sleep 50000
   ' Beim beenden dieses Sub-Programms
   ' stürzt bei mir noch das gesamte Programm ab,
   ' möglich das in ein Speicherbereich geschrieben wurde,
   ' der für den Rücksprung notwendig ist?
   Exit sub
END Sub
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
volta



Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192

BeitragVerfasst am: 10.06.2008, 17:14    Titel: Antworten mit Zitat

Hi,
ich hatte mich an die MSDN gehalten:
GetNetworkParams Function
GetAdaptersInfo Function
Code:
' Code Modul für FreeBasicCompiler
'------------------------------------------------------------------------------
' getestet auf Windows XP mit FBC 0.18.3 von Maeex
' getestet auf Windows ME mit FBC 0.20.0 (5.6.2008) von Volta
'------------------------------------------------------------------------------
' #INCLUDE ONCE "windows.bi"
' #INCLUDE ONCE "win/iphlpapi.bi"
' #INCLUDE ONCE "vbcompat.bi"
'
' Dieses Modul fragt die Netzwerk-Konfiguration ab.
' Der Orignal Code kommt von dieser Site:
' http://binaryworld.net/Main/CodeDetail.aspx?CodeId=3802
' und wurde von VOLTA das erste mal fehlerfrei übersetzt - Danke VOLTA!
'                                                         Liebe Grüße Mäx

' 3. Speicher reservieren
'Warum hier jetzt nicht der DatenBuffer reserviert werden muß?
'Kein REDIM, Relocate... oder so... ?

Mit DIM FixedInfo AS FIXED_INFO ist Speicherplatz reserviert worden.

'Der Block 2. könnte dann eigentlich wegfallen, wenn die Buffergröße
'nicht für eine Speicherreservierung benuttz werden muß - mh?

Eigentlich ... ja ..

'Die folgende Zeile liefert einen falschen Wert, da noch nicht
'auf die richtige Adresse gezeigt wird - oder?
'PRINT "DNS-Servers: " & FixedInfo.DnsServerList.IpAddress.STRING

Glaube ich nicht, so steht es in der MSDN.

'Soetwas in der art hätte ich in Block 3 auch erwartet...
Nein, IP_ADAPTER_INFO ist eine LinkList d.h. es kann mehrere Einträge geben.
In FIXED_INFO verweist nur DnsServerList auf eine LinkList, FIXED_INFO selbst gibt es nur ein mal.
Code:
   ' Beim beenden dieses SUB-Programms
   ' stürzt bei mir noch das gesamte Programm ab,
   ' möglich das in ein Speicherbereich geschrieben wurde,
   ' der für den Rücksprung notwendig ist?
   'EXIT SUB <- ist hier nicht nötig
END SUB
kann das den Absturz vermeiden?
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden Website dieses Benutzers besuchen
Mae



Anmeldungsdatum: 04.06.2008
Beiträge: 26

BeitragVerfasst am: 11.06.2008, 07:39    Titel: Wow: Online MSDN Antworten mit Zitat

Hi!
Du bist wirklich Wunderbar!!!
volta hat Folgendes geschrieben:
ich hatte mich an die MSDN gehalten:
GetNetworkParams Function
GetAdaptersInfo Function

Denn ich kannte die online MSDN noch gar nicht. Ersteinmal war es für mich schwierig zu verstehen, den ich konnte mit dem Beispiel-Code nichts anfangen - dann ist mir der "Language Filter" aufgefallen den ich auf VB gestellt habe und prompt wurde die Seite etwas übersichtlicher und verständlicher für mich: C++ Code ist das also... - aha!

Habe erst einmal den Header für das Modul "WinNet.BAS" verküzt.
Der Grund für diese Zeilen liegt im Vorbildlichen Archiv der "ActiveVB"-Site: Bei den Tips'n Tricks wird der Code gefolgt von einer Tabelle begleitet die angibt auf welchem System und welchem Compiler/IDE das Programm läuft.
Code:
' Code Modul für FreeBasicCompiler 0.18.3
' Dieses Modul fragt die Netzwerk-Konfiguration ab.
'------------------------------------------------------------------------------
' 2008-06-05 - Volta - läuft auf Windows ME mit FBC 0.20.0
' 2008-06-09 - Maeex - läuft auf Windows XP mit FBC 0.18.3
'------------------------------------------------------------------------------
'
' #INCLUDE ONCE "windows.bi"
' #INCLUDE ONCE "win/iphlpapi.bi"
' #INCLUDE ONCE "vbcompat.bi"
'
'------------------------------------------------------------------------------


Bis ich verstehe mit der MSDN umzugehen dauert es noch ein wenig.
Aber FIXED_INFO scheint also doch - wie der Name schon andeutet - wirklich feste Länge zu haben. Somit ist der Code natürlich zu kürzen, wie ich es im Header nun schon angefangen habe...
Da wird es ja vielleicht doch noch ein wenig zu meinem eigenen Code *g*

Wie es nun zu dem Absturz kommt habe ich leider noch nicht klären können. Ich habe einfach in bald jede Zeile zwischen geschrieben:
Code:
 Print "Ich laufe noch..." : Sleep

Und bin somit darauf gekommen das der Fehler direkt nach den Funktionsaufruf erfolgt.

Und natürlich bringt ein EXIT SUB auch keine Rettung - vielleicht darf ich Dir einmal das komplette Projekt senden und Du erkennst den Fehler den ich da eingebaut habe? Laut Deiner Site benutze ich den selben Editor... - denke ich - also "FreeBASIC editor 1.0.6.1".
Es geht darum möglichst viele System-Informationen unter Windows auszulesen: CPU-Daten, Netzwerk-Daten, Platten-Daten.
Da ich nur wüßte wie ich Dir via Mail das Projekt zukommen lassen könnte, bitte maild Dich bei "Maeex" at GMX.de - falls Du Zeit und Lust hast Dir das auch noch anzuschauen.

Danke - mit Dir macht das FB lernen richtig spaß!
Mäx
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
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