Просмотров: 1587 | Дата: 02.05.2024 | Коментарии (0)

Монитор активности Интернет









Продолжение темы http://purebasic.info/, поднятой kvitaliy

Так, как у меня безлимитный интернет, из кода удалил подсчет стоимости...

Версия PureBasic, с момента написания программы изменилась, заменил таймер на встроенную функцию...

Включил график из Друпии, показывающий входящий трафик...


Скачать архив

Code
; Монитор работы интернета с примером статистики трафика в виде обыкновенного текстового файла.  
; PureBasic v.4.41  
; kvitaliy 4.10.2007  

Enumeration  
  #Window_0  
  #TextGadget_2
  #tamer  
EndEnumeration  

Global TrafSpeed$=""  
Global OldInput.l=0  
Global OldOutput.l=0  

Structure WideChar  
  Hi.c  
  Lo.c  
EndStructure  

Structure TMibIfRow  
  wszName.WideChar[256]  
  dwIndex.l  
  dwType.l  
  dwMtu.l  
  dwSpeed.l  
  dwPhysAddrLen.l  
  bPhysAddr.c[8]  
  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.c[256]  
EndStructure  

Structure TMibIfArray  
  Array.TMibIfRow[513]  
EndStructure  

Structure TMibIfTable  
  dwNumEntries.l  
  Table.TMibIfArray  
EndStructure  

Structure TMac  
  Array.c[8]  
EndStructure  

Procedure.l InternetConnected()  
  Protected dwConnectionTypes.l = #INTERNET_CONNECTION_MODEM + #INTERNET_CONNECTION_LAN + #INTERNET_CONNECTION_PROXY  
  ProcedureReturn InternetGetConnectedState_(@dwConnectionTypes,0)  
EndProcedure  

Procedure$ GetMAC(*Value.TMac, Length.l)  
  Protected Result$  
  Static i.l  
  If Length  
  For i = 0 To Length-2  
  Result$ + RSet(Hex(*Value\Array[i]),2,"0") + "-"  
  Next  
  Result$ + RSet(Hex(*Value\Array[Length-1]),2,"0")  
  Else  
  Result$ = "00-00-00-00-00-00"  
  EndIf  
  ProcedureReturn Result$  
EndProcedure  

