AppIsRunning/fr: what changed

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

Title: AppIsRunning/fr

New		Line
1	+	### Teste si une application est déjà en train de tourner
2	+
3	+	Voici une unité qui marche à la fois sous Windows et Linux.
4	+
5	+	- Il n'est pas besoin de passer le chemin complet à l'application - Le ExeName suffira en général.
6	+
7	+	``` pascal
8	+	unit 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;
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;
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.
86	+	```
87	+
88	+	NdT: une version objet aurait été plus tendance...
89	+
90	+	---
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