Seite 1 von 3

GetAdaptersInfo

Verfasst: 05.09.2006 00:09
von pws32
kann jemand diesen code nach PB4.0 übersetzen?, Danke!

Code: Alles auswählen

; GetNetworkAdapters - 09/24/2003 updated/modified by TerryHough
; from PB forums by AngelSoul
; post http://jconserv.net/purebasic/viewtopic.php?t=7347

; The Lease Obtained and Lease Expired fields are incorrect.  Need to know
; how to convert them from long date to date.

Global Hostname$.s
Global DNSServer$.s
Global Adapter$.s

Declare GetAdaptersInfo(Total)
Structure IP_ADDR_STRING
  Nxt.l
  IP.b[16]
  mask.b[16]
  Context.l
EndStructure

Structure IP_ADAPTER_INFO
  Nxt.l
  ComboIndex.l
  AdapterName.b[260]
  Description.b[132]
  AddressLength.l
  Adr.b[8]
  Index.l
  Type.l
  DhcpEnabled.l
  CurrentIpAddress.l
  IpAddressList.IP_ADDR_STRING
  GatewayList.IP_ADDR_STRING
  DhcpServer.IP_ADDR_STRING
  HaveWins.w
  PrimaryWinsServer.IP_ADDR_STRING
  SecondaryWinsServer.IP_ADDR_STRING
  LeaseObtained.b[4]
  LeaseExpires.b[4]
EndStructure

Structure FIXED_INFO
  HostName.b[132]
  DomainName.b[132]
  CurrentDnsServer.l
  DnsServerList.IP_ADDR_STRING
  NodeType.l
  ScopeId.b[260]
  EnableRouting.l
  EnableProxy.l
  EnableDns.l
EndStructure

Structure IP_INFO
  AdapterName.s
  IP.s
  AdapterType.l
  AdapterTypeDesc.s
EndStructure

Dim Adapters.IP_INFO(10)

