You can also find it here: http://kc2000labs.shadowtavern.com/pb/z ... AN_520.rar
Code: Select all
#MIB_IF_TYPE_OTHER = 1
#MIB_IF_TYPE_ETHERNET = 6
#MIB_IF_TYPE_TOKENRING = 9
#MIB_IF_TYPE_FDDI = 15
#MIB_IF_TYPE_PPP = 23
#MIB_IF_TYPE_LOOPBACK = 24
#MIB_IF_TYPE_SLIP = 28
#MIB_IF_OPER_STATUS_NON_OPERATIONAL = 0
#MIB_IF_OPER_STATUS_UNREACHABLE = 1
#MIB_IF_OPER_STATUS_DISCONNECTED = 2
#MIB_IF_OPER_STATUS_CONNECTING = 3
#MIB_IF_OPER_STATUS_CONNECTED = 4
#MIB_IF_OPER_STATUS_OPERATIONAL = 5
#BROADCAST_NODETYPE = 1
#PEER_TO_PEER_NODETYPE = 2
#MIXED_NODETYPE = 4
#HYBRID_NODETYPE = 8
Structure IP_ADDR_STRING1
NextAdapter.i
IpAddress.a[16];IP_ADDRESS_STRING
IpMask.a[16];IP_ADDRESS_STRING
Context.i
EndStructure
Structure FIXED_INFO1
HostName.a[132] ;MAX_HOSTNAME_LEN + 4
DomainName.a[132] ;MAX_DOMAIN_NAME_LEN + 4
CurrentDnsServer.i
DnsServerList.IP_ADDR_STRING1
NodeType.l
ScopeId.a[260] ;MAX_SCOPE_ID_LEN + 4
EnableRouting.l
EnableProxy.l
EnableDns.l
EndStructure
Structure IP_ADAPTER_INFO1
NextAdapter.i
ComboIndex.l
AdapterName.a[260] ;MAX_ADAPTER_NAME_LENGTH + 4
Description.a[132] ;MAX_ADAPTER_DESCRIPTION_LENGTH + 4
AddressLength.l
Address.a[8] ;MAX_ADAPTER_ADDRESS_LENGTH
index.l
Type.l
DhcpEnabled.i
CurrentIpAddress.i
IpAddressList.IP_ADDR_STRING1
GatewayList.IP_ADDR_STRING1
DhcpServer.IP_ADDR_STRING1
HaveWINS.i
PrimaryWinsServer.IP_ADDR_STRING1
SecondaryWinsServer.IP_ADDR_STRING1
LeaseObtained.i
LeaseExpires.i
EndStructure
Structure MIB_IFROW
wszName.a[512] ;MAX_INTERFACE_NAME_LEN * 2
dwIndex.l
dwType.l
dwMtu.l
dwSpeed.l
dwPhysAddrLen.l
bPhysAddr.a[8] ;MAXLEN_PHYSADDR
dwAdminStatus.l
dwOperStatus.l
dwLastChange.l
dwInOctets.l
dwInUcastPkts.l
dwInNUcastPkts.l
dwInDiscards.l
dwInErrors.l
dwInUnknownProtos.l
dwOutOctets.l
dwOutUcastPkts.l
dwOutNUcastPkts.l
dwOutDiscards.l
dwOutErrors.l
dwOutQLen.l
dwDescrLen.l
bDescr.a[256] ;MAXLEN_IFDESCR
EndStructure
Structure MIB_IFTABLE1
dwNumEntries.l
table.MIB_IFROW[21]
EndStructure
Structure NetWorkInfo
index.l
HostName.s
DomainName.s
DNSIPAdd.s[11]
nod.s
ScopeID.s
DNSE.s
ProxyE.s
RoutE.s
Conx.s
AdapterName.s[11]
Type.s[11]
Speed.s[11]
sMTU.s[11]
packsS.s[11]
bytesS.s[11]
packsR.s[11]
bytesR.s[11]
status.s[11]
IPAddr.s[11]
SubMask.s[11]
Addr.s[11]
Indx.s[11]
DHCPE.s[11]
DHCPIPAddr.s[11]
DHCPIPMask.s[11]
DHCPLObt.s[11]
DHCPLExp.s[11]
GateIPAddress.s[11]
GateIPMask.s[11]
HaveWINS.s[11]
PWINSIPAddress.s[11]
PWINSIPMask.s[11]
SWINSIPAddress.s[11]
SWINSIPMask.s[11]
EndStructure
Global MIB_IFTABLE.MIB_IFTABLE1
Global Dim IP_ADAPTER_INFO.IP_ADAPTER_INFO1(1)
Global NewList NICs.s()
Global GroupDemicals.s = ","
Global GroupThousands.s = "."
Global LANInfo.NetWorkInfo
Procedure.d int32_uint32(lValue.l)
int32uint32.l
If lValue < 0
int32uint32 = lValue + $100000000
Else
int32uint32 = lValue
EndIf
ProcedureReturn int32uint32
EndProcedure
Procedure.s c2str(num.d, demical.l=0)
ProcedureReturn ReplaceString(StrD(num,demical), ".", GroupDemicals)
EndProcedure
Procedure.s FormatByteSize(n.q)
Protected s.s=Str(n)
Protected len=Len(s)
Protected ret.s
For i=0 To len-1
If i And Not i%3 : ret="." + ret : EndIf; "." is the greek symbol for separating thousands. Use your own.
ret= Mid(s,len-i,1) +ret
Next
ProcedureReturn ret
EndProcedure
Procedure.s SpaceDivider(space.q)
tm.s:mt.d=space
If mt>1000: mt / 1024:tm = " KB":EndIf
If mt>1000: mt / 1024:tm = " MB":EndIf
If mt>1000: mt / 1024:tm = " GB":EndIf
If mt>1000: mt / 1024:tm = " TB":EndIf
ProcedureReturn ReplaceString(StrD(mt,3), ".", GroupDemicals) + tm
EndProcedure
Procedure LAN()
hMod.i = LoadLibrary_("iphlpapi.dll")
FuncName.s = Space(60)
PokeS(@FuncName,"GetAdaptersInfo",-1,#PB_Ascii)
If GetProcAddress_(hMod, FuncName) <> 0
lBufferLength.l = SizeOf(IP_ADAPTER_INFO1)
lErrors = GetAdaptersInfo_(@IP_ADAPTER_INFO(0), @lBufferLength)
If lErrors <> #ERROR_SUCCESS: ProcedureReturn: EndIf
lBufferPos.l
For i.l=0 To 100
LANInfo\AdapterName[i] = PeekS(@IP_ADAPTER_INFO(AdapterCount)\Description,-1,#PB_Ascii)
lBufferPos = lBufferPos + SizeOf(IP_ADAPTER_INFO1)
If lBufferPos < lBufferLength
AdapterCount + 1
Else
Break
EndIf
Next
Else
MessageRequester("error","Could not connect with 'iphlpapi.dll'.")
ProcedureReturn
EndIf
AdapterCount.i
tmp.s
tmp2.d
FuncName = Space(60)
PokeS(@FuncName,"GetIfTable",-1,#PB_Ascii)
If GetProcAddress_(hMod, FuncName) <> 0 ;for speed and status
lSize = SizeOf(MIB_IFTABLE1)
lErrors = GetIfTable_(@MIB_IFTABLE, @lSize, 0)
EndIf
FuncName = Space(60)
PokeS(@FuncName,"GetNetworkParams",-1,#PB_Ascii)
If GetProcAddress_(hMod, FuncName) <> 0
xx = 0
FIXED_INFO.FIXED_INFO1
lErrors = GetNetworkParams_(@FIXED_INFO, @lBufferLength)
With FIXED_INFO
IP_ADDR_STRING.IP_ADDR_STRING1
LANInfo\HostName = PeekS(@\Hostname,-1,#PB_Ascii)
LANInfo\DomainName = PeekS(@\DomainName,-1,#PB_Ascii)
If \EnableDns = 1: LANInfo\DNSE = "Yes": Else: LANInfo\DNSE = "No": EndIf
LANInfo\DNSIPAdd[xx] = PeekS(@\DnsServerList\IpAddress,-1,#PB_Ascii)
lNext.l = \DnsServerList\NextAdapter
While aa.l=0
If lNext <> 0
If IsBadReadPtr_(lNext, SizeOf(IP_ADDR_STRING1)) = #False
MoveMemory(@lNext, @IP_ADDR_STRING, SizeOf(IP_ADDR_STRING1))
EndIf
If lNext <> IP_ADDR_STRING\NextAdapter
lNext = IP_ADDR_STRING\NextAdapter
xx = xx + 1
LANInfo\DNSIPAdd[xx] = PeekS(@IP_ADDR_STRING\IpAddress[0],-1,#PB_Ascii)
Else
aa=1
EndIf
Else
aa=1
EndIf
Wend
Select \NodeType
Case #BROADCAST_NODETYPE: LANInfo\nod = "Broadcast"
Case #PEER_TO_PEER_NODETYPE: LANInfo\nod = "Peer To Peer"
Case #MIXED_NODETYPE: LANInfo\nod = "Mixed"
Case #HYBRID_NODETYPE: LANInfo\nod = "Hybrid"
Default: LANInfo\nod = "Unknown " + Str(\NodeType)
EndSelect
LANInfo\ScopeID = ReplaceString(PeekS(@\ScopeId[0],-1,#PB_Ascii), Chr(0), "")
If \EnableProxy = 1: LANInfo\ProxyE = "Yes": Else: LANInfo\ProxyE = "No": EndIf
If \EnableRouting = 1: LANInfo\RoutE = "Yes": Else: LANInfo\RoutE = "No": EndIf
EndWith
Else
MessageRequester("error","GetNetworkParams not found")
EndIf
For i = 0 To AdapterCount
With IP_ADAPTER_INFO(i)
Select \Type
Case #MIB_IF_TYPE_OTHER: LANInfo\Type[i] = "Other"
Case #MIB_IF_TYPE_ETHERNET: LANInfo\Type[i] = "Ethernet"
Case #MIB_IF_TYPE_TOKENRING: LANInfo\Type[i] = "Tokenring"
Case #MIB_IF_TYPE_FDDI: LANInfo\Type[i] = "FDDI"
Case #MIB_IF_TYPE_PPP: LANInfo\Type[i] = "PPP"
Case #MIB_IF_TYPE_LOOPBACK: LANInfo\Type[i] = "Loopback"
Case #MIB_IF_TYPE_SLIP: LANInfo\Type[i] = "Slip"
Default: LANInfo\Type[i] = "Unknown " + Str(\Type)
EndSelect
For ii = 0 To 20
If PeekS(@MIB_IFTABLE\table[ii]\bDescr,-1,#PB_Ascii) = LANInfo\AdapterName[i]
tmp2 = int32_uint32(MIB_IFTABLE\table[ii]\dwSpeed): tmp = " bit"
If tmp2 >= 1000: tmp2 = tmp2 / 1000: tmp = " Kbit":EndIf
If tmp2 >= 1000: tmp2 = tmp2 / 1000: tmp = " Mbit": EndIf
If tmp2 >= 1000: tmp2 = tmp2 / 1000: tmp = " Gbit": EndIf
LANInfo\Speed[i] = c2str(tmp2,2) + tmp
LANInfo\sMTU[i] = Str(MIB_IFTABLE\table[ii]\dwMtu) + " bytes"
LANInfo\packsS[i] = FormatByteSize(MIB_IFTABLE\table[ii]\dwOutNUcastPkts + MIB_IFTABLE\table[ii]\dwOutUcastPkts)
tmp = FormatByteSize(MIB_IFTABLE\table[ii]\dwOutOctets)
If tmp = "": tmp = "0": EndIf
If MIB_IFTABLE\table[ii]\dwOutOctets > 1024
tmp + " ( " + SpaceDivider(MIB_IFTABLE\table[ii]\dwOutOctets) + " )"
If Right(tmp,6) = GroupDemicals + "000 )":tmp=Left(tmp,Len(tmp)-6) + " )": EndIf
EndIf
LANInfo\bytesS[i] = tmp
LANInfo\packsR[i] = FormatByteSize(MIB_IFTABLE\table[ii]\dwInNUcastPkts + MIB_IFTABLE\table[ii]\dwInUcastPkts)
tmp = FormatByteSize(MIB_IFTABLE\table[ii]\dwInOctets)
If tmp = "": tmp = "0": EndIf
If (MIB_IFTABLE\table[ii]\dwInOctets & $FFFFFFFF) > 1024
tmp + " ( " + SpaceDivider(MIB_IFTABLE\table[ii]\dwInOctets) + " )"
If Right(tmp,6) = GroupDemicals + "000 )":tmp=Left(tmp,Len(tmp)-6) + " )": EndIf
EndIf
LANInfo\bytesR[i] = tmp
Select MIB_IFTABLE\table[ii]\dwOperStatus
Case #MIB_IF_OPER_STATUS_NON_OPERATIONAL: LANInfo\status[i] = "Non operational"
Case #MIB_IF_OPER_STATUS_UNREACHABLE: LANInfo\status[i] = "Unreachable"
Case #MIB_IF_OPER_STATUS_DISCONNECTED: LANInfo\status[i] = "Disconnected"
Case #MIB_IF_OPER_STATUS_CONNECTING: LANInfo\status[i] = "Connecting"
Case #MIB_IF_OPER_STATUS_CONNECTED: LANInfo\status[i] = "Connected"
Case #MIB_IF_OPER_STATUS_OPERATIONAL: LANInfo\status[i] = "Operational"
Default: LANInfo\status[i] = "Unknown " + c2str(int32_uint32(MIB_IFTABLE\table[ii]\dwOperStatus),0)
EndSelect
Break
EndIf
Next
LANInfo\IPAddr[i] = PeekS(@\IpAddressList\IpAddress,-1,#PB_Ascii)
LANInfo\SubMask[i] = PeekS(@\IpAddressList\IpMask,-1,#PB_Ascii)
tmp = ""
If Len(PeekS(@\AdapterName,-1,#PB_Ascii)) >= \AddressLength
For lIncrement.l = 0 To \AddressLength-1
tmp = tmp + RSet(Hex(\Address[lIncrement] & $FF),2,"0")
Next lIncrement
tmp = RSet(tmp,12,"0")
tmp = Left(tmp, 2) + ":" + Mid(tmp, 3, 2) + ":" + Mid(tmp, 5, 2) + ":" + Mid(tmp, 7, 2) + ":" + Mid(tmp, 9, 2) + ":" + Mid(tmp, 11, 2)
LANInfo\Addr[i] = tmp
EndIf
LANInfo\Indx[i] = (c2str(int32_uint32(\Index),0))
If \DhcpEnabled = 1: LANInfo\DHCPE[i] = "Yes": Else: LANInfo\DHCPE[i] = "No": EndIf
LANInfo\DHCPIPAddr[i] = PeekS(@\DhcpServer\IpAddress,-1,#PB_Ascii)
LANInfo\DHCPIPMask[i] = PeekS(@\DhcpServer\IpMask,-1,#PB_Ascii)
If \LeaseObtained > 10000
tmp = FormatDate("%dd/%mm/%yyyy , %hh:%ii:%ss",AddDate( 1/1/1970,#PB_Date_Second, \LeaseObtained))
LANInfo\DHCPLObt[i] = FormatDate("%dd/%mm/%yyyy , %hh:%ii:%ss",AddDate( ParseDate("%dd/%mm/%yyyy , %hh:%ii:%ss",tmp),#PB_Date_Minute,-TZResult ))
Else
LANInfo\DHCPLObt[i] = "NotAvailable"
EndIf
If \LeaseExpires > 10000
tmp = FormatDate("%dd/%mm/%yyyy , %hh:%ii:%ss",AddDate( 1/1/1970,#PB_Date_Second, \LeaseExpires))
LANInfo\DHCPLExp[i] = FormatDate("%dd/%mm/%yyyy , %hh:%ii:%ss",AddDate( ParseDate("%dd/%mm/%yyyy , %hh:%ii:%ss",tmp),#PB_Date_Minute,-TZResult))
Else
LANInfo\DHCPLExp[i] = "NotAvailable"
EndIf
CopyMemory(@\IpAddressList,@IP_ADDR_STRING,SizeOf(IP_ADDR_STRING1))
For ii=0 To 100
If IP_ADDR_STRING\NextAdapter <> 0
If IsBadReadPtr_(@IP_ADDR_STRING\NextAdapter, SizeOf(IP_ADDR_STRING1)) = #False
MoveMemory(@IP_ADDR_STRING\NextAdapter, @IP_ADDR_STRING, SizeOf(IP_ADDR_STRING1))
EndIf
Else
Break
EndIf
If bShutdown = #True: Break: EndIf
Next
LANInfo\GateIPAddress[i] = PeekS(@\GatewayList\IpAddress,-1,#PB_Ascii)
LANInfo\GateIPMask[i] = PeekS(@\GatewayList\IpMask,-1,#PB_Ascii)
If \HaveWINS = 1: LANInfo\HaveWINS[i] = "Yes": Else: LANInfo\HaveWINS[i] = "No": EndIf
LANInfo\PWINSIPAddress[i] = PeekS(@\PrimaryWinsServer\IpAddress,-1,#PB_Ascii)
LANInfo\PWINSIPMask[i] = PeekS(@\PrimaryWinsServer\IpMask,-1,#PB_Ascii)
LANInfo\SWINSIPAddress[i] = PeekS(@\SecondaryWinsServer\IpAddress,-1,#PB_Ascii)
LANInfo\SWINSIPMask[i] = PeekS(@\SecondaryWinsServer\IpMask,-1,#PB_Ascii)
EndWith
Next
EndProcedure
If OpenWindow(0, 0, 0, 432, 510, "LAN", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ListIconGadget(0,5,5,422,500,"Element",200,#PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(0,1,"Data",200)
EndIf
LAN()
AddGadgetItem(0,-1,"Host name"+Chr(10)+LANInfo\HostName)
AddGadgetItem(0,-1,"Domain name"+Chr(10)+LANInfo\DomainName)
AddGadgetItem(0,-1,"DNS enabled"+Chr(10)+LANInfo\DNSE)
For i=0 To 10
If LANInfo\DNSIPAdd[i] <> ""
AddGadgetItem(0,-1,"DNS Server IP address #" + Str(i+1)+Chr(10)+LANInfo\DNSIPAdd[i])
EndIf
Next
AddGadgetItem(0,-1,"Node type"+Chr(10)+LANInfo\nod)
AddGadgetItem(0,-1,"Scope ID"+Chr(10)+LANInfo\ScopeID)
AddGadgetItem(0,-1,"WINS Proxy Enabled"+Chr(10)+LANInfo\ProxyE)
AddGadgetItem(0,-1,"IP Routing Enabled"+Chr(10)+LANInfo\RoutE)
AddGadgetItem(0,-1,""+Chr(10)+"")
For i=0 To 10
If LANInfo\AdapterName[i] <> ""
AddGadgetItem(0,-1,"Connection #"+Str(i+1)+Chr(10)+"")
SetGadgetItemColor(0,CountGadgetItems(0)-1,#PB_Gadget_FrontColor,$906000,0)
AddGadgetItem(0,-1,"Adapter name"+Chr(10)+LANInfo\AdapterName[i])
AddGadgetItem(0,-1,"Type"+Chr(10)+LANInfo\Type[i])
AddGadgetItem(0,-1,"Speed"+Chr(10)+LANInfo\Speed[i])
AddGadgetItem(0,-1,"Maximum Transfer Unit Size (MTU)"+Chr(10)+LANInfo\sMTU[i])
AddGadgetItem(0,-1,"Packets sent"+Chr(10)+LANInfo\packsS[i])
AddGadgetItem(0,-1,"Bytes sent"+Chr(10)+LANInfo\bytesS[i])
AddGadgetItem(0,-1,"Packets received"+Chr(10)+LANInfo\packsR[i])
AddGadgetItem(0,-1,"Bytes received"+Chr(10)+LANInfo\bytesR[i])
AddGadgetItem(0,-1,"Status"+Chr(10)+LANInfo\status[i])
AddGadgetItem(0,-1,"IP"+Chr(10)+LANInfo\IPAddr[i])
AddGadgetItem(0,-1,"SubMask"+Chr(10)+LANInfo\SubMask[i])
AddGadgetItem(0,-1,"Address"+Chr(10)+LANInfo\Addr[i])
AddGadgetItem(0,-1,"Index"+Chr(10)+LANInfo\Indx[i])
AddGadgetItem(0,-1,"DHCP enabled"+Chr(10)+LANInfo\DHCPE[i])
AddGadgetItem(0,-1,"DCHP IP address"+Chr(10)+LANInfo\DHCPIPAddr[i])
AddGadgetItem(0,-1,"DCHP IP mask"+Chr(10)+LANInfo\DHCPIPMask[i])
AddGadgetItem(0,-1,"DHCP lease obtained"+Chr(10)+LANInfo\DHCPLObt[i])
AddGadgetItem(0,-1,"DHCP lease expires"+Chr(10)+LANInfo\DHCPLExp[i])
AddGadgetItem(0,-1,"Gateway IP address"+Chr(10)+LANInfo\GateIPAddress[i])
AddGadgetItem(0,-1,"Gateway IP mask"+Chr(10)+LANInfo\GateIPMask[i])
AddGadgetItem(0,-1,"Have WINS"+Chr(10)+LANInfo\HaveWINS[i])
If LANInfo\HaveWINS[i] = "Yes"
AddGadgetItem(0,-1,"Primary WINS Server IP address"+Chr(10)+LANInfo\PWINSIPAddress[i])
AddGadgetItem(0,-1,"Primary WINS Server IP mask"+Chr(10)+LANInfo\PWINSIPMask[i])
AddGadgetItem(0,-1,"Secondary WINS Server IP address"+Chr(10)+LANInfo\SWINSIPAddress[i])
AddGadgetItem(0,-1,"Secondary WINS Server IP Mask"+Chr(10)+LANInfo\SWINSIPMask[i])
EndIf
EndIf
Next
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
End 
