Так, как у меня безлимитный интернет, из кода удалил подсчет стоимости...
Версия 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