Procedure.l Traffic(*TrafDownload, *TrafUpload,*Speed)  
  Protected TrafDownload.l, TrafUpload.l,Speed.l  
  Static i.l, Size.l, FLibHandle.l, Table.TMibIfTable, *GetIfTable  
  FLibHandle = OpenLibrary(#PB_Any,"IPHLPAPI.DLL")  
  If Not FLibHandle  
  ProcedureReturn #False  
  EndIf  
  *GetIfTable = GetFunction(FLibHandle,"GetIfTable")  
  If Not *GetIfTable  
  ProcedureReturn #False  
  EndIf  
  Size = SizeOf(TMibIfTable)  
  If CallFunctionFast(*GetIfTable,@Table,@Size,#False) = 0  
  For i = 0 To (Table\dwNumEntries - 1)  
  If GetMAC(@Table\Table\Array[i]\bPhysAddr, Table\Table\Array[i]\dwPhysAddrLen) <> "00-00-00-00-00-00"  
  TrafDownload + Table\Table\Array[i]\dwInOctets  
  TrafUpload + Table\Table\Array[i]\dwOutOctets  
  Speed + Table\Table\Array[i]\dwSpeed  
  EndIf  
  Next  
  EndIf  
  CloseLibrary(FLibHandle)  
  PokeL(*TrafDownload,TrafDownload)  
  PokeL(*TrafUpload, TrafUpload)  
  PokeL(*Speed, Speed)  
  ProcedureReturn #True  
EndProcedure  

Procedure CountTraf()  
If InternetConnected()  
  ;*******************************  
  Traffic(@Input,@Output,@Speed)  
  ;*******************************
  TrafAll=Input+Output  
  PicInp=Input-OldInput ; Пиковая скорость вх  
  PicOut=Output-OldOutput ; Пиковая скорость исх  
  ;*******************************
  If PicInp>0 And PicOut>0  
  ChangeSysTrayIcon(1,ExtractIcon_(0,"netshell.dll",59) )  
  EndIf  
  If PicInp>0 And PicOut=0  
  ChangeSysTrayIcon(1,ExtractIcon_(0,"netshell.dll",61) )  
  EndIf  
  If PicInp=0 And PicOut>0  
  ChangeSysTrayIcon(1,ExtractIcon_(0,"netshell.dll",60) )  
  EndIf  
  If PicInp=0 And PicOut=0  
  ChangeSysTrayIcon(1,ExtractIcon_(0,"netshell.dll",62) )  
  EndIf  
  ;*******************************
  TrafAllMb.d=(TrafAll/1024)/1024  
  TrafSpeed$= StrD(Speed/1000,2)+" Кбит/с Вх=" + StrD(PicInp/1024,2) +" Кб/c Исх="+StrD(PicOut/1024,2)+" Кб/c"  
  ;Debug PicInp
  GraphSet(a,PicInp)
  SetGadgetText(#TextGadget_2,TrafSpeed$)  
  cekund+1  
  cek+1  
  OldInput=Input  
  OldOutput=Output  
  EndIf  
EndProcedure
;*******************************  
OpenWindow(#Window_0, 0, 0, 270, 100, "Трафик: Вхлдящий / Исходящий", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)  
  SetWindowColor(#Window_0, RGB(1, 90, 254))
  SetWindowLongPtr_(WindowID(#Window_0),#GWL_EXSTYLE, #WS_EX_TOOLWINDOW)
  TextGadget(#TextGadget_2, 0, 7, 275, 20, "0 Кбит/сек", #PB_Text_Center)
  SetGadgetColor(#TextGadget_2, #PB_Gadget_FrontColor, RGB(255, 255, 255))  
  SetGadgetColor(#TextGadget_2, #PB_Gadget_BackColor, RGB(1, 90, 254))  
  a=Graph(2,33,261,60,200,0,0,200000,RGB(255,0,0),color=RGB(255,255,0),color=RGB(0,255,0),0)  
  ;*******************************  
  If OpenLibrary(1, "user32.dll")  
  CallFunction(1, "SetLayeredWindowAttributes", WindowID(#Window_0), 0, 255, 2)  
  CloseLibrary(1)  
  EndIf  
  ;*******************************
AddWindowTimer(#Window_0, #tamer, 1000)  
AddSysTrayIcon(1, WindowID(#Window_0),ExtractIcon_(0,"netshell.dll",64))  
  ;*******************************
HideWindow(#Window_0,0)  
Repeat
Event= WaitWindowEvent()
  Select Event
  Case #PB_Event_Timer  
  CountTraf()  
  EndSelect
If Event=#PB_Event_CloseWindow
Break
EndIf
ForEver


К сожалению не разобрался ещё до конца, после работы программы около часа, происходит её зависание...

Переписал функцию графика, но проблема похоже не в нём:


Скачать архив .



Code
Enumeration  
  #Window_0  
  #tamer
  #PB_im
  #grafic
EndEnumeration  

Global NewList MyList.l() ; Создание списка

Procedure CountTraf( )
x=5: y=20: Width=260: Height=50: color=$0501FA
CreateImage(#PB_im, Width, Height)
  If StartDrawing(ImageOutput(#PB_im))
  ResetList(MyList()) ; Сбросить позиции списка в '0 'и сделать первый элемент текущим.
  AddElement(MyList()) ; Добавляет новый пустой элемент  
  MyList()=Random(Height) ; Добавляет в пустой элемент значение
  ;*******************************  
  ForEach MyList() ; перебор всего списка
  rez=MyList()
  If ListIndex(MyList())>Width ; текущая позиция больше ширины  
  DeleteElement(MyList()) ; удаляем элемент из списка
  EndIf
  Line(a,0, 1,Height ,color) ; рисуем линию
  Line(a,0, 1,Height-rez ,RGB(0, 0, 0)) ; рисуем линию
  a+1
  Next
  ;*******************************  
  StopDrawing()
  SetGadgetState(#grafic,ImageID(#PB_im))  
  EndIf
EndProcedure

;*******************************  
OpenWindow(#Window_0, 0, 0, 270, 100, "случайный график", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)  
  SetWindowLongPtr_(WindowID(#Window_0),#GWL_EXSTYLE, #WS_EX_TOOLWINDOW)
  ImageGadget(#grafic,5, 20, 260, 50,0)
  ;******************************
  AddWindowTimer(#Window_0, #tamer, 100)  
  ;*******************************
HideWindow(#Window_0,0)  
Repeat
Event= WaitWindowEvent()
  Select Event
  Case #PB_Event_Timer  
  CountTraf( )  
  EndSelect
If Event=#PB_Event_CloseWindow
Break
EndIf
ForEver












Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.