Difference between revisions of "Windows Programming Tips"
Jwdietrich (talk | contribs) (Platform template added.) |
Jwdietrich (talk | contribs) (Fixing a typo.) |
||
Line 1: | Line 1: | ||
− | {{Platform only|Windows|Windows| | + | {{Platform only|Windows|Windows|Windows}} |
This page is dedicated to desktop Windows - including server - Windows) programming tips. | This page is dedicated to desktop Windows - including server - Windows) programming tips. | ||
Revision as of 21:17, 6 January 2015
This article applies to Windows only.
See also: Multiplatform Programming Guide
This page is dedicated to desktop Windows - including server - Windows) programming tips.
Other Interfaces
- Lazarus known issues (things that will never be fixed) - A list of interface compatibility issues
- Win32/64 Interface - The Windows API (formerly Win32 API) interface for Windows 95/98/Me/2000/XP/Vista/10, but not CE
- Windows CE Interface - For Pocket PC and Smartphones
- Carbon Interface - The Carbon 32 bit interface for macOS (deprecated; removed from macOS 10.15)
- Cocoa Interface - The Cocoa 64 bit interface for macOS
- Qt Interface - The Qt4 interface for Unixes, macOS, Windows, and Linux-based PDAs
- Qt5 Interface - The Qt5 interface for Unixes, macOS, Windows, and Linux-based PDAs
- GTK1 Interface - The gtk1 interface for Unixes, macOS (X11), Windows
- GTK2 Interface - The gtk2 interface for Unixes, macOS (X11), Windows
- GTK3 Interface - The gtk3 interface for Unixes, macOS (X11), Windows
- fpGUI Interface - Based on the fpGUI library, which is a cross-platform toolkit completely written in Object Pascal
- Custom Drawn Interface - A cross-platform LCL backend written completely in Object Pascal inside Lazarus. The Lazarus interface to Android.
Platform specific Tips
- Android Programming - For Android smartphones and tablets
- iPhone/iPod development - About using Objective Pascal to develop iOS applications
- FreeBSD Programming Tips - FreeBSD programming tips
- Linux Programming Tips - How to execute particular programming tasks in Linux
- macOS Programming Tips - Lazarus tips, useful tools, Unix commands, and more...
- WinCE Programming Tips - Using the telephone API, sending SMSes, and more...
- Windows Programming Tips - Desktop Windows programming tips
Interface Development Articles
- Carbon interface internals - If you want to help improving the Carbon interface
- Windows CE Development Notes - For Pocket PC and Smartphones
- Adding a new interface - How to add a new widget set interface
- LCL Defines - Choosing the right options to recompile LCL
- LCL Internals - Some info about the inner workings of the LCL
- Cocoa Internals - Some info about the inner workings of the Cocoa widgetset
Articles about Windows Programming
- High DPI - How to make your application DPI-aware on Windows 7.
- Aero Glass - How to apply Aero Glass effect in a Lazarus Form on Windows 7.
- Windows Icon - How to design your icon with the right sizes.
- Inno Setup Usage - How to create setup files with File Association support.
FPC 2.6.x/Lazarus warning (Missing support for SEH)
Warning: If you can avoid it, do not use Win64 builds of Lazarus based on FPC 2.6.x and earlier (this includes Lazarus 1.x. See below for details.
Please be aware that all current Lazarus 1.x releases use FPC 2.6.x. FPC 2.6.x (and probably earlier versions as well) does not properly support Windows 64 bit. Therefore, please use the 32 bit Lazarus IDE on Win64. If it is absolutely necessary to build 64 bit executables (e.g. explorer extensions), please install the 64 bit cross compiler add on for the 32 bit IDE.
Details of the bug: on Windows 64, exceptions in (third party) DLLs may be raised using SEH. These exceptions should be handled within the DLL itself.
However, FPC sees an (incorrect) FPC exception which may cause your programs (or Lazarus) to crash. This applies to DLLs like printer drivers, database drivers, Windows explorer extensions.
The issue has been fixed in the FPC development version but it is a major change and it will not be backported to FPC 2.6.x.
Relevant bug reports include http://bugs.freepascal.org/view.php?id=12742
Windows specific compiler options
The most prominent options are the -W flags. A GUI application requires the -WG flag. See Project Options / Compiler Options / Linking / Target OS Specific options / Win32 GUI application. No console is shown, writeln and readln are not possible, you will get File not open errors. Omitting this option creates a console application (same as passing -WC).
Writing cross-platform code that works on Windows
While you can use Windows-only code (such as the windows unit), with a little care you can often prepare for cross-platform use (e.g. use the lclintf unit).
See Multiplatform Programming Guide#Windows specific issues for more details.
COM Programming
Importing and using a COM library
The first step to import and use a COM library is generating the interface definitions from it. Use the program importtl which is located in Free Pascal in fpc/utils/importtl. A pre-compiled binary of this program can be found here: http://sourceforge.net/projects/p-tools/files/ImportTL/
You can call it, for example for MSAA like this:
importtl.exe C:\Windows\system32\oleacc.dll
And it will generate the type library pascal unit Accessibility_1_1_TLB.pas in the folder where it is.
Creating a library which exports a COM object
ToDo: write me
Windows Sensor/Location API
Available since Windows 7. See LazDeviceAPIs#Possible Windows implementation
ActiveX controls
You can use ActiveX controls in recent Lazarus versions. See LazActiveX
Services
Lazarus and FPC make writing Windows services easy. See Daemons and Services
Code snippets
File Association
To add icons to file associations and register for use with a program use: FileAssociation component.
Listing all available drives
program listdevices;
{$ifdef fpc}{$mode delphi}{$endif}
{$apptype console}
uses
Windows;
var
Drive: Char;
DriveLetter: string;
begin
WriteLn('The following drives were found in this computer:');
WriteLn('');
// Search all drive letters
for Drive := 'A' to 'Z' do
begin
DriveLetter := Drive + ':\';
case GetDriveType(PChar(DriveLetter)) of
DRIVE_REMOVABLE: WriteLn(DriveLetter + ' Floppy Drive');
DRIVE_FIXED: WriteLn(DriveLetter + ' Fixed Drive');
DRIVE_REMOTE: WriteLn(DriveLetter + ' Network Drive');
DRIVE_CDROM: WriteLn(DriveLetter + ' CD-ROM Drive');
DRIVE_RAMDISK: WriteLn(DriveLetter + ' RAM Disk');
end;
end;
// Also add a stop to see the result under Windows
WriteLn('');
WriteLn('Please press <ENTER> to exit the program.');
ReadLn(DriveLetter);
end.
Creating a shortcut (.lnk) file
Creating a shortcut on the desktop (can be easily adapted to any location). Adapted from post by Felipe Monteiro de Carvalho The ISLink object has more methods that you can use to modify your shortcut...
uses
...
windows, shlobj {for special folders}, ActiveX, ComObj;
...
procedure CreateDesktopShortCut(Target, TargetArguments, ShortcutName: string);
var
IObject: IUnknown;
ISLink: IShellLink;
IPFile: IPersistFile;
PIDL: PItemIDList;
InFolder: array[0..MAX_PATH] of Char;
TargetName: String;
LinkName: WideString;
begin
{ Creates an instance of IShellLink }
IObject := CreateComObject(CLSID_ShellLink);
ISLink := IObject as IShellLink;
IPFile := IObject as IPersistFile;
ISLink.SetPath(pChar(Target));
ISLink.SetArguments(pChar(TargetArguments));
ISLink.SetWorkingDirectory(pChar(ExtractFilePath(Target)));
{ Get the desktop location }
SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL);
SHGetPathFromIDList(PIDL, InFolder);
LinkName := InFolder + PathDelim + ShortcutName+'.lnk';
{ Create the link }
IPFile.Save(PWChar(LinkName), false);
end;
Getting special folders (My documents, Desktop, local application data, etc)
Often it is useful to get the location of a special folder such as the desktop. The example below shows how you can get the LocalAppData directory - where you can store user-specific configuration file files etc for your programs.
Use the My Documents folder (or a subfolder) to store documents.
Look in the shlobj unit (note: link may not be up to date) for more defines that let you look up the Desktop (note: use CSIDL_DESKTOPDIRECTORY, not CSIDL_DESKTOP), Recycle Bin, etc.
uses
...
shlobj;
var
AppDataPath: Array[0..MaxPathLen] of Char; //Allocate memory
...
begin
...
AppDataPath:='';
SHGetSpecialFolderPath(0,AppDataPath,CSIDL_LOCAL_APPDATA,false);
writeln('Your local appdata path is: ' + AppDataPath);
Enabling and disabling devices
The following code can be used to enable and disable Windows devices; it is useful to e.g. reset a serial port or USB device. An example program follows below.
unit controlwindevice;
{ Enable Disable windows devices
Copyright (c) 2010-2012 Ludo Brands
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to
deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
IN THE SOFTWARE.
}
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils,dynlibs,windows;
const
GUID_DEVCLASS_NET : TGUID = '{4D36E972-E325-11CE-BFC1-08002BE10318}';
GUID_DEVCLASS_PORT : TGUID = '{4D36E978-E325-11CE-BFC1-08002BE10318}';
type
TDeviceControlResult=(DCROK,DCRErrEnumDeviceInfo,DCRErrSetClassInstallParams,
DCRErrDIF_PROPERTYCHANGE);
function LoadDevices(GUID_DevClass:TGUID):TStringList;
function EnableDevice(SelectedItem: DWord):TDeviceControlResult;
function DisableDevice(SelectedItem: DWord):TDeviceControlResult;
implementation
// Setup api, based on SetupApi.pas JEDI library
const
DIF_PROPERTYCHANGE = $00000012;
DICS_ENABLE = $00000001;
DICS_DISABLE = $00000002;
DICS_FLAG_GLOBAL = $00000001; // make change in all hardware profiles
DIGCF_PRESENT = $00000002;
SPDRP_DEVICEDESC = $00000000; // DeviceDesc (R/W)
SPDRP_CLASS = $00000007; // Class (R--tied to ClassGUID)
SPDRP_CLASSGUID = $00000008; // ClassGUID (R/W)
SPDRP_FRIENDLYNAME = $0000000C; // FriendlyName (R/W)
type
HDEVINFO = Pointer;
DI_FUNCTION = LongWord; // Function type for device installer
PSPClassInstallHeader = ^TSPClassInstallHeader;
SP_CLASSINSTALL_HEADER = packed record
cbSize: DWORD;
InstallFunction: DI_FUNCTION;
end;
TSPClassInstallHeader = SP_CLASSINSTALL_HEADER;
PSPPropChangeParams = ^TSPPropChangeParams;
SP_PROPCHANGE_PARAMS = packed record
ClassInstallHeader: TSPClassInstallHeader;
StateChange: DWORD;
Scope: DWORD;
HwProfile: DWORD;
end;
TSPPropChangeParams = SP_PROPCHANGE_PARAMS;
PSPDevInfoData = ^TSPDevInfoData;
SP_DEVINFO_DATA = packed record
cbSize: DWORD;
ClassGuid: TGUID;
DevInst: DWORD; // DEVINST handle
Reserved: ULONG_PTR;
end;
TSPDevInfoData = SP_DEVINFO_DATA;
TSetupDiEnumDeviceInfo = function(DeviceInfoSet: HDEVINFO;
MemberIndex: DWORD; var DeviceInfoData: TSPDevInfoData): LongBool; stdcall;
TSetupDiSetClassInstallParamsA = function(DeviceInfoSet: HDEVINFO;
DeviceInfoData: PSPDevInfoData; ClassInstallParams: PSPClassInstallHeader;
ClassInstallParamsSize: DWORD): LongBool; stdcall;
TSetupDiSetClassInstallParamsW = function(DeviceInfoSet: HDEVINFO;
DeviceInfoData: PSPDevInfoData; ClassInstallParams: PSPClassInstallHeader;
ClassInstallParamsSize: DWORD): LongBool; stdcall;
TSetupDiSetClassInstallParams = TSetupDiSetClassInstallParamsA;
TSetupDiCallClassInstaller = function(InstallFunction: DI_FUNCTION;
DeviceInfoSet: HDEVINFO; DeviceInfoData: PSPDevInfoData): LongBool; stdcall;
TSetupDiGetClassDevs = function(ClassGuid: PGUID; const Enumerator: PAnsiChar;
hwndParent: HWND; Flags: DWORD): HDEVINFO; stdcall;
TSetupDiGetDeviceRegistryPropertyA = function(DeviceInfoSet: HDEVINFO;
const DeviceInfoData: TSPDevInfoData; Property_: DWORD;
var PropertyRegDataType: DWORD; PropertyBuffer: PBYTE; PropertyBufferSize: DWORD;
var RequiredSize: DWORD): BOOL; stdcall;
TSetupDiGetDeviceRegistryPropertyW = function(DeviceInfoSet: HDEVINFO;
const DeviceInfoData: TSPDevInfoData; Property_: DWORD;
var PropertyRegDataType: DWORD; PropertyBuffer: PBYTE; PropertyBufferSize: DWORD;
var RequiredSize: DWORD): BOOL; stdcall;
TSetupDiGetDeviceRegistryProperty = TSetupDiGetDeviceRegistryPropertyA;
var
DevInfo: hDevInfo;
SetupDiEnumDeviceInfo: TSetupDiEnumDeviceInfo;
SetupDiSetClassInstallParams: TSetupDiSetClassInstallParams;
SetupDiCallClassInstaller: TSetupDiCallClassInstaller;
SetupDiGetClassDevs: TSetupDiGetClassDevs;
SetupDiGetDeviceRegistryProperty: TSetupDiGetDeviceRegistryProperty;
var
SetupApiLoadCount:integer=0;
function LoadSetupApi: Boolean;
var SetupApiLib:TLibHandle;
begin
Result := True;
Inc(SetupApiLoadCount);
if SetupApiLoadCount > 1 then
Exit;
SetupApiLib:=LoadLibrary('SetupApi.dll');
Result := SetupApiLib<>0;
if Result then
begin
SetupDiEnumDeviceInfo := GetProcedureAddress(SetupApiLib, 'SetupDiEnumDeviceInfo');
SetupDiSetClassInstallParams := GetProcedureAddress(SetupApiLib, 'SetupDiSetClassInstallParamsA');
SetupDiCallClassInstaller := GetProcedureAddress(SetupApiLib, 'SetupDiCallClassInstaller');
SetupDiGetClassDevs := GetProcedureAddress(SetupApiLib, 'SetupDiGetClassDevsA');
SetupDiGetDeviceRegistryProperty := GetProcedureAddress(SetupApiLib, 'SetupDiGetDeviceRegistryPropertyA');
end;
end;
// implementation
function StateChange(NewState, SelectedItem: DWord;
hDevInfo: hDevInfo): TDeviceControlResult;
var
PropChangeParams: TSPPropChangeParams;
DeviceInfoData: TSPDevInfoData;
begin
PropChangeParams.ClassInstallHeader.cbSize := SizeOf(TSPClassInstallHeader);
DeviceInfoData.cbSize := SizeOf(TSPDevInfoData);
// Get a handle to the Selected Item.
if (not SetupDiEnumDeviceInfo(hDevInfo, SelectedItem, DeviceInfoData)) then
begin
Result := DCRErrEnumDeviceInfo;
exit;
end;
// Set the PropChangeParams structure.
PropChangeParams.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
PropChangeParams.Scope := DICS_FLAG_GLOBAL;
PropChangeParams.StateChange := NewState;
if (not SetupDiSetClassInstallParams(hDevInfo, @DeviceInfoData,
PSPClassInstallHeader(@PropChangeParams), SizeOf(PropChangeParams))) then
begin
Result := DCRErrSetClassInstallParams;
exit;
end;
// Call the ClassInstaller and perform the change.
if (not SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, hDevInfo, @DeviceInfoData)) then
begin
Result := DCRErrDIF_PROPERTYCHANGE;
exit;
end;
Result := DCROK;
end;
function GetRegistryProperty(PnPHandle: HDEVINFO;
DevData: TSPDevInfoData; Prop: DWORD; Buffer: PChar;
dwLength: DWord): Boolean;
var
aBuffer: array[0..256] of Char;
begin
dwLength := 0;
aBuffer[0] := #0;
SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, Prop, Prop, PBYTE(@aBuffer[0]), SizeOf(aBuffer), dwLength);
StrCopy(Buffer, aBuffer);
Result := Buffer^ <> #0;
end;
function ConstructDeviceName(DeviceInfoSet: hDevInfo;
DeviceInfoData: TSPDevInfoData; Buffer: PChar; dwLength: DWord): Boolean;
const
UnknownDevice = '<Unknown Device>';
begin
if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_FRIENDLYNAME, Buffer, dwLength)) then
begin
if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_DEVICEDESC, Buffer, dwLength)) then
begin
if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASS, Buffer, dwLength)) then
begin
if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASSGUID, Buffer, dwLength)) then
begin
dwLength := DWord(SizeOf(UnknownDevice));
Buffer := Pointer(LocalAlloc(LPTR, Cardinal(dwLength)));
StrCopy(Buffer, UnknownDevice);
end;
end;
end;
end;
Result := true;
end;
function LoadDevices(GUID_DevClass:TGUID):TStringList;
var
DeviceInfoData: TSPDevInfoData;
i: DWord;
pszText: PChar;
begin
if (not LoadSetupAPI) then
begin
result:=nil;
exit;
end;
DevInfo := nil;
// Get a handle to all devices in all classes present on system
DevInfo := SetupDiGetClassDevs(@GUID_DevClass, nil, 0, DIGCF_PRESENT);
if (DevInfo = Pointer(INVALID_HANDLE_VALUE)) then
begin
result:=nil;
exit;
end;
Result:=TStringList.Create;
DeviceInfoData.cbSize := SizeOf(TSPDevInfoData);
i := 0;
// Enumerate though all the devices.
while SetupDiEnumDeviceInfo(DevInfo, i, DeviceInfoData) do
begin
GetMem(pszText, 256);
try
// Get a friendly name for the device.
ConstructDeviceName(DevInfo, DeviceInfoData, pszText, DWord(nil));
Result.AddObject(pszText,Tobject(i));
finally
FreeMem(pszText);
inc(i);
end;
end;
end;
function EnableDevice(SelectedItem: DWord):TDeviceControlResult;
begin
result:=StateChange(DICS_ENABLE, SelectedItem , DevInfo);
end;
function DisableDevice(SelectedItem: DWord):TDeviceControlResult;
begin
result:=StateChange(DICS_DISABLE, SelectedItem , DevInfo);
end;
end.
Example program that lists all ports preceeded by a number.
Enter a number and the port will be disabled. Enter return again and the port will be enabled again.
program devicetest;
{$mode delphi}{$H+}
uses
Classes, controlwindevice;
var
sl:tstringlist;
i:integer;
begin
sl:=Loaddevices(GUID_DEVCLASS_PORT);
for i:=0 to sl.count-1 do
writeln(i,' : ',sl[i]);
readln(i);
if DisableDevice(i)=DCROK then
writeln(sl[i],' disabled');
readln;
if EnableDevice(i)=DCROK then
writeln(sl[i],' enabled');
sl.Free;
readln;
end.
Downloading a file using urlmon
Urlmon.dll is built into Windows and can be used to e.g. download a file from a web site. It supports SSL/TLS connections.
Windows-only; please look into libraries like fphttpclient, Synapse and Indy for cross-platform solutions.
function URLDownloadToFile(pCaller: pointer; URL: PChar; FileName: PChar; Reserved: DWORD; lpfnCB : pointer): HResult; stdcall; external 'urlmon.dll' name 'URLDownloadToFileA';
procedure TForm1.Button1Click(Sender: TObject);
var Source, Dest: string;
begin
Source:='http://lazarus.freepascal.org';
Dest:='C:\Windows\temp\data.txt';
if URLDownloadToFile(nil, PChar(Source), PChar(Dest), 0, nil)=0 then
showmessage('Download ok!')
else
showMessage('Error downloading '+Source);
end;
Showing/finding processes
Use code like thisto find a process handle based on the executable name (akin to the tasklist command):
program ProcessFindPID;
{$mode objfpc}{$H+}
uses
Classes, Sysutils, Windows, JwaTlHelp32;
function QueryFullProcessImageName(hProcess: HANDLE; dwFlags: DWORD; var lpExeName: LPTSTR;
var lpdwSize: LPDWORD): BOOL; stdcall; external 'KERNEL32.dll';
function FindInProcesses(const PName: string): DWord;
// Looks for process with PName executable and return
var
i: integer;
CPID: DWORD;
CProcName: array[0..259] of char;
S: HANDLE;
PE: TProcessEntry32;
begin
Result := 0;
CProcName := '';
S := CreateToolHelp32Snapshot(TH32CS_SNAPALL, 0); // Create snapshot
PE.DWSize := SizeOf(PE); // Set size before use
I := 1;
if Process32First(S, PE) then
repeat
CProcName := PE.szExeFile;
CPID := PE.th32ProcessID;
//if CProcName = '' then Writeln(IntToStr(i) + ' - (' + IntToStr(CPID) + ') Failed to get a process name')
Inc(i);
if UpperCase(CProcName) = UpperCase(PName) then
// Found the name. Set Result to the PID of process found
Result := CPID;
until not Process32Next(S, PE);
CloseHandle(S);
end;
begin
writeln('Explorer.exe has process id '+inttostr(FindInProcesses('explorer.exe')));
end.
Identify Windows Version
There is a code example at WindowsVersion/de
│
English (en) │
français (fr) │
Test whether an Application is already running
Here's a unit that works under both Windows and Linux
- 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.
unit uappisrunning;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils
{$IFDEF WINDOWS}, Windows, JwaTlHelp32{$ENDIF}
{$IFDEF LINUX},process{$ENDIF};
// JwaTlHelp32 is in fpc\packages\winunits-jedi\src\jwatlhelp32.pas
// Returns TRUE if EXEName is running under Windows or Linux
// Don't pass an .exe extension to Linux!
function AppIsRunning(const ExeName: string):Boolean;
implementation
// These functions return Zero if app is NOT running
// Override them if you have a better implementation
{$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);
// SendMessage(Exit-Message) possible?
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.