AppIsRunning/pl
Sprawdź, czy aplikacja jest już uruchomiona
Oto moduł, który działa zarówno w systemie Windows, jak i Linux
- Nie ma potrzeby przekazywania pełnej ścieżki aplikacji do funkcji — zwykle wystarczy ExeName. Poniższy kod nie może jednak znaleźć własnej nazwy exe.
unit uappisrunning;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils
{$IFDEF WINDOWS}, Windows, JwaTlHelp32{$ENDIF}
{$IFDEF LINUX},process{$ENDIF};
// JwaTlHelp32 znajduje się w fpc\packages\winunits-jedi\src\jwatlhelp32.pas
// Zwraca TRUE jeśli EXEName jest uruchomiony w systemie Windows lub Linux
// Nie przekazuj rozszerzenia .exe do Linuksa!
function AppIsRunning(const ExeName: string):Boolean;
implementation
// Te funkcje zwracają Zero, jeśli aplikacja NIE jest uruchomiona
// Zastąp je, jeśli masz lepszą implementację
{$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);
// Czy SendMessage(Exit-Message) jest możliwe?
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.Zobacz także
From the Free Pascal wiki, page "AppIsRunning/pl", as the Internet Archive kept it on 2022-08-18, last changed on 2022-01-06. Copyright stays with the author who wrote it, according to the old wiki's Licensing page. If you have concerns about this material, message the admin.
Talk about this page
Nobody has opened a bench for this page yet. Sign in to open one.
