Windows Programming Tips
This page is dedicated to desktop 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.
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
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 the Lazarus installer stores its configuration by default. Look in the shlobj unit for more defines that let you look up the 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 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):
Source: John forum post
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.