AppIsRunning: what changed

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

Title: AppIsRunning

New		Line
1	+	## Test whether an Application is already running
2	+
3	+	Here's a unit that works under both Windows and Linux
4	+
5	+	- 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.
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	+
26	+	// These functions return Zero if app is NOT running
27	+	// Override them if you have a better implementation
28	+
29	+	{$IFDEF WINDOWS}
30	+	function WindowsAppIsRunning(const ExeName: string): integer;
31	+	var
32	+	ContinueLoop: BOOL;
33	+	FSnapshotHandle: THandle;
34	+	FProcessEntry32: TProcessEntry32;
35	+
36	+	begin
37	+	FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
38	+	FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
39	+	ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
40	+	Result := 0;
41	+
42	+	while integer(ContinueLoop) <> 0 do
43	+	begin
44	+	if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
45	+	UpperCase(ExeName)) or (UpperCase(FProcessEntry32.szExeFile) =
46	+	UpperCase(ExeName))) then
47	+	begin
48	+	Inc(Result);
49	+	// SendMessage(Exit-Message) possible?
50	+	end;
51	+	ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
52	+	end;
53	+
54	+	CloseHandle(FSnapshotHandle);
55	+	end;
56	+	{$ENDIF}
57	+
58	+	{$IFDEF LINUX}
59	+	function LinuxAppIsRunning(const ExeName: string): integer;
60	+	var
61	+	t: TProcess;
62	+	s: TStringList;
63	+
64	+	begin
65	+	Result := 0;
66	+	t := tprocess.Create(nil);
67	+	t.CommandLine := 'ps -C ' + ExeName;
68	+	t.Options := [poUsePipes, poWaitonexit];
69	+
70	+	try
71	+	t.Execute;
72	+	s := TStringList.Create;
73	+	try
74	+	s.LoadFromStream(t.Output);
75	+	Result := Pos(ExeName, s.Text);
76	+	finally
77	+	s.Free;
78	+	end;
79	+	finally
80	+	t.Free;
81	+	end;
82	+
83	+	end;
84	+	{$ENDIF}
85	+
86	+	function AppIsRunning(const ExeName: string):Boolean;
87	+	begin
88	+
89	+	{$IFDEF WINDOWS}
90	+	Result:=(WindowsAppIsRunning(ExeName) > 0);
91	+	{$ENDIF}
92	+
93	+	{$IFDEF LINUX}
94	+	Result:=(LinuxAppIsRunning(ExeName) > 0);
95	+	{$ENDIF}
96	+
97	+	end;
98	+	end.
99	+	```
100	+
101	+	## See also
102	+
103	+	- [[UniqueInstance]]
104	+
105	+	---
106	+	From the Free Pascal wiki, page "AppIsRunning", as it stood on 2020-06-18 after a change by Kai Burghardt, 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