2010年4月17日土曜日

プロセスリストを表示する。

プロセスの一覧を表示するサンプルです。

Toolhelp32(DelphではTlHelp32)が使える環境では
比較的簡単ですが、

procedure TForm1.Button2Click(Sender: TObject);
var
 ProcEntry : TProcessEntry32W;
   SanpshotHandle : THandle;
begin
 //Toolhelp32を使用する例
   SanpshotHandle := TlHelp32.CreateToolhelp32Snapshot(TlHelp32.TH32CS_SNAPPROCESS,0);
   if (SanpshotHandle <> -1) then
   begin
    ListBox1.Items.Clear;
    ProcEntry.dwSize := Sizeof(TProcessEntry32W);
      if (TlHelp32.Process32First(SanpshotHandle, ProcEntry)) Then
      begin
         repeat
          ListBox1.Items.Add(ProcEntry.szExeFile);
         until (TlHelp32.Process32Next(SanpshotHandle,ProcEntry) = false);
      end;
   end;
   CloseHandle(SanpshotHandle);

end;



使えない環境(といいても、4.0以下のNTだけですが・・・)だと
大変です。



procedure TForm1.Button1Click(Sender: TObject);
var
    cb : Cardinal;
   elements : Cardinal;
   Needs : Cardinal;
   ProcIdArray : Array of DWORD;
   Win32Ret : LongBool;
   i : Cardinal;
   ProcHandle : THandle;
   OpenMode : THandle;
   ProcessName : String;

begin

    //プロセス数がいくつあるか解らないので大きめにとっておく
   elements := 128;
   Needs := elements * Sizeof(DWORD);
   cb := 0;
   while (cb <= Needs) do
   begin

        SetLength(ProcIdArray, elements);
       cb := Length(ProcIdArray) * Sizeof(DWORD);
       Needs := 0;
      Win32Ret := PsApi.EnumProcesses(PDWORD(ProcIdArray),cb,Needs);

      //APIが失敗したら抜ける
      if (not(Win32Ret)) then
      begin
         break;
      end;

      //領域が足りなかったときに備えて倍にする。
      elements := elements * 2;

   end;

   if (Win32Ret) then
   begin
       ListBox1.Items.Clear;
      OpenMode := Windows.PROCESS_QUERY_INFORMATION or Windows.PROCESS_VM_READ;
        elements := Needs div Sizeof(DWORD);
       for i := 0 to elements - 1 do
       begin
          //プロセスIDから情報をえる
         ProcHandle := Windows.OpenProcess(OpenMode,FALSE,ProcIdArray[i]);
         if (ProcHandle <> 0) then
         begin
             ProcessName := GetProcessName(ProcHandle);
            if (Length(ProcessName) > 0) then
            begin
                ListBox1.Items.Add(ProcessName);
            end;
         end;
         Windows.CloseHandle(ProcHandle);
      end;
   end;

end;

function TForm1.GetProcessName(ProcessHandle: THandle): String;
var
    cb : Cardinal;
   elements : Cardinal;
   Needs : Cardinal;
   ModuleHandleArray : Array of THandle;
   Win32Ret : LongBool;
   i : longint;
   ModuleHandle: THandle;
   ModuleName : WideString;
   ModeleNameLength : Integer;
   ProcessName : String;
   FileExt : String;
begin

    Result := '';
    //モジュール数数がいくつあるか解らないので大きめにとっておく
   elements := 128;
   Needs := elements * Sizeof(DWORD);
   cb := 0;
   while (cb <= Needs) do
   begin

        SetLength(ModuleHandleArray, elements);
       cb := Length(ModuleHandleArray) * Sizeof(DWORD);
       Needs := 0;
      Win32Ret := PsApi.EnumProcessModules(ProcessHandle,PDWORD(ModuleHandleArray),cb,Needs);

      //APIが失敗したら抜ける
      if (not(Win32Ret)) then
      begin
         break;
      end;
      //領域が足りなかったときに備えて倍にする。
      elements := elements * 2;
   end;

   if (Win32Ret) then
   begin
       ModeleNameLength := 255;
      SetLength(ModuleName,ModeleNameLength);
        elements := Needs div Sizeof(DWORD);
       for i := 0 to elements - 1 do
       begin
          ModuleHandle := ModuleHandleArray[i];
          ModeleNameLength := PsApi.GetModuleBaseName(
                                  ProcessHandle,
                                ModuleHandle,
                                PWideChar(ModuleName),
                                ModeleNameLength);
         if (ModeleNameLength > 0) then
         begin
             //モジュール名がExeファイルであればプロセスとみなす。
             SetLength(ModuleName,ModeleNameLength);
            ProcessName := ModuleName;
            FileExt := ExtractFileExt(ProcessName);
            if (CompareText(FileExt,'.EXE') = 0)  then
            begin
                Result :=  ProcessName;
               break;
            end;
         end;
      end;
   end;
end;