GetAdaptersInfo(Total)
If Total = -1
  MessageRequester("Error","An error occured accessing adapter info",#MB_ICONERROR)
  End
Else
  MessageRequester("IP Configuration Report",Adapter$,#MB_ICONINFORMATION)
EndIf
End

Procedure GetAdaptersInfo(Total)
  Shared Total
  Shared Adapter$
  res=GetNetworkParams_(0,@FixedInfoSize.l)
  If res<>0
    If res<>#ERROR_BUFFER_OVERFLOW
      Total=-1
      ProcedureReturn Total
    EndIf
  EndIf
  Dim FixedInfoBuffer.b(FixedInfoSize-1)
  res = GetNetworkParams_(@FixedInfoBuffer(0), @FixedInfoSize)
  If res=0
    CopyMemory(@FixedInfoBuffer(0),@FixedInfo.FIXED_INFO,SizeOf(FIXED_INFO))
    Hostname$ =PeekS(@FixedInfo\HostName)
    Adapter$ = "Host name: " + Hostname$ + Chr(10)
    Domain$  = PeekS(@FixedInfo\DomainName)
    Adapter$ = Adapter$ + "Domain name: " + Domain$ + Chr(10)
    DNSServer$=PeekS(@FixedInfo\DnsServerList\IP)
    Adapter$ = Adapter$ + "DNS Servers: " + DNSServer$ + Chr(10)
    pAddrStr.l=PeekL(@FixedInfo\DnsServerList\Nxt)
    Repeat
      CopyMemory(pAddrStr,@Buffer.IP_ADDR_STRING,SizeOf(IP_ADDR_STRING))
      pAddrStr =Buffer\Nxt
    Until pAddrStr=0
    Select PeekL(@FixedInfo\NodeType)
      Case 1 : Adapter$ + "Node Type: Broadcast" + Chr(10)
      Case 2 : Adapter$ + "Node Type: Peer to Peer" + Chr(10)
      Case 4 : Adapter$ + "Node Type: Mixed" + Chr(10)
      Case 8 : Adapter$ + "Node Type: Hybrid" + Chr(10)
      Default: Adapter$ + "Node Type: Unknown" + Chr(10)
    EndSelect
    Select PeekL(@FixedInfo\EnableRouting)
      Case 0 : Adapter$ + "IP Routing: Not Enabled" + Chr(10)
      Default: Adapter$ + "Node Type: Enabled" + Chr(10)
    EndSelect
    Select PeekL(@FixedInfo\EnableProxy)
      Case 0 : Adapter$ + "WINS Proxy: Not enabled" + Chr(10)
      Default: Adapter$ + "WINS Proxy: Enabled" + Chr(10)
    EndSelect
    Select PeekL(@FixedInfo\EnableDns)
      Case 0 : Adapter$ + "NetBIOS does not use DNS" + Chr(10)
      Default: Adapter$ + "NetBIOS uses DNS" + Chr(10)
    EndSelect
    Adapter$ = Adapter$ + Chr(10)
  EndIf
  AdapterInfoSize.l=0
  res=GetAdaptersInfo_(0, @AdapterInfoSize)
  If res<>0
    If res<>#ERROR_BUFFER_OVERFLOW
      Total=-1
      ProcedureReturn
    EndIf
  EndIf
  Dim AdapterInfoBuffer.b(AdapterInfoSize - 1) ;OK
  res=GetAdaptersInfo_(@AdapterInfoBuffer(0), @AdapterInfoSize.l) ;OK
  CopyMemory(@AdapterInfoBuffer(0),@AdapterInfo.IP_ADAPTER_INFO,SizeOf(IP_ADAPTER_INFO))
  pAdapt=AdapterInfo\Nxt
  
  Repeat
    CopyMemory(@AdapterInfo,@Buffer2.IP_ADAPTER_INFO,SizeOf(IP_ADAPTER_INFO))
    pAddrStr=Buffer2\IpAddressList\Nxt
    Repeat
      CopyMemory(@Buffer2\IpAddressList,@Buffer,SizeOf(IP_ADDR_STRING))
      Total=Total+1
      Adapter$ + "Adapter: " + PeekS(@Buffer2\Description) + Chr(10)
      Select Buffer2\Type
        Case  1 :Adapter$ + "Type: " + Str(Buffer2\Type) + " Ethernet Adapter" + Chr(10)
        Case  2 :Adapter$ + "Type: " + Str(Buffer2\Type) + " Token Ring Adapter" + Chr(10)
        Case  3 :Adapter$ + "Type: " + Str(Buffer2\Type) + " FDDI Adapter" + Chr(10)
        Case  4 :Adapter$ + "Type: " + Str(Buffer2\Type) + " PPP Adapter" + Chr(10)
        Case  5 :Adapter$ + "Type: " + Str(Buffer2\Type) + " Loopback Adapter" + Chr(10)
        Case  6 :Adapter$ + "Type: " + Str(Buffer2\Type) + " Slip Adapter" + Chr(10)
        Case 23 :Adapter$ + "Type: " + Str(Buffer2\Type) + " PPPoE Adapter" + Chr(10)
        Default :Adapter$ + "Type: " + Str(Buffer2\Type) + " Unknown Adapter" + Chr(10)
      EndSelect
      Adapter$ + "IP Address: " + PeekS(@Buffer\IP) + Chr(10)
      Adapter$ + "Subnet Mask: " + PeekS(@Buffer\mask) + Chr(10)
      pAddrStr=Buffer\Nxt
      If pAddrStr<>0
        CopyMemory(pAddrStr,@Buffer2\GatewayList,SizeOf(IP_ADDR_STRING))
      EndIf
    Until pAddrStr=0
    If PeekS(@Buffer2\GatewayList\IP)
      Adapter$ + "Default Gateway: " +PeekS(@Buffer2\GatewayList\IP) + Chr(10)
    EndIf
    
    pAdapt=Buffer2\Nxt
    If pAdapt<>0
      CopyMemory(pAdapt,@AdapterInfo,SizeOf(IP_ADAPTER_INFO))
    EndIf
    If PeekS(@Buffer2\DhcpServer\IP)
      Adapter$ + "DHCP Server: " +PeekS(@Buffer2\DhcpServer\IP) + Chr(10)
    EndIf
    If PeekS(@Buffer2\PrimaryWinsServer)
      Adapter$ + "Primary WINS Server: " +PeekS(@Buffer2\PrimaryWinsServer) + Chr(10)
    EndIf
    If PeekS(@Buffer2\SecondaryWinsServer)
      Adapter$ + "Secondary WINS Server: " +PeekS(@Buffer2\SecondaryWinsServer) + Chr(10)
    EndIf
    Adapter$ + "Lease obtained: " + FormatDate("%mm/%dd/%yyyy %hh;%mm:%ss",PeekL(@Buffer2\LeaseObtained)) + Chr(10)
    Adapter$ + "Lease expires: "  + FormatDate("%mm/%dd/%yyyy %hh;%mm:%ss",PeekL(@Buffer2\LeaseExpires))  + Chr(10)
    Adapter$ + Chr(10)
    
  Until pAdapt=0
EndProcedure 

Re: GetAdaptersInfo

Verfasst: 05.09.2006 00:29
von Kiffi
pws32 hat geschrieben:kann jemand diesen code nach PB4.0 übersetzen?, Danke!
willst Du nicht erstmal abwarten, was die Kollegen unter
http://www.purebasic.fr/english/viewtopic.php?t=23536
dazu schreiben? /:->

Grüße ... Kiffi

Verfasst: 05.09.2006 00:32
von ts-soft
In welcher Version soll der Code den mal funktioniert haben?
Unter 3.94 geht er auch nicht :freak:

Verfasst: 05.09.2006 00:37
von pws32
warten?, nö eigentlich nicht so gern

version?, ich weiss es nicht ich habs unter 3.93,3.94 und 4.0 nicht zum laufen bekommen

Verfasst: 05.09.2006 00:45
von ts-soft
pws32 hat geschrieben:warten?, nö eigentlich nicht so gern

version?, ich weiss es nicht ich habs unter 3.93,3.94 und 4.0 nicht zum laufen bekommen
Deine Version ist wahrscheinlich nie gelaufen :mrgreen:

Code: Alles auswählen

; English forum: http://purebasic.myforums.net/viewtopic.php?t=7347
; Author: AngelSoul
; Date: 26. August 2003
; updated for PB4 by ts-soft
; List adapters with their respective IPs
Declare GetAdaptersInfo() 
Structure IP_ADDR_STRING 
  Nxt.l 
  IP.b[16] 
  mask.b[16] 
  Context.l 
EndStructure 

Structure IP_ADAPTER_INFO 
  Nxt.l 
  ComboIndex.l 
  AdapterName.b[260] 
  Description.b[132] 
  AddressLength.l 
  Adr.b[8] 
  Index.l 
  Type.l 
  DhcpEnabled.l 
  CurrentIpAddress.l 
  IpAddressList.IP_ADDR_STRING 
  GatewayList.IP_ADDR_STRING 
  DhcpServer.IP_ADDR_STRING 
  HaveWins.w 
  PrimaryWinsServer.IP_ADDR_STRING 
  SecondaryWinsServer.IP_ADDR_STRING 
  LeaseObtained.l 
  LeaseExpires.l 
EndStructure 

Structure FIXED_INFO 
  HostName.b[132] 
  DomainName.b[132] 
  CurrentDnsServer.l 
  DnsServerList.IP_ADDR_STRING 
  NodeType.l 
  ScopeId.b[260] 
  EnableRouting.l 
  EnableProxy.l 
  EnableDns.l 
EndStructure 

Structure IP_INFO 
  AdapterName.s 
  IP.s 
  AdapterType.l 
  AdapterTypeDesc.s 
EndStructure 

Global Dim Adapters.IP_INFO(10) 

GetAdaptersInfo() 
If Total=-1:MessageRequester("Error","An error occured accessing adapter info",0):End:EndIf 
For gg=1 To Total 
  Debug "Adapter: "+Adapters(gg)\AdapterName 
  Debug "Type: "+Adapters(gg)\AdapterTypeDesc 
  Debug "IP: "+Adapters(gg)\IP 
  Debug Adapters(gg)\AdapterType 
  Debug "" 
Next 

End 




Procedure GetAdaptersInfo() 
  Shared Total 
  
  res=GetNetworkParams_(0,@FixedInfoSize.l) 
  If res<>0 
    If res<>#ERROR_BUFFER_OVERFLOW 
      Total=-1:ProcedureReturn 
      End 
    EndIf 
  EndIf 
  Dim FixedInfoBuffer.b(FixedInfoSize-1) 
  res = GetNetworkParams_(@FixedInfoBuffer(0), @FixedInfoSize) 
  If res=0 
    CopyMemory(@FixedInfoBuffer(0),@FixedInfo.FIXED_INFO,SizeOf(FIXED_INFO)) 
    Hostname$=PeekS(@FixedInfo\HostName) 
    DNSServer$=PeekS(@FixedInfo\DnsServerList\IP) 
    pAddrStr.l=@FixedInfo\DnsServerList\Nxt 
    Repeat 
      CopyMemory(pAddrStr,@Buffer.IP_ADDR_STRING,SizeOf(IP_ADDR_STRING)) 
      pAddrStr =Buffer\Nxt 
    Until pAddrStr=0 
  EndIf 
  
  AdapterInfoSize.l=0 
  res=GetAdaptersInfo_(0, @AdapterInfoSize) 
  If res<>0 
    If res<>#ERROR_BUFFER_OVERFLOW 
      Total=-1:ProcedureReturn 
    EndIf 
  EndIf 
  Dim AdapterInfoBuffer.b(AdapterInfoSize - 1) ;OK 
  res=GetAdaptersInfo_(@AdapterInfoBuffer(0), @AdapterInfoSize.l) ;OK 
  
  CopyMemory(@AdapterInfoBuffer(0),@AdapterInfo.IP_ADAPTER_INFO,SizeOf(IP_ADAPTER_INFO)) 
  pAdapt=AdapterInfo\Nxt 
  
  Repeat 
    CopyMemory(@AdapterInfo,@Buffer2.IP_ADAPTER_INFO,SizeOf(IP_ADAPTER_INFO)) 
    Select Buffer2\Type 
      Case 1:AdType$="Ethernet Adapter" 
      Case 2:AdType$="Token Ring Adapter" 
      Case 3:AdType$="FDDI Adapter" 
      Case 4:AdType$="PPP Adapter" 
      Case 5:AdType$="Loopback Adapter" 
      Case 6:AdType$="Slip Adapter" 
      Case 23:AdType$="PPPoE Adapter" 
      Default:AdType$="Unknown Adapter" 
    EndSelect 
    
    
    pAddrStr=Buffer2\IpAddressList\Nxt 
    Repeat 
      CopyMemory(@Buffer2\IpAddressList,@Buffer,SizeOf(IP_ADDR_STRING)) 
      Total=Total+1 
      Adapters(Total)\AdapterName=PeekS(@Buffer2\Description) 
      Adapters(Total)\AdapterType=Buffer2\Type 
      Adapters(Total)\IP=PeekS(@Buffer\IP) 
      Adapters(Total)\AdapterTypeDesc=AdType$ 
      pAddrStr=Buffer\Nxt 
      If pAddrStr<>0:CopyMemory(pAddrStr,@Buffer2\GatewayList,SizeOf(IP_ADDR_STRING)):EndIf 
    Until pAddrStr=0 
    
    pAdapt=Buffer2\Nxt 
    If pAdapt<>0:CopyMemory(pAdapt,@AdapterInfo,SizeOf(IP_ADAPTER_INFO)):EndIf 
    
  Until pAdapt=0 
EndProcedure 

Verfasst: 05.09.2006 00:55
von pws32
danke für die mühe aber..., diese version tut´s auch nicht unter PB4.0

Verfasst: 05.09.2006 00:59
von ts-soft
pws32 hat geschrieben:danke für die mühe aber..., diese version tut´s auch nicht unter PB4.0
Läuft einwandfrei, nur im UnicodeModus nicht:
Adapter: TechnoTrend TT-PCline budget Adapter - Paketplaner-Miniport
Type: Slip Adapter
IP: 192.168.44.21
6

Adapter: SiS 900-basierte PCI-Fast Ethernet-Adapter - Paketplaner-Miniport
Type: Slip Adapter
IP: 192.168.1.33
6

Adapter: VMware Virtual Ethernet Adapter for VMnet1
Type: Slip Adapter
IP: 192.168.85.1
6

Adapter: VMware Virtual Ethernet Adapter for VMnet8
Type: Slip Adapter
IP: 192.168.61.1
6

Verfasst: 05.09.2006 01:07
von pws32
bin unerfahren in pb4.0, wo schaltet man diesen modus ab?

Verfasst: 05.09.2006 01:12
von ts-soft
In den Compileroptionen, aber Unicode liefert keine Fehlermeldung, sondern
viel Fragezeichen statt Text. Der obige Code liefert bei mir dieselben
Ergebnisse, wie die Version für PB 3.94 aus dem CodeArchiv.

Hab nur Total als Parameter entfernt, weil dieser als solcher autom. Local ist,
seid PB4, in diesem Fall aber Global benötigt wird, bzw. durch Shared wird
dasselbe erreicht. Desweiteren das Array Global gemacht.

Verfasst: 05.09.2006 01:20
von pws32
also bei mir kann ich unicode ein oder ausschalten ich habe immer noch den selben fehler