Sign in Join
Wiki copytemporary

AppIsRunning/fr: what changed

Revision 1 to 2. Removed lines have a minus sign; added lines have a plus sign.

OldNewLine
11### Teste si une application est déjà en train de tourner
22
3-Voici une unité qui marche à la fois sous Windows et Linux.
3+Voici une unité qui marche à la fois sous Windows et Linux.
44
5-- Il n'est pas besoin de passer le chemin complet à l'application - Le ExeName suffira en général.
5+ * Il n'est pas besoin de passer le chemin complet à l'application - Le ExeName suffira en général.
66
7-``` pascal
7+```
88unit uappisrunning;
9-
10-{$mode objfpc}{$H+}
11-
12-interface
13-
14-uses
15- Classes, SysUtils
16- {$IFDEF WINDOWS}, Windows, JwaTlHelp32{$ENDIF}
17- {$IFDEF LINUX},process{$ENDIF};
18-// JwaTlHelp32 is in fpc\packages\winunits-jedi\src\jwatlhelp32.pas
19-
20-// Returns TRUE if EXEName is running under Windows or Linux
21-// Don't pass an .exe extension to Linux!
22-function AppIsRunning(const ExeName: string):Boolean;
23-
24-implementation
25-// These functions return Zero if app is NOT running
26-// Override them if you have a better implementation
27-{$IFDEF WINDOWS}
28-function WindowsAppIsRunning(const ExeName: string): integer;
29-var
30- ContinueLoop: BOOL;
31- FSnapshotHandle: THandle;
32- FProcessEntry32: TProcessEntry32;
33-begin
34- FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
35- FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
36- ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
37- Result := 0;
38- while integer(ContinueLoop) <> 0 do
9+
10+ {$mode objfpc}{$H+}
11+
12+ interface
13+
14+ uses
15+ Classes, SysUtils
16+ {$IFDEF WINDOWS}, Windows, JwaTlHelp32{$ENDIF}
17+ {$IFDEF LINUX},process{$ENDIF};
18+ // JwaTlHelp32 is in fpc\packages\winunits-jedi\src\jwatlhelp32.pas
19+
20+ // Returns TRUE if EXEName is running under Windows or Linux
21+ // Don't pass an .exe extension to Linux!
22+ function AppIsRunning(const ExeName: string):Boolean;
23+
24+ implementation
25+ // These functions return Zero if app is NOT running
26+ // Override them if you have a better implementation
27+ {$IFDEF WINDOWS}
28+ function WindowsAppIsRunning(const ExeName: string): integer;
29+ var
30+ ContinueLoop: BOOL;
31+ FSnapshotHandle: THandle;
32+ FProcessEntry32: TProcessEntry32;
3933 begin
40- if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
41- UpperCase(ExeName)) or (UpperCase(FProcessEntry32.szExeFile) =
42- UpperCase(ExeName))) then
43- begin
44- Inc(Result);
45- // SendMessage(Exit-Message) possible?
46- end;
47- ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
34+ FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
35+ FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
36+ ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
37+ Result := 0;
38+ while integer(ContinueLoop) <> 0 do
39+ begin
40+ if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
41+ UpperCase(ExeName)) or (UpperCase(FProcessEntry32.szExeFile) =
42+ UpperCase(ExeName))) then
43+ begin
44+ Inc(Result);
45+ // SendMessage(Exit-Message) possible?
46+ end;
47+ ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
48+ end;
49+ CloseHandle(FSnapshotHandle);
4850 end;
49- CloseHandle(FSnapshotHandle);
50-end;
51-{$ENDIF}
52-{$IFDEF LINUX}
53-function LinuxAppIsRunning(const ExeName: string): integer;
54-var
55- t: TProcess;
56- s: TStringList;
57-begin
58- Result := 0;
59- t := tprocess.Create(nil);
60- t.CommandLine := 'ps -C ' + ExeName;
61- t.Options := [poUsePipes, poWaitonexit];
62- try
63- t.Execute;
64- s := TStringList.Create;
65- try
66- s.LoadFromStream(t.Output);
67- Result := Pos(ExeName, s.Text);
68- finally
69- s.Free;
70- end;
71- finally
72- t.Free;
51+ {$ENDIF}
52+ {$IFDEF LINUX}
53+ function LinuxAppIsRunning(const ExeName: string): integer;
54+ var
55+ t: TProcess;
56+ s: TStringList;
57+ begin
58+ Result := 0;
59+ t := tprocess.Create(nil);
60+ t.CommandLine := 'ps -C ' + ExeName;
61+ t.Options := [poUsePipes, poWaitonexit];
62+ try
63+ t.Execute;
64+ s := TStringList.Create;
65+ try
66+ s.LoadFromStream(t.Output);
67+ Result := Pos(ExeName, s.Text);
68+ finally
69+ s.Free;
70+ end;
71+ finally
72+ t.Free;
73+ end;
7374 end;
74-end;
75-{$ENDIF}
76-function AppIsRunning(const ExeName: string):Boolean;
77-begin
78-{$IFDEF WINDOWS}
79- Result:=(WindowsAppIsRunning(ExeName) > 0);
80-{$ENDIF}
81-{$IFDEF LINUX}
82- Result:=(LinuxAppIsRunning(ExeName) > 0);
83-{$ENDIF}
84-end;
85-end.
75+ {$ENDIF}
76+ function AppIsRunning(const ExeName: string):Boolean;
77+ begin
78+ {$IFDEF WINDOWS}
79+ Result:=(WindowsAppIsRunning(ExeName) > 0);
80+ {$ENDIF}
81+ {$IFDEF LINUX}
82+ Result:=(LinuxAppIsRunning(ExeName) > 0);
83+ {$ENDIF}
84+ end;
85+ end.
8686```
8787
8888NdT: une version objet aurait été plus tendance...
8989
9090---
91-*From the Free Pascal wiki, page "AppIsRunning/fr", as it stood on 2020-02-09 after a change by GAN, out of the wiki's dump of 2024-05-26. 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](/wiki-contact).*
91+*From the Free Pascal wiki, page "AppIsRunning/fr", as the Internet Archive kept it on 2024-01-21. 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](/wiki-contact).*

Back to history