Difference between revisions of "AppIsRunning"
From Lazarus wiki
Jump to navigationJump to searchJwdietrich (talk | contribs) |
(add →See also: UniqueInstance) |
||
(6 intermediate revisions by 5 users not shown) | |||
Line 1: | Line 1: | ||
− | + | {{AppIsRunning}} | |
+ | |||
+ | ==Test whether an Application is already running== | ||
Here's a unit that works under both Windows and Linux | Here's a unit that works under both Windows and Linux | ||
− | *There's no need to pass the full application path to the function - the ExeName will usually do | + | |
− | <syntaxhighlight> | + | *There's no need to pass the full application path to the function - the ExeName will usually do. Below code cannot find out its own exename though. |
+ | |||
+ | <syntaxhighlight lang="pascal"> | ||
unit uappisrunning; | unit uappisrunning; | ||
Line 20: | Line 24: | ||
implementation | implementation | ||
+ | |||
// These functions return Zero if app is NOT running | // These functions return Zero if app is NOT running | ||
// Override them if you have a better implementation | // Override them if you have a better implementation | ||
+ | |||
{$IFDEF WINDOWS} | {$IFDEF WINDOWS} | ||
function WindowsAppIsRunning(const ExeName: string): integer; | function WindowsAppIsRunning(const ExeName: string): integer; | ||
Line 28: | Line 34: | ||
FSnapshotHandle: THandle; | FSnapshotHandle: THandle; | ||
FProcessEntry32: TProcessEntry32; | FProcessEntry32: TProcessEntry32; | ||
+ | |||
begin | begin | ||
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); | FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); | ||
Line 33: | Line 40: | ||
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); | ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); | ||
Result := 0; | Result := 0; | ||
+ | |||
while integer(ContinueLoop) <> 0 do | while integer(ContinueLoop) <> 0 do | ||
begin | begin | ||
Line 44: | Line 52: | ||
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); | ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); | ||
end; | end; | ||
+ | |||
CloseHandle(FSnapshotHandle); | CloseHandle(FSnapshotHandle); | ||
end; | end; | ||
{$ENDIF} | {$ENDIF} | ||
+ | |||
{$IFDEF LINUX} | {$IFDEF LINUX} | ||
function LinuxAppIsRunning(const ExeName: string): integer; | function LinuxAppIsRunning(const ExeName: string): integer; | ||
Line 52: | Line 62: | ||
t: TProcess; | t: TProcess; | ||
s: TStringList; | s: TStringList; | ||
+ | |||
begin | begin | ||
Result := 0; | Result := 0; | ||
Line 57: | Line 68: | ||
t.CommandLine := 'ps -C ' + ExeName; | t.CommandLine := 'ps -C ' + ExeName; | ||
t.Options := [poUsePipes, poWaitonexit]; | t.Options := [poUsePipes, poWaitonexit]; | ||
+ | |||
try | try | ||
t.Execute; | t.Execute; | ||
Line 69: | Line 81: | ||
t.Free; | t.Free; | ||
end; | end; | ||
+ | |||
end; | end; | ||
{$ENDIF} | {$ENDIF} | ||
+ | |||
function AppIsRunning(const ExeName: string):Boolean; | function AppIsRunning(const ExeName: string):Boolean; | ||
begin | begin | ||
+ | |||
{$IFDEF WINDOWS} | {$IFDEF WINDOWS} | ||
Result:=(WindowsAppIsRunning(ExeName) > 0); | Result:=(WindowsAppIsRunning(ExeName) > 0); | ||
{$ENDIF} | {$ENDIF} | ||
+ | |||
{$IFDEF LINUX} | {$IFDEF LINUX} | ||
Result:=(LinuxAppIsRunning(ExeName) > 0); | Result:=(LinuxAppIsRunning(ExeName) > 0); | ||
{$ENDIF} | {$ENDIF} | ||
+ | |||
end; | end; | ||
end. | end. | ||
</syntaxhighlight> | </syntaxhighlight> | ||
− | + | ==See also== | |
− | + | * [[UniqueInstance]] | |
− | [[ |
Latest revision as of 01:36, 19 June 2020
│
English (en) │
français (fr) │
polski (pl) │
Test whether an Application is already running
Here's a unit that works under both Windows and Linux
- There's no need to pass the full application path to the function - the ExeName will usually do. Below code cannot find out its own exename though.
unit uappisrunning;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils
{$IFDEF WINDOWS}, Windows, JwaTlHelp32{$ENDIF}
{$IFDEF LINUX},process{$ENDIF};
// JwaTlHelp32 is in fpc\packages\winunits-jedi\src\jwatlhelp32.pas
// Returns TRUE if EXEName is running under Windows or Linux
// Don't pass an .exe extension to Linux!
function AppIsRunning(const ExeName: string):Boolean;
implementation
// These functions return Zero if app is NOT running
// Override them if you have a better implementation
{$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;
end.