Sign in Join
Wiki copytemporary

Windows Programming Tips/fr: what changed

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

Title: Windows Programming Tips/fr

OldNewLine
1+*(Windows only)*
2+
3+Cette page est dédiée au bureau Windows - en y incluant le serveur - **Trucs de programmation Windows**.
4+
5+## Articles sur la programmation Windows
6+
7+- [[High DPI/fr|High DPI]] - Comment rendre sensible au DPI votre application sur Windows 7 ?
8+- [[Aero Glass/fr|Aero Glass]] - Comment appliquer l'effet Aero Glass sur une fiche Lazarus sur Windows 7 ?
9+- [[Windows Icon/fr|Icône Windows]] - Comment concevoir votre icône dans les bonnes tailles ?
10+- [[Inno Setup Usage/fr|Emploi d'Inno Setup]] - Comment créer les fichiers d'installation avec le support des associations de fichiers ?
11+
12+## Avertissement sur FPC 2.6.x/Lazarus (support manquant pour SEH)
13+
14+> **Warning:** Si vous pouvez l'éviter, n'utilisez pas les versions Win64 de Lazarus basées sur FPC 2.6.x et antérieures (ceci inclut Lazarus 1.x. Voir plus bas pour les détails.
15+
16+Gardez à l'esprit que les versions Lazarus 1.x utilisent FPC 2.6.x. FPC 2.6.x (et probablement aussi de plus anciennes versions) ne supporte pas proprement Windows 64 bit. En conséquence, utilisez de préférence l'IDE Lazarus 32-bit sous Win64. S'il est absolument nécessaire de construire des exécutables 64-bit (p.ex. des extensions de l'explorateur), installez alors le compilateur croisé 64-bit en add-on pour l'IDE 32-bit.
17+
18+Détails sur le bug : Sur Win64, les exceptions dans les DLLs (tierce-partie) peuvent être levée en utilsant SEH. Ces exceptions devrait être gérées à l'intérieur de la DLL elle-même.
19+
20+Toutefois, FPC voit une exception FPC (incorrecte) qui peut amener votre programme ou Lazarus à planter. Cela s'applique au DLLs comme les pilotes d'imprimantes, les pilotes de base de données, les extensions de Windows Explorer.
21+
22+Le problème a été corrigé dans la version de développement de FPC mais c'est un changement majeur qui ne sera reporté dans FPC 2.6.x.
23+
24+Des rapports de bug pertinents incluent <http://bugs.freepascal.org/view.php?id=12742>.
25+
26+## Options du compilateur spécifiques à Windows
27+
28+Les plus importantes options sont les drapeaux **-W**. Une application IHM nécessite le drapeau **-WG**. Voir *Options pour le projet / Options du compilateur / Ajouts et remplacements / Définir Win32*. Aucune console n'est visible, **writeln** et **readln** ne sont pas possible, vous obtiendrez des erreurs **File not open**. L'omission de cette option aboutit à une application console (identique à -WC).
29+
30+## Ecrire du code multiplate-forme qui tourne sur Windows
31+
32+Alors que vous pouvez utiliser du code Windows seulement (comme avec l'unité **windows**), avec un peu de soin vous pouvez souvent préparer pour une utilisation multiplate-forme (i.e. utiliser l'unité [[lclintf/fr|lclintf]]).
33+
34+Voir [[Multiplatform Programming Guide/fr|Problèmes spécifiques à Windows]] pour plus de détails.
35+
36+## Programmation COM
37+
38+### Importation et emploi d'une bibliothèque COM
39+
40+La première étape pour import et utiliser une bibliothèque COM consiste à générer les définitions d'interface à partir d'elle. Utiliser le programme importtl qui est à l'emplacement fpc/utils/importtl dans Free Pascal. Un binaire pré-compilé peut être trouvé là : <http://sourceforge.net/projects/p-tools/files/ImportTL/>.
41+
42+Vous pouvez l'appeler, par exemple pour MSAA comme cela :
43+
44+`importtl.exe C:\Windows\system32\oleacc.dll`
45+
46+Et il générera l'unité Pascal de bibliothèque de type Accessibility_1_1_TLB.pas dans le dossier où il se trouve.
47+
48+### Création d'une bibliothèque qui exporte un objet COM
49+
50+A faire: écrivez-moi...
51+
52+### Capteur Windows/API de localisation
53+
54+Disponible depuis Windows 7. Voir [[LazDeviceAPIs|Implémentation possible dans Windows]]
55+
56+## Contrôles ActiveX
57+
58+Vous pouvez utiliser des contrôles ActiveX dans les versions récentes de Lazarus. Voir [[LazActiveX/fr|LazActiveX]].
59+
60+## Services
61+
62+Lazarus et FPC facilitent l'écriture de services Windows. See [[Daemons and Services/fr|Daemons et Services]].
63+
64+## Extraits de code
65+
66+### Association de fichier
67+
68+Pour ajouter des icônes aux associations de fichier et l'enregistrer pour l'utilisation avec un programme, utilisez le composant [[FileAssociation/fr|FileAssociation]].
69+
70+### Liste de tous les lecteurs disponibles
71+
72+``` pascal
73+program listdevices;
74+
75+{$ifdef fpc}{$mode delphi}{$endif}
76+{$apptype console}
77+
78+uses
79+ Windows;
80+
81+var
82+ Drive: Char;
83+ DriveLetter: string;
84+ OldMode: Word;
85+begin
86+ WriteLn('The following drives were found in this computer:');
87+ WriteLn('');
88+
89+ // Empty Floppy or Zip drives can generate a Windows error.
90+ // We disable system errors during the listing.
91+ // Note that another way to skip these errors would be to use DEVICE_IO_CONTROL.
92+ OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
93+ try
94+
95+ // Search all drive letters
96+ for Drive := 'A' to 'Z' do
97+ begin
98+ DriveLetter := Drive + ':\';
99+
100+ case GetDriveType(PChar(DriveLetter)) of
101+ DRIVE_REMOVABLE: WriteLn(DriveLetter + ' Floppy Drive');
102+ DRIVE_FIXED: WriteLn(DriveLetter + ' Fixed Drive');
103+ DRIVE_REMOTE: WriteLn(DriveLetter + ' Network Drive');
104+ DRIVE_CDROM: WriteLn(DriveLetter + ' CD-ROM Drive');
105+ DRIVE_RAMDISK: WriteLn(DriveLetter + ' RAM Disk');
106+ end;
107+ end;
108+
109+ finally
110+ // Restores previous Windows error mode.
111+ SetErrorMode(OldMode);
112+ end;
113+
114+ // Also add a stop to see the result under Windows
115+ WriteLn('');
116+ WriteLn('Please press <ENTER> to exit the program.');
117+ ReadLn(DriveLetter);
118+end.
119+```
120+
121+### Création d'un fichier raccourci (.lnk)
122+
123+La création d'un raccourci sur le bureau peut être adapté à tout emplacement. Adapté de [posté par Felipe Monteiro de Carvalho](http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg13325.html) L'objet ISLink a plus de méthodes a plus de méthodes que vous pouvez utiliser pour modifier votre raccourci...
124+
125+``` pascal
126+uses
127+...
128+windows, shlobj {for special folders}, ActiveX, ComObj;
129+...
130+procedure CreateDesktopShortCut(Target, TargetArguments, ShortcutName: string);
131+var
132+ IObject: IUnknown;
133+ ISLink: IShellLink;
134+ IPFile: IPersistFile;
135+ PIDL: PItemIDList;
136+ InFolder: array[0..MAX_PATH] of Char;
137+ TargetName: String;
138+ LinkName: WideString;
139+begin
140+ { Creates an instance of IShellLink }
141+ IObject := CreateComObject(CLSID_ShellLink);
142+ ISLink := IObject as IShellLink;
143+ IPFile := IObject as IPersistFile;
144+
145+ ISLink.SetPath(pChar(Target));
146+ ISLink.SetArguments(pChar(TargetArguments));
147+ ISLink.SetWorkingDirectory(pChar(ExtractFilePath(Target)));
148+
149+ { Get the desktop location }
150+ SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL);
151+ SHGetPathFromIDList(PIDL, InFolder);
152+ LinkName := InFolder + PathDelim + ShortcutName+'.lnk';
153+
154+ { Create the link }
155+ IPFile.Save(PWChar(LinkName), false);
156+end;
157+```
158+
159+### Obtention des dossiers spéciaux (Mes documents, Bureau, Données locales d'application, etc)
160+
161+Il est souvent utile d'obtenir l'emplacement d'un dossier spécial tel que le bureau. L'exemple du dessous montre comment vous pouvez obtenir le dossier LocalAppData - où vous pouvez enregistrer un fichier de configuration dédié à l'utilisateur, des fichiers etc pour votre programme.
162+
163+Utiliser le dossier MesDocuments (ou un sous-dossier) pour stocker des documents.
164+
165+Regardez dans l'unité [shlobj](http://delphi-miranda-plugins.googlecode.com/svn-history/r105/trunk/FPC/units/src/shlobj.pp) (note: le lien peut ne pas être à jour) pour plus de définitions qui vous laissent atteindre le Bureau (note : utilisez CSIDL_DESKTOPDIRECTORY, pas CSIDL_DESKTOP), la poubelle, etc.
166+
167+``` pascal
168+uses
169+...
170+shlobj;
171+
172+var
173+ AppDataPath: Array[0..MaxPathLen] of Char; //Allocate memory
174+...
175+begin
176+...
177+ AppDataPath:='';
178+ SHGetSpecialFolderPath(0,AppDataPath,CSIDL_LOCAL_APPDATA,false);
179+ writeln('Your local appdata path is: ' + AppDataPath);
180+```
181+
182+Une autre manière pour réussir cela sans employer l'API Windows est d'interroger une variable d'environnement spécifique. Cette solution permet d'écrire un code système plus homogène puisque selon le système d'exploitation, seul le nom de la variable doit être modifié.
183+
184+Par exemple :
185+
186+``` pascal
187+program UseEnv;
188+
189+uses sysutils;
190+
191+begin
192+ writeln(GetEnvironmentVariable('APPDATA'));
193+ writeln(GetEnvironmentVariable('PROGRAMFILES'));
194+ writeln(GetEnvironmentVariable('HOMEPATH'));
195+ readln;
196+end.
197+```
198+
199+Toutefois cette solution n'est pas aussi précise que **SHGetSpecialFolderPath()**, puisqu'il est parfois nécessaire de composer entre plusieurs variables.
200+
201+Les variables disponibles peuvent être récupérées avec **SHGetSpecialFolderPath()** :
202+
203+``` pascal
204+program ListEnv;
205+
206+uses sysutils;
207+
208+var
209+ i: integer;
210+
211+begin
212+ for i in [0..GetEnvironmentVariableCount-1] do
213+ writeln(GetEnvironmentString(i));
214+ readln;
215+end.
216+```
217+
218+### Activation et désactivation de périphériques
219+
220+Le code suivant peut être utilisé pour activer et désactiver des périphériques Windows ; c'est utile pour p.ex. réinitialiser un port série pour un périphérique USB. Un exemple suit dessous.
221+
222+``` pascal
223+unit controlwindevice;
224+
225+{ Enable Disable windows devices
226+
227+ Copyright (c) 2010-2012 Ludo Brands
228+
229+ Permission is hereby granted, free of charge, to any person obtaining a copy
230+ of this software and associated documentation files (the "Software"), to
231+ deal in the Software without restriction, including without limitation the
232+ rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
233+ sell copies of the Software, and to permit persons to whom the Software is
234+ furnished to do so, subject to the following conditions:
235+
236+ The above copyright notice and this permission notice shall be included in
237+ all copies or substantial portions of the Software.
238+
239+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
240+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
241+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
242+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
243+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
244+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
245+ IN THE SOFTWARE.
246+}
247+
248+{$mode delphi}{$H+}
249+
250+interface
251+
252+uses
253+ Classes, SysUtils,dynlibs,windows;
254+
255+const
256+ GUID_DEVCLASS_NET : TGUID = '{4D36E972-E325-11CE-BFC1-08002BE10318}';
257+ GUID_DEVCLASS_PORT : TGUID = '{4D36E978-E325-11CE-BFC1-08002BE10318}';
258+
259+type
260+ TDeviceControlResult=(DCROK,DCRErrEnumDeviceInfo,DCRErrSetClassInstallParams,
261+ DCRErrDIF_PROPERTYCHANGE);
262+
263+function LoadDevices(GUID_DevClass:TGUID):TStringList;
264+function EnableDevice(SelectedItem: DWord):TDeviceControlResult;
265+function DisableDevice(SelectedItem: DWord):TDeviceControlResult;
266+
267+implementation
268+
269+// Setup api, based on SetupApi.pas JEDI library
270+const
271+ DIF_PROPERTYCHANGE = $00000012;
272+ DICS_ENABLE = $00000001;
273+ DICS_DISABLE = $00000002;
274+ DICS_FLAG_GLOBAL = $00000001; // make change in all hardware profiles
275+ DIGCF_PRESENT = $00000002;
276+ SPDRP_DEVICEDESC = $00000000; // DeviceDesc (R/W)
277+ SPDRP_CLASS = $00000007; // Class (R--tied to ClassGUID)
278+ SPDRP_CLASSGUID = $00000008; // ClassGUID (R/W)
279+ SPDRP_FRIENDLYNAME = $0000000C; // FriendlyName (R/W)
280+
281+type
282+ HDEVINFO = Pointer;
283+ DI_FUNCTION = LongWord; // Function type for device installer
284+
285+ PSPClassInstallHeader = ^TSPClassInstallHeader;
286+ SP_CLASSINSTALL_HEADER = packed record
287+ cbSize: DWORD;
288+ InstallFunction: DI_FUNCTION;
289+ end;
290+ TSPClassInstallHeader = SP_CLASSINSTALL_HEADER;
291+
292+ PSPPropChangeParams = ^TSPPropChangeParams;
293+ SP_PROPCHANGE_PARAMS = packed record
294+ ClassInstallHeader: TSPClassInstallHeader;
295+ StateChange: DWORD;
296+ Scope: DWORD;
297+ HwProfile: DWORD;
298+ end;
299+ TSPPropChangeParams = SP_PROPCHANGE_PARAMS;
300+
301+ PSPDevInfoData = ^TSPDevInfoData;
302+ SP_DEVINFO_DATA = packed record
303+ cbSize: DWORD;
304+ ClassGuid: TGUID;
305+ DevInst: DWORD; // DEVINST handle
306+ Reserved: ULONG_PTR;
307+ end;
308+ TSPDevInfoData = SP_DEVINFO_DATA;
309+
310+ TSetupDiEnumDeviceInfo = function(DeviceInfoSet: HDEVINFO;
311+ MemberIndex: DWORD; var DeviceInfoData: TSPDevInfoData): LongBool; stdcall;
312+ TSetupDiSetClassInstallParamsA = function(DeviceInfoSet: HDEVINFO;
313+ DeviceInfoData: PSPDevInfoData; ClassInstallParams: PSPClassInstallHeader;
314+ ClassInstallParamsSize: DWORD): LongBool; stdcall;
315+ TSetupDiSetClassInstallParamsW = function(DeviceInfoSet: HDEVINFO;
316+ DeviceInfoData: PSPDevInfoData; ClassInstallParams: PSPClassInstallHeader;
317+ ClassInstallParamsSize: DWORD): LongBool; stdcall;
318+ TSetupDiSetClassInstallParams = TSetupDiSetClassInstallParamsA;
319+ TSetupDiCallClassInstaller = function(InstallFunction: DI_FUNCTION;
320+ DeviceInfoSet: HDEVINFO; DeviceInfoData: PSPDevInfoData): LongBool; stdcall;
321+ TSetupDiGetClassDevs = function(ClassGuid: PGUID; const Enumerator: PAnsiChar;
322+ hwndParent: HWND; Flags: DWORD): HDEVINFO; stdcall;
323+ TSetupDiGetDeviceRegistryPropertyA = function(DeviceInfoSet: HDEVINFO;
324+ const DeviceInfoData: TSPDevInfoData; Property_: DWORD;
325+ var PropertyRegDataType: DWORD; PropertyBuffer: PBYTE; PropertyBufferSize: DWORD;
326+ var RequiredSize: DWORD): BOOL; stdcall;
327+ TSetupDiGetDeviceRegistryPropertyW = function(DeviceInfoSet: HDEVINFO;
328+ const DeviceInfoData: TSPDevInfoData; Property_: DWORD;
329+ var PropertyRegDataType: DWORD; PropertyBuffer: PBYTE; PropertyBufferSize: DWORD;
330+ var RequiredSize: DWORD): BOOL; stdcall;
331+ TSetupDiGetDeviceRegistryProperty = TSetupDiGetDeviceRegistryPropertyA;
332+
333+var
334+ DevInfo: hDevInfo;
335+ SetupDiEnumDeviceInfo: TSetupDiEnumDeviceInfo;
336+ SetupDiSetClassInstallParams: TSetupDiSetClassInstallParams;
337+ SetupDiCallClassInstaller: TSetupDiCallClassInstaller;
338+ SetupDiGetClassDevs: TSetupDiGetClassDevs;
339+ SetupDiGetDeviceRegistryProperty: TSetupDiGetDeviceRegistryProperty;
340+
341+var
342+ SetupApiLoadCount:integer=0;
343+
344+function LoadSetupApi: Boolean;
345+var SetupApiLib:TLibHandle;
346+begin
347+ Result := True;
348+ Inc(SetupApiLoadCount);
349+ if SetupApiLoadCount > 1 then
350+ Exit;
351+ SetupApiLib:=LoadLibrary('SetupApi.dll');
352+ Result := SetupApiLib<>0;
353+ if Result then
354+ begin
355+ SetupDiEnumDeviceInfo := GetProcedureAddress(SetupApiLib, 'SetupDiEnumDeviceInfo');
356+ SetupDiSetClassInstallParams := GetProcedureAddress(SetupApiLib, 'SetupDiSetClassInstallParamsA');
357+ SetupDiCallClassInstaller := GetProcedureAddress(SetupApiLib, 'SetupDiCallClassInstaller');
358+ SetupDiGetClassDevs := GetProcedureAddress(SetupApiLib, 'SetupDiGetClassDevsA');
359+ SetupDiGetDeviceRegistryProperty := GetProcedureAddress(SetupApiLib, 'SetupDiGetDeviceRegistryPropertyA');
360+ end;
361+end;
362+
363+// implementation
364+
365+function StateChange(NewState, SelectedItem: DWord;
366+ hDevInfo: hDevInfo): TDeviceControlResult;
367+var
368+ PropChangeParams: TSPPropChangeParams;
369+ DeviceInfoData: TSPDevInfoData;
370+begin
371+ PropChangeParams.ClassInstallHeader.cbSize := SizeOf(TSPClassInstallHeader);
372+ DeviceInfoData.cbSize := SizeOf(TSPDevInfoData);
373+ // Get a handle to the Selected Item.
374+ if (not SetupDiEnumDeviceInfo(hDevInfo, SelectedItem, DeviceInfoData)) then
375+ begin
376+ Result := DCRErrEnumDeviceInfo;
377+ exit;
378+ end;
379+ // Set the PropChangeParams structure.
380+ PropChangeParams.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
381+ PropChangeParams.Scope := DICS_FLAG_GLOBAL;
382+ PropChangeParams.StateChange := NewState;
383+ if (not SetupDiSetClassInstallParams(hDevInfo, @DeviceInfoData,
384+ PSPClassInstallHeader(@PropChangeParams), SizeOf(PropChangeParams))) then
385+ begin
386+ Result := DCRErrSetClassInstallParams;
387+ exit;
388+ end;
389+ // Call the ClassInstaller and perform the change.
390+ if (not SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, hDevInfo, @DeviceInfoData)) then
391+ begin
392+ Result := DCRErrDIF_PROPERTYCHANGE;
393+ exit;
394+ end;
395+ Result := DCROK;
396+end;
397+
398+function GetRegistryProperty(PnPHandle: HDEVINFO;
399+ DevData: TSPDevInfoData; Prop: DWORD; Buffer: PChar;
400+ dwLength: DWord): Boolean;
401+var
402+ aBuffer: array[0..256] of Char;
403+begin
404+ dwLength := 0;
405+ aBuffer[0] := #0;
406+ SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, Prop, Prop, PBYTE(@aBuffer[0]), SizeOf(aBuffer), dwLength);
407+ StrCopy(Buffer, aBuffer);
408+ Result := Buffer^ <> #0;
409+end;
410+
411+function ConstructDeviceName(DeviceInfoSet: hDevInfo;
412+ DeviceInfoData: TSPDevInfoData; Buffer: PChar; dwLength: DWord): Boolean;
413+const
414+ UnknownDevice = '<Unknown Device>';
415+begin
416+ if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_FRIENDLYNAME, Buffer, dwLength)) then
417+ begin
418+ if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_DEVICEDESC, Buffer, dwLength)) then
419+ begin
420+ if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASS, Buffer, dwLength)) then
421+ begin
422+ if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASSGUID, Buffer, dwLength)) then
423+ begin
424+ dwLength := DWord(SizeOf(UnknownDevice));
425+ Buffer := Pointer(LocalAlloc(LPTR, Cardinal(dwLength)));
426+ StrCopy(Buffer, UnknownDevice);
427+ end;
428+ end;
429+ end;
430+ end;
431+ Result := true;
432+end;
433+
434+function LoadDevices(GUID_DevClass:TGUID):TStringList;
435+var
436+ DeviceInfoData: TSPDevInfoData;
437+ i: DWord;
438+ pszText: PChar;
439+
440+begin
441+ if (not LoadSetupAPI) then
442+ begin
443+ result:=nil;
444+ exit;
445+ end;
446+ DevInfo := nil;
447+ // Get a handle to all devices in all classes present on system
448+ DevInfo := SetupDiGetClassDevs(@GUID_DevClass, nil, 0, DIGCF_PRESENT);
449+ if (DevInfo = Pointer(INVALID_HANDLE_VALUE)) then
450+ begin
451+ result:=nil;
452+ exit;
453+ end;
454+ Result:=TStringList.Create;
455+ DeviceInfoData.cbSize := SizeOf(TSPDevInfoData);
456+ i := 0;
457+ // Enumerate though all the devices.
458+ while SetupDiEnumDeviceInfo(DevInfo, i, DeviceInfoData) do
459+ begin
460+ GetMem(pszText, 256);
461+ try
462+ // Get a friendly name for the device.
463+ ConstructDeviceName(DevInfo, DeviceInfoData, pszText, DWord(nil));
464+ Result.AddObject(pszText,Tobject(i));
465+ finally
466+ FreeMem(pszText);
467+ inc(i);
468+ end;
469+ end;
470+end;
471+
472+function EnableDevice(SelectedItem: DWord):TDeviceControlResult;
473+
474+begin
475+ result:=StateChange(DICS_ENABLE, SelectedItem , DevInfo);
476+end;
477+
478+function DisableDevice(SelectedItem: DWord):TDeviceControlResult;
479+
480+begin
481+ result:=StateChange(DICS_DISABLE, SelectedItem , DevInfo);
482+end;
483+
484+end.
485+```
486+
487+Exemple de programme qui liste tous les ports précédé d'un nombre.
488+
489+Entrez un nombre et le port sera désactivé. Entrez Retour à nouveau et le port sera activé à nouveau.
490+
491+``` pascal
492+program devicetest;
493+
494+{$mode delphi}{$H+}
495+
496+uses
497+ Classes, controlwindevice;
498+var
499+ sl:tstringlist;
500+ i:integer;
501+begin
502+ sl:=Loaddevices(GUID_DEVCLASS_PORT);
503+ for i:=0 to sl.count-1 do
504+ writeln(i,' : ',sl[i]);
505+ readln(i);
506+ if DisableDevice(i)=DCROK then
507+ writeln(sl[i],' disabled');
508+ readln;
509+ if EnableDevice(i)=DCROK then
510+ writeln(sl[i],' enabled');
511+ sl.Free;
512+ readln;
513+end.
514+```
515+
516+### Télécharger un fichier en utilisant urlmon
517+
518+Urlmon.dll est construite dans Windows et peut être pour p.ex. télécharger un fichier depuis un site Web. Il supporte les connexions SSL/TLS.
519+
520+Valable uniquement pour Windows ; regardez dans les bibliothèques comme [[fphttpclient/fr|fphttpclient]], [[Synapse/fr|Synapse]] et [[Indy/fr|Indy]] pour des solutions multi plates-formes.
521+
522+``` pascal
523+function URLDownloadToFile(pCaller: pointer; URL: PChar; FileName: PChar; Reserved: DWORD; lpfnCB : pointer): HResult; stdcall; external 'urlmon.dll' name 'URLDownloadToFileA';
524+
525+procedure TForm1.Button1Click(Sender: TObject);
526+var Source, Dest: string;
527+begin
528+ Source:='http://lazarus.freepascal.org';
529+ Dest:='C:\Windows\temp\data.txt';
530+ if URLDownloadToFile(nil, PChar(Source), PChar(Dest), 0, nil)=0 then
531+ showmessage('Download ok!')
532+ else
533+ showMessage('Error downloading '+Source);
534+end;
535+```
536+
537+### Montrer/trouver des processus
538+
539+UTiliser un code comme celui-ci pour trouver un handle de processus en se basant sur le nom de l'exécutable (similaire à la commande TaskList) :
540+
541+``` pascal
542+program ProcessFindPID;
543+
544+{$mode objfpc}{$H+}
545+
546+uses
547+ Classes, Sysutils, Windows, JwaTlHelp32;
548+
549+function QueryFullProcessImageName(hProcess: HANDLE; dwFlags: DWORD; var lpExeName: LPTSTR;
550+var lpdwSize: LPDWORD): BOOL; stdcall; external 'KERNEL32.dll';
551+
552+function FindInProcesses(const PName: string): DWord;
553+ // Looks for process with PName executable and return
554+var
555+ i: integer;
556+ CPID: DWORD;
557+ CProcName: array[0..259] of char;
558+ S: HANDLE;
559+ PE: TProcessEntry32;
560+begin
561+ Result := 0;
562+ CProcName := '';
563+ S := CreateToolHelp32Snapshot(TH32CS_SNAPALL, 0); // Create snapshot
564+ PE.DWSize := SizeOf(PE); // Set size before use
565+ I := 1;
566+ if Process32First(S, PE) then
567+ repeat
568+ CProcName := PE.szExeFile;
569+ CPID := PE.th32ProcessID;
570+ //if CProcName = '' then Writeln(IntToStr(i) + ' - (' + IntToStr(CPID) + ') Failed to get a process name')
571+ Inc(i);
572+ if UpperCase(CProcName) = UpperCase(PName) then
573+ // Found the name. Set Result to the PID of process found
574+ Result := CPID;
575+ until not Process32Next(S, PE);
576+ CloseHandle(S);
577+end;
578+
579+begin
580+ writeln('Explorer.exe has process id '+inttostr(FindInProcesses('explorer.exe')));
581+end.
582+```
583+
584+### Identifier la version de Windows
585+
586+C'est un exemple de code de [[WindowsVersion/de]].
587+
588+---
589+*From the Free Pascal wiki, page "Windows Programming Tips/fr", as it stood on 2020-03-04 after a change by Trev, 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