ステップ27 「メモリ監視ツールを作る①」 - abwiki @ ウィキ (ActiveBasic非公式wiki)

公式のものは4.24でもコンパイル可能であるが、メモリが4GBとかだと値がおかしくなるし、新しいOSにも対応していないので
次のように修正が必要。

' ----------------------------------------------------------------------------
' イベント プロシージャ
' ----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' メモ - 以下の領域を、変数、構造体、定数、関数を宣言するための、
' グローバル領域として利用することができます。
' ----------------------------------ここから----------------------------------

Dim RenewalTiming As Long '更新間隔
RenewalTiming=500 'ミリ秒

Dim GlobalMemoryStatusEx As *Function(ByRef LPMEMORYSTATUSEX As MEMORYSTATUSEX) As Long
Dim hDLL As HANDLE

Type MEMORYSTATUSEX
dwLength As DWord
dwMemoryLoad As DWord
uulTotalPhys As QWord
uulAvailPhys As QWord
uulTotalPageFile As QWord
uulAvailPageFile As QWord
uulTotalVirtual As QWord
uulAvailVirtual As QWord
ullAvailExtendedVirtual As Qword
End Type

' ----------------------------------ここまで----------------------------------

Sub MainWnd_Destroy()

If hDLL Then FreeLibrary(hDLL)

'タイマーを終了する
KillTimer(hMainWnd,0)

SystemWatcher_DestroyObjects()
PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
Dim buf As String
Dim hProgBar As Long

'--------------------------
' OSのバージョン情報を取得
'--------------------------
Dim OsVerInfo As OSVERSIONINFO
Dim BuildNum As Long
OsVerInfo.dwOSVersionInfoSize=Len(OsVerInfo)
GetVersionEx(OsVerInfo)

If OsVerInfo.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS Then
'Windows 9x系OS（メジャーバージョンは常に4）
Select Case OsVerInfo.dwMinorVersion
Case 0
buf="Windows 95"
Case 10
buf="Windows 98"
Case 90
buf="Windows Me"
End Select
BuildNum=LOWORD(OsVerInfo.dwBuildNumber)
ElseIf OsVerInfo.dwPlatformId=VER_PLATFORM_WIN32_NT Then
'Windows NT系OS
If OsVerInfo.dwMajorVersion=4 Then
buf="Windows NT"
ElseIf OsVerInfo.dwMajorVersion=5 Then
If OsVerInfo.dwMinorVersion=0 Then
buf="Windows 2000"
ElseIf OsVerInfo.dwMinorVersion=1 Then
buf="Windows XP"
End If
ElseIf OsVerInfo.dwMajorVersion=6 Then
If OsVerInfo.dwMinorVersion=0 Then
buf="Windows Vista"
ElseIf OsVerInfo.dwMinorVersion=1 Then
buf="Windows 7"
End If

End If
BuildNum=OsVerInfo.dwBuildNumber
End If


'OS情報をウィンドウに表示する
SetWindowText(GetDlgItem(hMainWnd,Static_OSName),buf)
SetWindowText(GetDlgItem(hMainWnd,Static_OSBuildNum),Str$(BuildNum))
SetWindowText(GetDlgItem(hMainWnd,Static_OSNote),OsVerInfo.szCSDVersion)


'------------------
' メモリ情報を取得
'------------------
Dim MemStatus As MEMORYSTATUS
Dim MemStatusex As MEMORYSTATUSEX
Dim rate_Physical As Long, rate_Virtual As Long

If OsVerInfo.dwMajorVersion = 4 Then
MemStatus.dwLength=Len(MemStatus)
GlobalMemoryStatus(MemStatus)
'物理メモリに関する情報を表示する
rate_Physical=MemStatus.dwMemoryLoad
SetWindowText(GetDlgItem(hMainWnd,Static_RatePhysical),Str$(rate_Physical)+"%")
SetWindowText(GetDlgItem(hMainWnd,Static_TotalPhysical),Str$(Int(MemStatus.dwTotalPhys/1024))+"KB")
SetWindowText(GetDlgItem(hMainWnd,Static_UsedPhysical),Str$(Int((MemStatus.dwTotalPhys-MemStatus.dwAvailPhys)/1024))+"KB")

'仮想メモリに関する情報を表示する
rate_Virtual=Int(CDbl(MemStatus.dwTotalPageFile-MemStatus.dwAvailPageFile)/CDbl(MemStatus.dwTotalPageFile)*100)
SetWindowText(GetDlgItem(hMainWnd,Static_RateVirtual),Str$(rate_Virtual)+"%")
SetWindowText(GetDlgItem(hMainWnd,Static_TotalVirtual),Str$(Int(MemStatus.dwTotalPageFile/1024))+"KB")
SetWindowText(GetDlgItem(hMainWnd,Static_UsedVirtual),Str$(Int((MemStatus.dwTotalPageFile-MemStatus.dwAvailPageFile)/1024))+"KB")
Else If OsVerInfo.dwMajorVersion > 4 Then
hDLL = LoadLibrary("kernel32")
GlobalMemoryStatusEx = GetProcAddress(hDLL, "GlobalMemoryStatusEx")

