ToolHelp関数を使って他アプリケーションのヒープサイズを測っています。
今のところHeap32First+Heap32Nextを繰り返し回して合計を返すようにしているのですが、この部分が激烈に遅いのです。
例えばexplorer.exeのヒープサイズを測ろうとすると30秒近く待たされるのです。
var
h: THandle;
pe: TProcessEntry32;
hl: THeapList32;
he: THeapEntry32;
HeapSize: DWord;
st: Integer;
begin
h := CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
if h = INVALID_HANDLE_VALUE then
begin
Exit;
end;
pe.dwSize := SizeOf(TProcessEntry32);
if Process32First( h, pe ) then
repeat
if pe.szExeFile='explorer.exe' then
Break;
until not Process32Next( h, pe );
CloseHandle( h );
h := CreateToolhelp32Snapshot( TH32CS_SNAPALL, pe.th32ProcessID );
if h = INVALID_HANDLE_VALUE then begin
Exit;
end;
//ヒープの列挙
st:=GetTickCount;
HeapSize:=0;
hl.dwSize:=SizeOf(THeapList32);
if Heap32ListFirst( h, hl ) then begin
repeat
he.dwSize:=SizeOf(THeapEntry32);
if Heap32First( he, hl.th32ProcessID, hl.th32HeapID ) then begin
repeat
if he.dwFlags and LF32_FREE = 0 then
Inc(HeapSize,he.dwBlockSize);
until not Heap32Next( he );
end;
until not Heap32ListNext( h, hl );
end;
MessageBox(Handle,
PChar(Format('Time: %d'#13+
'Heap Use: %d',
[GetTickCount-st, HeapSize]))
,'',0);
CloseHandle( h );
end;
実行環境は Win2k+D5+P3 850MHz です。
タスクマネージャで監視していると、Heap32Nextのループでexplorer.exeのプロセス占有が上がっていました。
なんとか速度を改善する方法、またはヒープサイズの計測で別な方法があればご教授願います。