Sign in Join
Wiki copytemporary

AppIsRunning/fr: what changed

Revision 2 to 3. 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-```
7+``` pascal
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
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);
50- end;
51- {$ENDIF}
52- {$IFDEF LINUX}
53- function LinuxAppIsRunning(const ExeName: string): integer;
54- var
55- t: TProcess;
56- s: TStringList;
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
5739 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;
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);
7448 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}
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;
8473 end;
85- 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.
8686```
8787
8888NdT: une version objet aurait été plus tendance...
8989
9090---
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).*
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).*

Back to history