PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

How-To: Netzwerk-Status abfragen

https://www.purebasic.fr/german/viewtopic.php?t=4516

Seite 4 von 4

Verfasst: 06.09.2005 19:35
von honk
ursprünglich stammt es aus diesem forum, und da ich's grad brauchte aber net fand, wollte ich's hier suchen, fand aber nur diesen thread...
also hab ich nochmal gründlich meine hdd durchforstet und wills nicht vorenthalten:

Code: Alles auswählen

#MAX_INTERFACE_NAME_LEN = 256
#MAXLEN_PHYSADDR        = 8
#MAXLEN_IFDESCR         = 256
#ERROR_SUCCESS          = 0
#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

Structure MIB_IFROW
  wszName.b[#MAX_INTERFACE_NAME_LEN*2]
  dwIndex.l                        ; index of the interface
  dwType.l                         ; type of interface
  dwMtu.l                          ; max transmission unit
  dwSpeed.l                        ; speed of the interface
  dwPhysAddrLen.l                  ; length of physical address
  bPhysAddr.b[#MAXLEN_PHYSADDR]    ; physical address of adapter
  dwAdminStatus.l                  ; administrative status
  dwOperStatus.l                   ; operational status
  dwLastChange.l                   ; last time operational status changed
  dwInOctets.l                     ; octets received
  dwInUcastPkts.l                  ; unicast packets received
  dwInNUcastPkts.l                 ; non-unicast packets received
  dwInDiscards.l                   ; received packets discarded
  dwInErrors.l                     ; erroneous packets received
  dwInUnknownProtos.l              ; unknown protocol packets received
  dwOutOctets.l                    ; octets sent
  dwOutUcastPkts.l                 ; unicast packets sent
  dwOutNUcastPkts.l                ; non-unicast packets sent
  dwOutDiscards.l                  ; outgoing packets discarded
  dwOutErrors.l                    ; erroneous packets sent
  dwOutQLen.l                      ; output queue length
  dwDescrLen.l                     ; length of bDescr member
  bDescr.b[#MAXLEN_IFDESCR]        ; interface description
EndStructure

Procedure.l GetIFInfo()
  Protected IPInterfaceRow.MIB_IFROW
  Protected Buffer.l , BufferSize.l , nStructSize.l , nRows.l , cnt.l
  BufferSize = 0
  RetCode.l = GetIfTable_( #NULL , @BufferSize , #TRUE )
  If RetCode = 122
    Buffer = AllocateMemory( BufferSize )
    GetIfTable_( Buffer , @BufferSize , #TRUE ); = #ERROR_SUCCESS
    nStructSize = SizeOf(IPInterfaceRow)
    CopyMemory( Buffer , @nRows , 4 )
    Dim ListArray.s(nRows,20)
    ListArray(0,0)  = "Interface Description"
    ListArray(0,1)  = "Index of the Interface"
    ListArray(0,2)  = "Type of interface"
    ListArray(0,3)  = "Max transmission unit"
    ListArray(0,4)  = "Speed of the interface"
    ListArray(0,5)  = "Physical address of adapter"
    ListArray(0,6)  = "Administrative status"
    ListArray(0,7)  = "Operational status"
    ListArray(0,8)  = "Last time operational status changed"
    ListArray(0,9)  = "Octets received"
    ListArray(0,10) = "Octets sent "
    ListArray(0,11) = "Unicast packets received "
    ListArray(0,12) = "Unicast packets sent"
    ListArray(0,13) = "Non-unicast packets received"
    ListArray(0,14) = "Non-unicast packets sent"
    ListArray(0,15) = "Received packets discarded"
    ListArray(0,16) = "Outgoing packets discarded"
    ListArray(0,17) = "Erroneous packets received"
    ListArray(0,18) = "Erroneous packets sent"
    ListArray(0,19) = "Unknown protocol packets received"
    ListArray(0,20) = "Output queue length"
    For cnt = 1 To nRows
      CopyMemory( (Buffer + 4 + (cnt - 1) * nStructSize) , @IPInterfaceRow , nStructSize )
      For i = 0 To (IPInterfaceRow\dwDescrLen - 1)
        IF_Description.s
        IF_Description = IF_Description + Chr(IPInterfaceRow\bDescr[i])
      Next i
      For j = 0 To (IPInterfaceRow\dwPhysAddrLen - 1)
        IF_PhysAddress.s
        If j<>(IPInterfaceRow\dwPhysAddrLen - 1)
          IF_PhysAddress = IF_PhysAddress + Hex(IPInterfaceRow\bPhysAddr[j]) + "-"
        Else
          IF_PhysAddress = IF_PhysAddress + Hex(IPInterfaceRow\bPhysAddr[j])
        EndIf
        If FindString(IF_PhysAddress,"FFFFFF",1)
          IF_PhysAddress = RemoveString(IF_PhysAddress, "FFFFFF",1)
        EndIf
      Next j
      If Len(IF_PhysAddress) = 0
        IF_PhysAddress = "No physical address"
      EndIf
      ListArray(cnt,0)  = IF_Description
      ListArray(cnt,1)  = Str(IPInterfaceRow\dwIndex)
      ListArray(cnt,2)  = Str(IPInterfaceRow\dwType)
      ListArray(cnt,3)  = Str(IPInterfaceRow\dwMtu)
      ListArray(cnt,4)  = Str(IPInterfaceRow\dwSpeed)
      ListArray(cnt,5)  = IF_PhysAddress
      ListArray(cnt,6)  = Str(IPInterfaceRow\dwAdminStatus)
      ListArray(cnt,7)  = Str(IPInterfaceRow\dwOperStatus)
      ListArray(cnt,8)  = Str(IPInterfaceRow\dwLastChange)
      ListArray(cnt,9)  = Str(IPInterfaceRow\dwInOctets)
      ListArray(cnt,10) = Str(IPInterfaceRow\dwOutOctets)
      ListArray(cnt,11) = Str(IPInterfaceRow\dwInUcastPkts)
      ListArray(cnt,12) = Str(IPInterfaceRow\dwOutUcastPkts)
      ListArray(cnt,13) = Str(IPInterfaceRow\dwInNUcastPkts)
      ListArray(cnt,14) = Str(IPInterfaceRow\dwOutNUcastPkts)
      ListArray(cnt,15) = Str(IPInterfaceRow\dwInDiscards)
      ListArray(cnt,16) = Str(IPInterfaceRow\dwOutDiscards)
      ListArray(cnt,17) = Str(IPInterfaceRow\dwInErrors)
      ListArray(cnt,18) = Str(IPInterfaceRow\dwOutErrors)
      ListArray(cnt,19) = Str(IPInterfaceRow\dwInUnknownProtos)
      ListArray(cnt,20) = Str(IPInterfaceRow\dwOutQLen)
      IF_PhysAddress = ""
      IF_Description = ""
    Next cnt
  EndIf
  ProcedureReturn nRows
EndProcedure


If OpenWindow(0,500,500,580,320,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"Interface List") 

  If CreateGadgetList(WindowID(0)) 
    ListIconGadget(0, 0, 0, 580, 318, "Value",192,#PB_ListIcon_GridLines) 

      nRows.l = GetIFInfo() 
      For a=1 To nRows          ; fügt weitere Spalten zum ListIcon hinzu 
        AddGadgetColumn(0,a,"Interface "+Str(a),(384/nRows)) 
      Next 

        
      For b=0 To 20          ; fügt 4 Einträge auf jeder Zeile des ListIcons hinzu 
          y=b    
          AddGadgetItem(0,b,ListArray(0,b)); + Chr(10)+LineArray(b)) 
      Next 
  EndIf 


  Repeat 
    temp.l = GetIFInfo()
    If nRows <> temp
      nRows.l = temp
      FreeGadget(0) 
      If CreateGadgetList(WindowID(0)) 
      ListIconGadget(0, 0, 0, 580, 318, "Value",192,#PB_ListIcon_GridLines) 

        For a=1 To nRows          ; fügt weitere Spalten zum ListIcon hinzu 
          AddGadgetColumn(0,a,"Interface "+Str(a),(384/nRows)) 
        Next 

        
        For b=0 To 20          ; fügt 4 Einträge auf jeder Zeile des ListIcons hinzu 
          y=b    
          AddGadgetItem(0,b,ListArray(0,b)); + Chr(10)+LineArray(b)) 
        Next 
      EndIf 

    EndIf 

    nRows = GetIFInfo() 
    For b=0 To 20 
      For a=1 To nRows 
        SetGadgetItemText(0, b, ListArray(a,b) , a) 
      Next 
    Next 

    Delay(50) 
  Until WindowEvent()=#PB_Event_CloseWindow 
EndIf

Verfasst: 10.03.2006 00:10
von SoS
Benötigt wird PB4 beta 5,Timerlib (PBOSL) für PB4

Code: Alles auswählen

#MAX_INTERFACE_NAME_LEN       = 256
#MAXLEN_IFDESCR                      = 256
#MAXLEN_PHYSADDR                   = 8

Structure MIB_IFROW
  wszName.b [#MAX_INTERFACE_NAME_LEN*2]
  dwIndex.l
  dwType.l
  dwMtu.l
  dwSpeed.l
  dwPhysAddrLen.l
  bPhysAddr.b [#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.b [#MAXLEN_IFDESCR]
EndStructure

Structure ifTable
  nRows.l
  ifRow.MIB_IFROW [10]
EndStructure

Global Window_0, Text_0, Text_1, Text_2, ProgressBar_0
Global ProgressBar_1

Structure VisualDesignerGadgets
  Gadget.l
  EventFunction.l
EndStructure

Global NewList EventProcedures.VisualDesignerGadgets()

Procedure RegisterGadgetEvent(Gadget, *Function)

  If IsGadget(Gadget)
    AddElement(EventProcedures())
    EventProcedures()\Gadget        = Gadget
    EventProcedures()\EventFunction = *Function
  EndIf

EndProcedure

Procedure CallEventFunction(Window, Event, Gadget, Type)

  ForEach EventProcedures()
    If EventProcedures()\Gadget = Gadget
      CallFunctionFast(EventProcedures()\EventFunction, Window, Event, Gadget, Type)
      LastElement(EventProcedures())
    EndIf
  Next

EndProcedure

Procedure Open_Window_0()

  Window_0 = OpenWindow(#PB_Any, 122, 313, 472, 137,  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Window 0")
  If Window_0
    If CreateGadgetList(WindowID(Window_0))
      Text_0 = TextGadget(#PB_Any, 10, 10, 130, 20, "", #PB_Text_Center | #PB_Text_Border)
      Text_1 = TextGadget(#PB_Any, 10, 50, 130, 20, "", #PB_Text_Center | #PB_Text_Border)
      Text_2 = TextGadget(#PB_Any, 10, 90, 130, 20, "", #PB_Text_Center | #PB_Text_Border)
      ProgressBar_0 = ProgressBarGadget(#PB_Any, 150, 10, 310, 20, 0, 300, #PB_ProgressBar_Smooth)
      ProgressBar_1 = ProgressBarGadget(#PB_Any, 150, 50, 310, 20, 0, 50, #PB_ProgressBar_Smooth)
    EndIf
  EndIf
EndProcedure

Procedure traffic()
  Shared pIfTable.ifTable,m_rec.f,m_sen.f,m_down.f,m_up.f
  Static m_recv_old,m_sent_old
  pdwSize.l=0
  m_recv.l=0
  m_sent.l=0
  GetIfTable_(#Null,@pdwSize.l, #True)
  GetIfTable_(@pIfTable.ifTable,@pdwSize.l, #True)

  For i = 1 To pIfTable\nRows
    m_recv + pIfTable\ifRow[i]\dwInOctets
    m_sent + pIfTable\ifRow[i]\dwOutOctets
  Next

  m_rec.f = m_recv/1048576
  m_sen.f = m_sent/1048576
  m_down.f = (m_recv - m_recv_old)/1024
  m_up.f     = (m_sent - m_sent_old)/1024
  m_recv_old = m_recv
  m_sent_old = m_sent
EndProcedure

Open_Window_0()
StartTimer( 1 , 1000 , @traffic() )

Repeat

  SetGadgetText(Text_0, StrF(m_down,2)+" kb/s")
  SetGadgetText(Text_1, StrF(m_up,2)+" kb/s")
  SetGadgetText(Text_2, StrF((m_rec+m_sen),2)+" MB")
  SetGadgetState(ProgressBar_0, m_down)
  SetGadgetState(ProgressBar_1, m_up)
  Event = WindowEvent()
  Gadget = EventGadget()
  Type   = EventType()
  Window = EventWindow()

  Select Event
    Case #PB_Event_Gadget
      CallEventFunction(Window, Event, Gadget, Type)
  EndSelect

  WindowID = EventWindow()

  GadgetID = EventGadget()

  If Event = #PB_Event_Gadget

  EndIf
  Delay(1)

Until Event = #PB_Event_CloseWindow
EndTimer( 1 )

End
/edit

Für die Beta 6

Code: Alles auswählen

Window_0 = OpenWindow(#PB_Any, 122, 313, 472, 137, "Window 0",  #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
Alle Zeiten sind UTC+02:00
Seite 4 von 4

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de