Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Windows API / MS.NET Framework API (https://www.delphipraxis.net/20-library-windows-api-ms-net-framework-api/)
-   -   Delphi Alle Threads einer laufenden Anwendung ermitteln (https://www.delphipraxis.net/2577-alle-threads-einer-laufenden-anwendung-ermitteln.html)

Luckie 30. Jan 2003 11:07


Alle Threads einer laufenden Anwendung ermitteln
 
Delphi-Quellcode:
type
  TDWordList = Array of DWord;

function GetThreadID(const FileName: String): TDWordList;
var
  ToolHnd, MToolHnd: THandle;
  PE32: TProcessEntry32;
  ME32: TModuleEntry32;
  TE32: TThreadEntry32;
  PIDArray, ThreadArray: TDWordList;
  a: Integer;
  PID: DWord;
begin
  PIDArray := nil;
  ThreadArray := nil;
  ToolHnd := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS or TH32CS_SNAPTHREAD, 0); //Handle auf Snapshot
  if ToolHnd = INVALID_HANDLE_VALUE then RaiseLastWin32Error;
  try
    PE32.dwSize := SizeOf(ProcessEntry32);
    if not Process32First(ToolHnd, PE32) then RaiseLastWin32Error; //erster Prozess
    repeat
      if CompareText(PE32.szExeFile, ExtractFileName(FileName)) = 0 then
      begin
        SetLength(PIDArray, Length(PIDArray) + 1);
        PIDArray[Length(PIDARRAY) - 1] := PE32.th32ProcessID;
      end;
    until not Process32Next(ToolHnd, PE32);

    { Jetzt sind alle PIDs der Prozesse, deren Dateinamen gleich dem gesuchten ist, gespeichert } 
    { Jetzt wird für jeden Prozess anhand der Modulliste der vollständige Pfad ermittelt und so } 
    { die endgültige, richtige ProcessID ermittelt.                                            } 

    PID := 0;
    for a := 0 to Length(PIDArray) -1 do
    begin
      MToolHnd := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, PIDArray[a]); //Modulliste des gewählten Prozesses
      if MToolHnd = INVALID_HANDLE_VALUE then RaiseLastWin32Error;
      try
        ME32.dwSize := SizeOf(TModuleEntry32);
        if not Module32First(MToolhnd, ME32) then RaiseLastWin32Error;
        repeat
          if CompareText(ME32.szExePath, FileName) = 0 then
          begin
            PID := ME32.th32ProcessID;
            Break;
          end;
        until not Module32Next(MToolHnd, ME32);
      finally
        CloseHandle(MToolHnd);
      end;
      if PID <> 0 then Break;
    end;

    { Jetzt werden alle Threads des Prozesses ermittelt                                        } 

    TE32.dwSize := SizeOf(ThreadEntry32);
    if not Thread32First(ToolHnd, TE32) then RaiseLastWin32Error;
    repeat
      if TE32.th32OwnerProcessID = PID then
      begin
        SetLength(ThreadArray, Length(ThreadArray) + 1);
        ThreadArray[Length(ThreadArray) - 1] := TE32.th32ThreadID;
      end;
    until not Thread32Next(ToolHnd, TE32);
  finally
    CloseHandle(ToolHnd);
  end;
  if Length(ThreadArray) > 0 then
  begin
    Result := ThreadArray;
  end else Result := nil;
end;
Beitrag von Chewie.

[edit=Matze][code] durch [delphi]-Tags ersetzt. Mfg, Matze[/edit]


Alle Zeitangaben in WEZ +1. Es ist jetzt 10:02 Uhr.

Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf