Code: Select all
''
'' This app displays a simple disk drive activity indicator in
'' the Taskbar notification area (a.k.a. system tray). Requires
'' Windows 2000 or later (or Windows NT 4.0 with pdh.dll added).
''
#include once "windows.bi"
#include once "win/shellapi.bi"
#include "pdh.bi"
option explicit
'*************************************************************************
#define WM_CALLBACK WM_USER+100
#define IDI_TASKBARICON 0
#define IDM_EXIT 1000
#define ID_TIMER 1
dim shared hPopupMenu as HMENU
dim shared hQueryR as PDH_HQUERY
dim shared hQueryW as PDH_HQUERY
dim shared hCounterR as PDH_HCOUNTER
dim shared hCounterW as PDH_HCOUNTER
dim shared hIconRW as HICON
dim shared hIconNA as HICON
dim shared hIconR as HICON
dim shared hIconW as HICON
dim shared nid as NOTIFYICONDATA
dim shared pfcR as PDH_FMT_COUNTERVALUE
dim shared pfcw as PDH_FMT_COUNTERVALUE
sub TimerProc
static as uint queryCountR, queryCountW
static as uint queryTotalR, queryTotalW
static as uint prevStateR, prevStateW
dim as uint stateR, stateW, fChange
'' To ensure that the display states will persist long
'' enough to be readily visible, sum the counter values
'' over 10 timer periods (so the display states will
'' persist for at least 100ms).
PdhCollectQueryData( hQueryR )
PdhGetFormattedCounterValue( hCounterR, PDH_FMT_LONG, 0, @pfcR )
if pfcR.CStatus = PDH_CSTATUS_VALID_DATA then
queryCountR += 1
queryTotalR += pfcR.longValue
if queryCountR = 10 then
stateR = queryTotalR > 0
queryCountR = 0
queryTotalR = 0
if prevStateR <> stateR then
prevStateR = stateR
fChange = true
endif
endif
endif
PdhCollectQueryData( hQueryW )
PdhGetFormattedCounterValue( hCounterW, PDH_FMT_LONG, 0, @pfcW )
if pfcW.CStatus = PDH_CSTATUS_VALID_DATA then
queryCountW += 1
queryTotalW += pfcW.longValue
if queryCountW = 10 then
stateW = queryTotalW > 0
queryCountW = 0
queryTotalW = 0
if prevStateW <> stateW then
prevStateW = stateW
fChange = true
endif
endif
endif
if fChange then
if stateR and stateW then
nid.hIcon = hIconRW
elseif stateR then
nid.hIcon = hIconR
elseif stateW then
nid.hIcon = hIconW
else
nid.hIcon = hIconNA
endif
Shell_NotifyIcon( NIM_MODIFY, @nid )
endif
end sub
function WindowProc( byval hWnd as HWND, _
byval uMsg as UINT, _
byval wParam as WPARAM, _
byval lParam as LPARAM ) as LRESULT
dim hMod as HMODULE
dim pt as POINT
select case uMsg
case WM_CREATE
hMod = GetModuleHandle( null )
hIconRW = LoadImage( hMod, MAKEINTRESOURCEA(1000), _
IMAGE_ICON, 0, 0, null )
hIconR = LoadImage( hMod, MAKEINTRESOURCEA(2000), _
IMAGE_ICON, 0, 0, null )
hIconW = LoadImage( hMod, MAKEINTRESOURCEA(3000), _
IMAGE_ICON, 0, 0, null )
hIconNA = LoadImage( hMod, MAKEINTRESOURCEA(4000), _
IMAGE_ICON, 0, 0, null )
hPopupMenu = CreatePopupMenu
AppendMenu( hPopupMenu, MF_STRING, IDM_EXIT, "Exit" )
nid.cbSize = len( NOTIFYICONDATA )
nid.hwnd = hWnd
nid.uID = IDI_TASKBARICON
nid.uFlags = NIF_ICON + NIF_MESSAGE + NIF_TIP
nid.uCallbackMessage = WM_CALLBACK
nid.hIcon = hIconNA
nid.szTip = "HDD Activity Monitor"
Shell_NotifyIcon( NIM_ADD, @nid )
return 0
case WM_DESTROY
PostQuitMessage( null )
return 0
case WM_TIMER
TimerProc
return 0
case WM_COMMAND
if lParam = 0 then
Shell_NotifyIcon( NIM_DELETE, @nid )
if wParam = IDM_EXIT then
DestroyWindow( hWnd )
endif
endif
return 0
case WM_CALLBACK
if wParam = IDI_TASKBARICON then
if lParam = WM_RBUTTONDOWN then
'' To avoid a problem with the menu not closing
'' when the user clicks somewhere else our window
'' must be the foreground window.
''
SetForegroundWindow( hWnd )
GetCursorPos( @pt )
TrackPopupMenu( hPopupMenu, TPM_RIGHTALIGN, _
pt.x, pt.y, null, hWnd, null )
endif
endif
return 0
case else
return DefWindowProc( hWnd, uMsg, wParam, lParam )
end select
end function
function WinMain( byval hInstance as HINSTANCE,_
byval hPrevInstance as HINSTANCE,_
lpCmdLine as string,_
byval nCmdShow as integer )
dim hWnd as HWND
dim nSize as DWORD
dim wMsg as MSG
dim wcx as WNDCLASSEX
dim className as string = "HddActivityMonitor_class"
dim machineName as string * MAX_COMPUTERNAME_LENGTH + 1
dim objectName as string * 128
dim counterNameR as string * 128
dim counterNameW as string * 128
dim instanceName as string = "_Total"
dim counterPath as string * PDH_MAX_COUNTER_PATH
dim pcpe as PDH_COUNTER_PATH_ELEMENTS
nSize = MAX_COMPUTERNAME_LENGTH + 1
GetComputerName( machineName, @nSize )
'' Lookup the object and counter names by index so the object
'' and counters will be correctly specified on non-English
'' language systems. For whatever reason, instance names are
'' English only.
'' Index 234 is "PhysicalDisk" on English language systems.
''
nSize = 128
PdhLookupPerfNameByIndex( strptr(machineName), 234, _
strptr(objectName), @nSize )
'' Index 202 is "% Disk Read Time" on English language systems.
''
nSize = 128
PdhLookupPerfNameByIndex( strptr(machineName), 202, _
strptr(counterNameR), @nSize )
' Index 204 is "% Disk Write Time" on English language systems.
'
nSize = 128
PdhLookupPerfNameByIndex( strptr(machineName), 204, _
strptr(counterNameW), @nSize )
pcpe.szMachineName = strptr( machineName )
pcpe.szObjectName = strptr( objectName )
pcpe.szCounterName = strptr( counterNameR )
pcpe.szInstanceName = strptr( instanceName )
pcpe.szParentInstance = null
pcpe.dwInstanceIndex = -1
nSize = PDH_MAX_COUNTER_PATH
PdhMakeCounterPath( @pcpe, strptr( counterPath ), @nSize, 0 )
PdhOpenQuery( null, null, @hQueryR )
PdhAddCounter( hQueryR, strptr( counterPath ), null, @hCounterR )
pcpe.szMachineName = strptr( machineName )
pcpe.szObjectName = strptr( objectName )
pcpe.szCounterName = strptr( counterNameW )
pcpe.szInstanceName = strptr( instanceName )
pcpe.szParentInstance = null
pcpe.dwInstanceIndex = -1
nSize = PDH_MAX_COUNTER_PATH
PdhMakeCounterPath( @pcpe, strptr( counterPath ), @nSize, 0 )
PdhOpenQuery( null, null, @hQueryW )
PdhAddCounter( hQueryW, strptr( counterPath ), null, @hCounterW )
with wcx
.cbSize = len( WNDCLASSEX )
.style = CS_HREDRAW or CS_VREDRAW or CS_BYTEALIGNWINDOW
.lpfnWndProc = cast( WNDPROC, @WindowProc )
.cbClsExtra = null
.cbWndExtra = null
.hInstance = hInstance
.hbrBackground = cast( HBRUSH, COLOR_WINDOW + 1 )
.lpszMenuName = null
.lpszClassName = strptr( className )
.hIcon = LoadIcon( null, IDI_APPLICATION )
.hCursor = LoadCursor( null, IDC_ARROW )
.hIconSm = LoadIcon( null, IDI_APPLICATION )
end with
RegisterClassEx( @wcx )
hWnd = CreateWindowEx( WS_EX_OVERLAPPEDWINDOW, _
strptr( className ), _
"Hdd Activity Monitor", _
WS_OVERLAPPEDWINDOW, _
10, 10, 300, 200, _
null, null, hInstance, null )
'' This for debug only.
''
'' ShowWindow( hWnd, nCmdShow )
'' Poll the counters at the maximum timer frequency to minimize
'' the number of undetected disk activities. The processor time
'' is negligible even at the maximum timer frequency.
''
SetTimer( hWnd, ID_TIMER, 10, null )
do until( GetMessage( @wMsg, null, 0, 0 ) = 0 )
TranslateMessage( @wMsg )
DispatchMessage( @wMsg )
loop
PdhCloseQuery( hQueryR )
PdhCloseQuery( hQueryW )
KillTimer( hWnd, ID_TIMER )
return wMsg.wParam
end function
end WinMain( GetModuleHandle( null ), null, Command$, SW_NORMAL )
Code: Select all
1000 ICON "rw.ico" ; First will be application icon
2000 ICON "read.ico"
3000 ICON "write.ico"
4000 ICON "na.ico"
Code: Select all
LIBRARY PDH.DLL
EXPORTS
PdhAddCounterA@16
PdhAddCounterW@16
PdhCloseQuery@4
PdhCollectQueryData@4
PdhGetFormattedCounterValue@16
PdhLookupPerfIndexByNameA@12
PdhLookupPerfIndexByNameW@12
PdhLookupPerfNameByIndexA@16
PdhLookupPerfNameByIndexW@16
PdhMakeCounterPathA@16
PdhMakeCounterPathW@16
PdhOpenQuery@12
Code: Select all
:
: This assumes that dlltool.exe and as.exe are in the current directory
:
dlltool -k -d pdh.dll.def -l pdh.dll.a
pause
Code: Select all
''
'' This file defines a *small* subset of the PDH functions and
'' related data types and structures.
''
#inclib "pdh"
#define PDH_MAX_COUNTER_PATH 2048
#define PDH_FMT_LONG &h00000100
#define PDH_CSTATUS_VALID_DATA 0
type PDH_STATUS as UINT
type PDH_HQUERY as UINT
type PDH_HCOUNTER as UINT
type PDH_COUNTER_PATH_ELEMENTS
szMachineName as LPTSTR
szObjectName as LPTSTR
szInstanceName as LPTSTR
szParentInstance as LPTSTR
dwInstanceIndex as DWORD
szCounterName as LPTSTR
end type
type PDH_FMT_COUNTERVALUE
CStatus as DWORD
padding as DWORD
union
longValue as LONG
doubleValue as DOUBLE
largeValue as DWORDLONG
AnsiStringValue as LPCSTR
WideStringValue as LPCWSTR
end union
end type
declare function PdhAddCounter alias "PdhAddCounterA" _
(byval as PDH_HQUERY, byval as LPCTSTR, _
byval as DWORD_PTR, byval as PDH_HCOUNTER ptr) _
as PDH_STATUS
declare function PdhCloseQuery alias "PdhCloseQuery" _
(byval as PDH_HQUERY) _
as PDH_STATUS
declare function PdhCollectQueryData alias "PdhCollectQueryData" _
(byval as PDH_HQUERY) _
as PDH_STATUS
declare function PdhGetFormattedCounterValue alias "PdhGetFormattedCounterValue" _
(byval as PDH_HCOUNTER, _
byval as DWORD, byval as LPDWORD, _
byval as PDH_FMT_COUNTERVALUE ptr) _
as PDH_STATUS
declare function PdhLookupPerfIndexByName alias "PdhLookupPerfIndexByNameA" _
(byval as LPCTSTR, _
byval as LPCTSTR, _
byval as LPDWORD) _
as PDH_STATUS
declare function PdhLookupPerfNameByIndex alias "PdhLookupPerfNameByIndexA" _
(byval as LPCTSTR, _
byval as DWORD, _
byval as LPTSTR, _
byval as LPDWORD) _
as PDH_STATUS
declare function PdhMakeCounterPath alias "PdhMakeCounterPathA" _
(byval as PDH_COUNTER_PATH_ELEMENTS ptr, _
byval as LPTSTR, _
byval as LPDWORD, _
byval as DWORD) _
as PDH_STATUS
declare function PdhOpenQuery alias "PdhOpenQuery" _
(byval as LPCTSTR, _
byval as DWORD_PTR, _
byval as PDH_HQUERY ptr) _
as PDH_STATUS