Version 1.0 DEV 1.09

Signed-off-by: Dennis07 <den.goehlert@t-online.de>

Source/uSysCtrls.pas

@@ -10,10 +10,14 @@ interface
 
 uses
   { Standard-Units }
-  SysUtils, Classes, Windows,
+  SysUtils, Classes, Windows, TlHelp32, PsAPI,
   { Andere Package-Units }
   uBase, uSysTools;
 
+type
+  { Fehlermeldungen }
+  EBatteryFlag = class(Exception);
+
 type
   { Hilfsklassen }
   TBatteryFlag = (bfHealthy,bfLow,bfCritical,bfCharge,bfHealthyAccu,bfNone,bfUnknown);
@@ -56,6 +60,31 @@ type
     property About: TComponentAbout read FAbout;
   end;
 
+  TProcessManager = class(TComponent)
+  private
+    { Private-Deklarationen }
+    FAbout: TComponentAbout;
+    FNames: TStrings;
+    FTimeOut: DWORD;
+  public
+    { Public-Deklarationen }
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Update;
+    procedure Kill(ProcID: DWORD);
+    function GetID(ProcName: String): DWORD;
+    function GetPath(ProcID: DWORD): String;
+    function GetThreads(ProcName: String): DWORD;
+    function GetParentID(ProcName: String): DWORD;
+    function GetPriority(ProcName: String): Integer;
+    function GetMemory(ProcID: DWORD): DWORD;
+  published
+    { Published-Deklarationen }
+    property About: TComponentAbout read FAbout;
+    property Names: TStrings read FNames;
+    property TimeOut: DWORD read FTimeOut write FTimeOut;
+  end;
+
   procedure Register;
 
 const
@@ -78,11 +107,16 @@ const
   CursorFixComponent_Copyright = 'Copyright � 2014';
   CursorFixComponent_Author = 'Dennis G�hlert a.o.';
 
+  ProcessManagerComponent_Name = 'ProcessManager';
+  ProcessManagerComponent_Version = 1.0;
+  ProcessManagerComponent_Copyright = 'Copyright � 2014';
+  ProcessManagerComponent_Author = 'Dennis G�hlert a.o.';
+
 implementation
 
 procedure Register;
 begin
