 |
Das deutsche QBasic- und FreeBASIC-Forum Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
Autor |
Nachricht |
Mae

Anmeldungsdatum: 04.06.2008 Beiträge: 26
|
Verfasst am: 04.06.2008, 18:53 Titel: VB->FB: Netzwerk-Karten informationen auslesen per Win-AP |
|
|
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 |
|
 |
volta
Anmeldungsdatum: 04.05.2005 Beiträge: 1876 Wohnort: D59192
|
Verfasst am: 06.06.2008, 13:37 Titel: |
|
|
Hi,
ob dabei alle Infos richtig ausgewertet werden kann ich nicht garantieren,
zumindest kompiliert der Code ohne Fehlermeldungen
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 |
|
 |
Mae

Anmeldungsdatum: 04.06.2008 Beiträge: 26
|
Verfasst am: 08.06.2008, 09:08 Titel: Vielen Dank! |
|
|
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 |
|
 |
Mae

Anmeldungsdatum: 04.06.2008 Beiträge: 26
|
Verfasst am: 10.06.2008, 14:27 Titel: ...doch noch Fragen... |
|
|
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 |
|
 |
volta
Anmeldungsdatum: 04.05.2005 Beiträge: 1876 Wohnort: D59192
|
Verfasst am: 10.06.2008, 17:14 Titel: |
|
|
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 |
|
 |
Mae

Anmeldungsdatum: 04.06.2008 Beiträge: 26
|
Verfasst am: 11.06.2008, 07:39 Titel: Wow: Online MSDN |
|
|
Hi!
Du bist wirklich Wunderbar!!!
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 |
|
 |
|
|
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.
|
|