added routine to find running process

This commit is contained in:
Basile Burg 2015-02-06 02:51:07 +01:00
parent 257c34b8ec
commit b36a5af627
1 changed files with 66 additions and 1 deletions

View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, ExtCtrls,
{$IFDEF WINDOWS}
Windows,
Windows, JwaTlHelp32,
{$ENDIF}
ActnList, dialogs, forms, process, asyncprocess;
@ -222,6 +222,12 @@ type
*)
procedure ensureNoPipeIfWait(aProcess: TProcess);
(**
* Returns TRUE if EXEName is running under Windows or Linux
*)
function AppIsRunning(const ExeName: string):Boolean;
(**
* Returns the length of the line ending in aFilename;
*)
@ -858,6 +864,65 @@ begin
end;
end;
{$IFDEF WINDOWS}
function WindowsAppIsRunning(const ExeName: string): integer;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
Result := 0;
while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeName))) then
begin
Inc(Result);
// SendMessage(Exit-Message) possible?
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
{$ENDIF}
{$IFDEF LINUX}
function LinuxAppIsRunning(const ExeName: string): integer;
var
t: TProcess;
s: TStringList;
begin
Result := 0;
t := tprocess.Create(nil);
t.CommandLine := 'ps -C ' + ExeName;
t.Options := [poUsePipes, poWaitonexit];
try
t.Execute;
s := TStringList.Create;
try
s.LoadFromStream(t.Output);
Result := Pos(ExeName, s.Text);
finally
s.Free;
end;
finally
t.Free;
end;
end;
{$ENDIF}
function AppIsRunning(const ExeName: string):Boolean;
begin
{$IFDEF WINDOWS}
Result:=(WindowsAppIsRunning(ExeName) > 0);
{$ENDIF}
{$IFDEF LINUX}
Result:=(LinuxAppIsRunning(ExeName) > 0);
{$ENDIF}
end;
initialization
RegisterClasses([TMRUList, TMRUFileList]);