MemStatusex.dwLength=Len(MemStatusex)
GlobalMemoryStatusEx(MemStatusex)

rate_Physical=MemStatusex.dwMemoryLoad
SetWindowText(GetDlgItem(hMainWnd,Static_RatePhysical),Str$(rate_Physical)+"%")
SetWindowText(GetDlgItem(hMainWnd,Static_TotalPhysical),Str$(Int(MemStatusex.uulTotalPhys/1024))+"KB")
SetWindowText(GetDlgItem(hMainWnd,Static_UsedPhysical),Str$(Int((MemStatusex.uulTotalPhys-MemStatusex.uulAvailPhys)/1024))+"KB")

'仮想メモリに関する情報を表示する
rate_Virtual=Int(CDbl(MemStatusex.uulTotalPageFile-MemStatusex.uulAvailPageFile)/CDbl(MemStatusex.uulTotalPageFile)*100)
SetWindowText(GetDlgItem(hMainWnd,Static_RateVirtual),Str$(rate_Virtual)+"%")
SetWindowText(GetDlgItem(hMainWnd,Static_TotalVirtual),Str$(Int(MemStatusex.uulTotalPageFile/1024))+"KB")
SetWindowText(GetDlgItem(hMainWnd,Static_UsedVirtual),Str$(Int((MemStatusex.uulTotalPageFile-MemStatusex.uulAvailPageFile)/1024))+"KB")
End If
'物理メモリ使用率のプログレスバーの初期設定
SendMessage(GetDlgItem(hMainWnd,ProgressBar_Physical),PBM_SETRANGE,0,MAKELONG(0,100))
SendMessage(GetDlgItem(hMainWnd,ProgressBar_Physical),PBM_SETPOS,rate_Physical,0)

'仮想メモリ使用率のプログレスバーの初期設定
SendMessage(GetDlgItem(hMainWnd,ProgressBar_Virtual),PBM_SETRANGE,0,MAKELONG(0,100))
SendMessage(GetDlgItem(hMainWnd,ProgressBar_Virtual),PBM_SETPOS,rate_Virtual,0)


'メモリ使用率のタイマーを設定（RenewalTiming秒間隔）
SetTimer(hMainWnd,OsVerInfo.dwMajorVersion,RenewalTiming,0)
End Sub

Sub MainWnd_Timer(ByVal TimerID As Long)
Dim MemStatus As MEMORYSTATUS
Dim rate_Physical As Long, rate_Virtual As Long
Dim MemStatusex As MEMORYSTATUSEX


'------------------
' メモリ情報を取得
'------------------
If TimerID = 4 Then
MemStatus.dwLength=Len(MemStatus)
GlobalMemoryStatus(MemStatus)

'物理メモリに関する情報を更新する
rate_Physical=MemStatus.dwMemoryLoad
SetWindowText(GetDlgItem(hMainWnd,Static_RatePhysical),Str$(rate_Physical)+"%")
SetWindowText(GetDlgItem(hMainWnd,Static_UsedPhysical),Str$(Int((MemStatus.dwTotalPhys-MemStatus.dwAvailPhys)/1024))+"KB")

'仮想メモリに関する情報を更新する
rate_Virtual=Int(CDbl(MemStatus.dwTotalPageFile-MemStatus.dwAvailPageFile)/CDbl(MemStatus.dwTotalPageFile)*100)
SetWindowText(GetDlgItem(hMainWnd,Static_RateVirtual),Str$(rate_Virtual)+"%")
SetWindowText(GetDlgItem(hMainWnd,Static_UsedVirtual),Str$(Int((MemStatus.dwTotalPageFile-MemStatus.dwAvailPageFile)/1024))+"KB")

Else If TimerID > 4 Then
MemStatusex.dwLength=Len(MemStatusex)
GlobalMemoryStatusEx(MemStatusex)

'物理メモリに関する情報を更新する
rate_Physical=MemStatusex.dwMemoryLoad
SetWindowText(GetDlgItem(hMainWnd,Static_RatePhysical),Str$(rate_Physical)+"%")
SetWindowText(GetDlgItem(hMainWnd,Static_UsedPhysical),Str$(Int((MemStatusex.uulTotalPhys-MemStatusex.uulAvailPhys)/1024))+"KB")

'仮想メモリに関する情報を更新する
rate_Virtual=Int(CDbl(MemStatusex.uulTotalPageFile-MemStatusex.uulAvailPageFile)/CDbl(MemStatusex.uulTotalPageFile)*100)
SetWindowText(GetDlgItem(hMainWnd,Static_RateVirtual),Str$(rate_Virtual)+"%")
SetWindowText(GetDlgItem(hMainWnd,Static_UsedVirtual),Str$(Int((MemStatusex.uulTotalPageFile-MemStatusex.uulAvailPageFile)/1024))+"KB")

End If
'プログレスバーの位置を設定
SendMessage(GetDlgItem(hMainWnd,ProgressBar_Physical),PBM_SETPOS,rate_Physical,0)
SendMessage(GetDlgItem(hMainWnd,ProgressBar_Virtual),PBM_SETPOS,rate_Virtual,0)
End Sub