-  RegisterComponents(ComponentsPage,[TBattery,TCursorFix]);
+  RegisterComponents(ComponentsPage,[TBattery,TCursorFix,TProcessManager]);
 end;
 
 { ----------------------------------------------------------------------------
@@ -99,6 +133,10 @@ begin
     9: Result := bfHealthyAccu;
     128: Result := bfNone;
     255: Result := bfUnknown;
+  else
+    begin
+      raise EBatteryFlag.Create('Unable to obtain battery flag information');
+    end;
   end;
 end;
 
@@ -211,4 +249,223 @@ begin
   inherited;
 end;
 
+{ ----------------------------------------------------------------------------
+  TProcessManager
+  ---------------------------------------------------------------------------- }
+
+constructor TProcessManager.Create(AOwner: TComponent);
+begin
+  inherited;
+  FAbout := TComponentAbout.Create(ProcessManagerComponent_Name,ProcessManagerComponent_Version,ProcessManagerComponent_Copyright,ProcessManagerComponent_Author);
+  FNames := TStringList.Create;
+end;
+
+destructor TProcessManager.Destroy;
+begin
+  FAbout.Free;
+  FNames.Free;
+  inherited;
+end;
+
+procedure TProcessManager.Update;
+var
+  Snapshot: THandle;
+  ProcEntry: TProcessEntry32;
+begin
+  FNames.Clear;
+  Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
+  try
+    ProcEntry.dwSize := SizeOf(ProcEntry);
+    if Process32First(Snapshot,ProcEntry) then
+    begin
+      repeat
+        FNames.Add(ProcEntry.szExeFile);
+      until (Process32Next(Snapshot,ProcEntry) = False)
+    end else
+    begin
+      RaiseLastOSError;
+    end;
+  finally
+    CloseHandle(Snapshot);
+  end;
+end;
+
+procedure TProcessManager.Kill(ProcID: DWORD);
+var
+  CurrentProc: THandle;
+  Error: DWORD;
+begin
+  CurrentProc := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE,False,ProcID);
+  try
+    if CurrentProc > 0 then
+    begin
+      Error := Integer(TerminateProcess(CurrentProc,1));
+      if Error <> 0 then
+      begin
+        Error := WaitForSingleObject(CurrentProc,FTimeOut);
+        if Error = WAIT_FAILED then
+        begin
+          RaiseLastOSError;
+        end;
+      end else
+      begin
+        RaiseLastOSError;
+      end;
+    end else
+    begin
+      RaiseLastOSError;
+    end;
+  finally
+    CloseHandle(CurrentProc);
+  end;
+end;
+
+function TProcessManager.GetID(ProcName: String): DWORD;
+var
+  Snapshot: THandle;
+  ProcEntry: TProcessEntry32;
+begin
+  Result := 0;
+  Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
+  try
+    ProcEntry.dwSize := SizeOf(ProcEntry);
+    if Process32First(Snapshot,ProcEntry) then
+    begin
+      repeat
+        if Pos(AnsiLowerCase(ProcEntry.szExeFile),AnsiLowerCase(ExtractFilename(ProcName))) > 0 then
+        begin
+          Result := ProcEntry.th32ProcessID;
+          Break;
+        end;
+      until (Process32Next(Snapshot,ProcEntry) = False)
+    end else
+    begin
+      RaiseLastOSError;
+    end;
+  finally
+    CloseHandle(Snapshot);
+  end;
+end;
+
+function TProcessManager.GetPath(ProcID: DWORD): String;
+var
+  Snapshot: THandle;
+  ModEntry: TModuleEntry32;
+begin
+  Result := '';
+  Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPMODULE,ProcID);
+  try
+    ModEntry.dwSize := SizeOf(ModEntry);
+    if Module32First(Snapshot,ModEntry) then
+    begin
+      Result := ModEntry.szExePath;
+    end else
+    begin
+      RaiseLastOSError;
+    end;
+  finally
+    CloseHandle(Snapshot);
+  end;
+end;
+
+function TProcessManager.GetThreads(ProcName: String): DWORD;
+var
+  Snapshot: THandle;
+  ProcEntry: TProcessEntry32;
+begin
+  Result := 0;
+  Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
+  try
+    ProcEntry.dwSize := SizeOf(ProcEntry);
+    if Process32First(Snapshot,ProcEntry) then
+    begin
+      repeat
+        if Pos(AnsiLowerCase(ProcEntry.szExeFile),AnsiLowerCase(ExtractFilename(ProcName))) > 0 then
+        begin
+          Result := ProcEntry.cntThreads;
+          Break;
+        end;
+      until (Process32Next(Snapshot,ProcEntry) = False)
+    end else
+    begin
+      RaiseLastOSError;
+    end;
+  finally
+    CloseHandle(Snapshot);
+  end;
+end;
+
+function TProcessManager.GetParentID(ProcName: String): DWORD;
+var
+  Snapshot: THandle;
+  ProcEntry: TProcessEntry32;
+begin
+  Result := 0;
+  Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
+  try
+    ProcEntry.dwSize := SizeOf(ProcEntry);
+    if Process32First(Snapshot,ProcEntry) then
+    begin
+      repeat
+        if Pos(AnsiLowerCase(ProcEntry.szExeFile),AnsiLowerCase(ExtractFilename(ProcName))) > 0 then
+        begin
+          Result := ProcEntry.th32ParentProcessID;
+          Break;
+        end;
+      until (Process32Next(Snapshot,ProcEntry) = False)
+    end else
+    begin
+      RaiseLastOSError;
+    end;
+  finally
+    CloseHandle(Snapshot);
+  end;
+end;
+
+function TProcessManager.GetPriority(ProcName: String): Integer;
+var
+  Snapshot: THandle;
+  ProcEntry: TProcessEntry32;
+begin
+  Result := -1;
+  Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
+  try
+    ProcEntry.dwSize := SizeOf(ProcEntry);
+    if Process32First(Snapshot,ProcEntry) then
+    begin
+      repeat
+        if Pos(AnsiLowerCase(ProcEntry.szExeFile),AnsiLowerCase(ExtractFilename(ProcName))) > 0 then
+        begin
+          Result := ProcEntry.pcPriClassBase;
+          Break;
+        end;
+      until (Process32Next(Snapshot,ProcEntry) = False)
+    end else
+    begin
+      RaiseLastOSError;
+    end;
+  finally
+    CloseHandle(Snapshot);
+  end;
+end;
+
+function TProcessManager.GetMemory(ProcID: DWORD): DWORD;
+var
+  ProcMem: PPROCESS_MEMORY_COUNTERS;
+  CB: Integer;
+begin
+  Result := 0;
+  CB := SizeOf(_PROCESS_MEMORY_COUNTERS);
+  GetMem(ProcMem,CB);
+  ProcMem^.cb := CB;
+  try
+    if GetProcessMemoryInfo(OpenProcess(PROCESS_ALL_ACCESS,False,ProcID),ProcMem,CB) = True then
+    begin
+      Result := ProcMem^.WorkingSetSize;
+    end;
+  finally
+    FreeMem(ProcMem);
+  end;
+end;
+
 end.