Sign in Join
Wiki copytemporary

Windows Programming Tips/fr: what changed

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

OldNewLine
11*(Windows only)*
22
33Cette page est dédiée au bureau Windows - en y incluant le serveur - **Trucs de programmation Windows**.
44
55## Articles sur la programmation Windows
66
77- [[High DPI/fr|High DPI]] - Comment rendre sensible au DPI votre application sur Windows 7 ?
88- [[Aero Glass/fr|Aero Glass]] - Comment appliquer l'effet Aero Glass sur une fiche Lazarus sur Windows 7 ?
99- [[Windows Icon/fr|Icône Windows]] - Comment concevoir votre icône dans les bonnes tailles ?
1010- [[Inno Setup Usage/fr|Emploi d'Inno Setup]] - Comment créer les fichiers d'installation avec le support des associations de fichiers ?
1111
1212## Avertissement sur FPC 2.6.x/Lazarus (support manquant pour SEH)
1313
1414> **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.
1515
1616Gardez à 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.
1717
1818Dé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.
1919
2020Toutefois, 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.
2121
2222Le 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.
2323
2424Des rapports de bug pertinents incluent <http://bugs.freepascal.org/view.php?id=12742>.
2525
2626## Options du compilateur spécifiques à Windows
2727
2828Les 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).
2929
3030## Ecrire du code multiplate-forme qui tourne sur Windows
3131
3232Alors 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]]).
3333
3434Voir [[Multiplatform Programming Guide/fr|Problèmes spécifiques à Windows]] pour plus de détails.
3535
3636## Programmation COM
3737
3838### Importation et emploi d'une bibliothèque COM
3939
4040La 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/>.
4141
4242Vous pouvez l'appeler, par exemple pour MSAA comme cela :
4343
44-`importtl.exe C:\Windows\system32\oleacc.dll`
44+```text
45+importtl.exe C:\Windows\system32\oleacc.dll
46+```
4547
4648Et il générera l'unité Pascal de bibliothèque de type Accessibility_1_1_TLB.pas dans le dossier où il se trouve.
4749
4850### Création d'une bibliothèque qui exporte un objet COM
4951
5052A faire: écrivez-moi...
5153
5254### Capteur Windows/API de localisation
5355
5456Disponible depuis Windows 7. Voir [[LazDeviceAPIs|Implémentation possible dans Windows]]
5557
5658## Contrôles ActiveX
5759
5860Vous pouvez utiliser des contrôles ActiveX dans les versions récentes de Lazarus. Voir [[LazActiveX/fr|LazActiveX]].
5961
6062## Services
6163
6264Lazarus et FPC facilitent l'écriture de services Windows. See [[Daemons and Services/fr|Daemons et Services]].
6365
6466## Extraits de code
6567
6668### Association de fichier
6769
6870Pour ajouter des icônes aux associations de fichier et l'enregistrer pour l'utilisation avec un programme, utilisez le composant [[FileAssociation/fr|FileAssociation]].
6971
7072### Liste de tous les lecteurs disponibles
7173
7274``` pascal
7375program listdevices;
7476
7577{$ifdef fpc}{$mode delphi}{$endif}
7678{$apptype console}
7779
7880uses
7981 Windows;
8082
8183var
8284 Drive: Char;
8385 DriveLetter: string;
8486 OldMode: Word;
8587begin
8688 WriteLn('The following drives were found in this computer:');
8789 WriteLn('');
8890
8991 // Empty Floppy or Zip drives can generate a Windows error.
9092 // We disable system errors during the listing.
9193 // Note that another way to skip these errors would be to use DEVICE_IO_CONTROL.
9294 OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
9395 try
9496
9597 // Search all drive letters
9698 for Drive := 'A' to 'Z' do
9799 begin
98100 DriveLetter := Drive + ':\';
99101
100102 case GetDriveType(PChar(DriveLetter)) of
101103 DRIVE_REMOVABLE: WriteLn(DriveLetter + ' Floppy Drive');
102104 DRIVE_FIXED: WriteLn(DriveLetter + ' Fixed Drive');
103105 DRIVE_REMOTE: WriteLn(DriveLetter + ' Network Drive');
104106 DRIVE_CDROM: WriteLn(DriveLetter + ' CD-ROM Drive');
105107 DRIVE_RAMDISK: WriteLn(DriveLetter + ' RAM Disk');
106108 end;
107109 end;
108110
109111 finally
110112 // Restores previous Windows error mode.
111113 SetErrorMode(OldMode);
112114 end;
113115
114116 // Also add a stop to see the result under Windows
115117 WriteLn('');
116118 WriteLn('Please press <ENTER> to exit the program.');
117119 ReadLn(DriveLetter);
118120end.
119121```
120122
121123### Création d'un fichier raccourci (.lnk)
122124
123125La 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...
124126
125127``` pascal
126128uses
127129...
128130windows, shlobj {for special folders}, ActiveX, ComObj;
129131...
130132procedure CreateDesktopShortCut(Target, TargetArguments, ShortcutName: string);
131133var
132134 IObject: IUnknown;
133135 ISLink: IShellLink;
134136 IPFile: IPersistFile;
135137 PIDL: PItemIDList;
136138 InFolder: array[0..MAX_PATH] of Char;
137139 TargetName: String;
138140 LinkName: WideString;
139141begin
140142 { Creates an instance of IShellLink }
141143 IObject := CreateComObject(CLSID_ShellLink);
142144 ISLink := IObject as IShellLink;
143145 IPFile := IObject as IPersistFile;
144146
145147 ISLink.SetPath(pChar(Target));
146148 ISLink.SetArguments(pChar(TargetArguments));
147149 ISLink.SetWorkingDirectory(pChar(ExtractFilePath(Target)));
148150
149151 { Get the desktop location }
150152 SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, PIDL);
151153 SHGetPathFromIDList(PIDL, InFolder);
152154 LinkName := InFolder + PathDelim + ShortcutName+'.lnk';
153155
154156 { Create the link }
155157 IPFile.Save(PWChar(LinkName), false);
156158end;
157159```
158160
159161### Obtention des dossiers spéciaux (Mes documents, Bureau, Données locales d'application, etc)
160162
161163Il 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.
162164
163165Utiliser le dossier MesDocuments (ou un sous-dossier) pour stocker des documents.
164166
165167Regardez 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.
166168
167169``` pascal
168170uses
169171...
170172shlobj;
171173
172174var
173175 AppDataPath: Array[0..MaxPathLen] of Char; //Allocate memory
174176...
175177begin
176178...
177179 AppDataPath:='';
178180 SHGetSpecialFolderPath(0,AppDataPath,CSIDL_LOCAL_APPDATA,false);
179181 writeln('Your local appdata path is: ' + AppDataPath);
180182```
181183
182184Une 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é.
183185
184186Par exemple :
185187
186188``` pascal
187189program UseEnv;
188190
189191uses sysutils;
190192
191193begin
192194 writeln(GetEnvironmentVariable('APPDATA'));
193195 writeln(GetEnvironmentVariable('PROGRAMFILES'));
194196 writeln(GetEnvironmentVariable('HOMEPATH'));
195197 readln;
196198end.
197199```
198200
199201Toutefois cette solution n'est pas aussi précise que **SHGetSpecialFolderPath()**, puisqu'il est parfois nécessaire de composer entre plusieurs variables.
200202
201203Les variables disponibles peuvent être récupérées avec **SHGetSpecialFolderPath()** :
202204
203205``` pascal
204206program ListEnv;
205207
206208uses sysutils;
207209
208210var
209211 i: integer;
210212
211213begin
212214 for i in [0..GetEnvironmentVariableCount-1] do
213215 writeln(GetEnvironmentString(i));
214216 readln;
215217end.
216218```
217219
218220### Activation et désactivation de périphériques
219221
220222Le 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.
221223
222224``` pascal
223225unit controlwindevice;
224226
225227{ Enable Disable windows devices
226228
227229 Copyright (c) 2010-2012 Ludo Brands
228230
229231 Permission is hereby granted, free of charge, to any person obtaining a copy
230232 of this software and associated documentation files (the "Software"), to
231233 deal in the Software without restriction, including without limitation the
232234 rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
233235 sell copies of the Software, and to permit persons to whom the Software is
234236 furnished to do so, subject to the following conditions:
235237
236238 The above copyright notice and this permission notice shall be included in
237239 all copies or substantial portions of the Software.
238240
239241 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
240242 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
241243 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
242244 AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
243245 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
244246 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
245247 IN THE SOFTWARE.
246248}
247249
248250{$mode delphi}{$H+}
249251
250252interface
251253
252254uses
253255 Classes, SysUtils,dynlibs,windows;
254256
255257const
256258 GUID_DEVCLASS_NET : TGUID = '{4D36E972-E325-11CE-BFC1-08002BE10318}';
257259 GUID_DEVCLASS_PORT : TGUID = '{4D36E978-E325-11CE-BFC1-08002BE10318}';
258260
259261type
260262 TDeviceControlResult=(DCROK,DCRErrEnumDeviceInfo,DCRErrSetClassInstallParams,
261263 DCRErrDIF_PROPERTYCHANGE);
262264
263265function LoadDevices(GUID_DevClass:TGUID):TStringList;
264266function EnableDevice(SelectedItem: DWord):TDeviceControlResult;
265267function DisableDevice(SelectedItem: DWord):TDeviceControlResult;
266268
267269implementation
268270
269271// Setup api, based on SetupApi.pas JEDI library
270272const
271273 DIF_PROPERTYCHANGE = $00000012;
272274 DICS_ENABLE = $00000001;
273275 DICS_DISABLE = $00000002;
274276 DICS_FLAG_GLOBAL = $00000001; // make change in all hardware profiles
275277 DIGCF_PRESENT = $00000002;
276278 SPDRP_DEVICEDESC = $00000000; // DeviceDesc (R/W)
277279 SPDRP_CLASS = $00000007; // Class (R--tied to ClassGUID)
278280 SPDRP_CLASSGUID = $00000008; // ClassGUID (R/W)
279281 SPDRP_FRIENDLYNAME = $0000000C; // FriendlyName (R/W)
280282
281283type
282284 HDEVINFO = Pointer;
283285 DI_FUNCTION = LongWord; // Function type for device installer
284286
285287 PSPClassInstallHeader = ^TSPClassInstallHeader;
286288 SP_CLASSINSTALL_HEADER = packed record
287289 cbSize: DWORD;
288290 InstallFunction: DI_FUNCTION;
289291 end;
290292 TSPClassInstallHeader = SP_CLASSINSTALL_HEADER;
291293
292294 PSPPropChangeParams = ^TSPPropChangeParams;
293295 SP_PROPCHANGE_PARAMS = packed record
294296 ClassInstallHeader: TSPClassInstallHeader;
295297 StateChange: DWORD;
296298 Scope: DWORD;
297299 HwProfile: DWORD;
298300 end;
299301 TSPPropChangeParams = SP_PROPCHANGE_PARAMS;
300302
301303 PSPDevInfoData = ^TSPDevInfoData;
302304 SP_DEVINFO_DATA = packed record
303305 cbSize: DWORD;
304306 ClassGuid: TGUID;
305307 DevInst: DWORD; // DEVINST handle
306308 Reserved: ULONG_PTR;
307309 end;
308310 TSPDevInfoData = SP_DEVINFO_DATA;
309311
310312 TSetupDiEnumDeviceInfo = function(DeviceInfoSet: HDEVINFO;
311313 MemberIndex: DWORD; var DeviceInfoData: TSPDevInfoData): LongBool; stdcall;
312314 TSetupDiSetClassInstallParamsA = function(DeviceInfoSet: HDEVINFO;
313315 DeviceInfoData: PSPDevInfoData; ClassInstallParams: PSPClassInstallHeader;
314316 ClassInstallParamsSize: DWORD): LongBool; stdcall;
315317 TSetupDiSetClassInstallParamsW = function(DeviceInfoSet: HDEVINFO;
316318 DeviceInfoData: PSPDevInfoData; ClassInstallParams: PSPClassInstallHeader;
317319 ClassInstallParamsSize: DWORD): LongBool; stdcall;
318320 TSetupDiSetClassInstallParams = TSetupDiSetClassInstallParamsA;
319321 TSetupDiCallClassInstaller = function(InstallFunction: DI_FUNCTION;
320322 DeviceInfoSet: HDEVINFO; DeviceInfoData: PSPDevInfoData): LongBool; stdcall;
321323 TSetupDiGetClassDevs = function(ClassGuid: PGUID; const Enumerator: PAnsiChar;
322324 hwndParent: HWND; Flags: DWORD): HDEVINFO; stdcall;
323325 TSetupDiGetDeviceRegistryPropertyA = function(DeviceInfoSet: HDEVINFO;
324326 const DeviceInfoData: TSPDevInfoData; Property_: DWORD;
325327 var PropertyRegDataType: DWORD; PropertyBuffer: PBYTE; PropertyBufferSize: DWORD;
326328 var RequiredSize: DWORD): BOOL; stdcall;
327329 TSetupDiGetDeviceRegistryPropertyW = function(DeviceInfoSet: HDEVINFO;
328330 const DeviceInfoData: TSPDevInfoData; Property_: DWORD;
329331 var PropertyRegDataType: DWORD; PropertyBuffer: PBYTE; PropertyBufferSize: DWORD;
330332 var RequiredSize: DWORD): BOOL; stdcall;
331333 TSetupDiGetDeviceRegistryProperty = TSetupDiGetDeviceRegistryPropertyA;
332334
333335var
334336 DevInfo: hDevInfo;
335337 SetupDiEnumDeviceInfo: TSetupDiEnumDeviceInfo;
336338 SetupDiSetClassInstallParams: TSetupDiSetClassInstallParams;
337339 SetupDiCallClassInstaller: TSetupDiCallClassInstaller;
338340 SetupDiGetClassDevs: TSetupDiGetClassDevs;
339341 SetupDiGetDeviceRegistryProperty: TSetupDiGetDeviceRegistryProperty;
340342
341343var
342344 SetupApiLoadCount:integer=0;
343345
344346function LoadSetupApi: Boolean;
345347var SetupApiLib:TLibHandle;
346348begin
347349 Result := True;
348350 Inc(SetupApiLoadCount);
349351 if SetupApiLoadCount > 1 then
350352 Exit;
351353 SetupApiLib:=LoadLibrary('SetupApi.dll');
352354 Result := SetupApiLib<>0;
353355 if Result then
354356 begin
355357 SetupDiEnumDeviceInfo := GetProcedureAddress(SetupApiLib, 'SetupDiEnumDeviceInfo');
356358 SetupDiSetClassInstallParams := GetProcedureAddress(SetupApiLib, 'SetupDiSetClassInstallParamsA');
357359 SetupDiCallClassInstaller := GetProcedureAddress(SetupApiLib, 'SetupDiCallClassInstaller');
358360 SetupDiGetClassDevs := GetProcedureAddress(SetupApiLib, 'SetupDiGetClassDevsA');
359361 SetupDiGetDeviceRegistryProperty := GetProcedureAddress(SetupApiLib, 'SetupDiGetDeviceRegistryPropertyA');
360362 end;
361363end;
362364
363365// implementation
364366
365367function StateChange(NewState, SelectedItem: DWord;
366368 hDevInfo: hDevInfo): TDeviceControlResult;
367369var
368370 PropChangeParams: TSPPropChangeParams;
369371 DeviceInfoData: TSPDevInfoData;
370372begin
371373 PropChangeParams.ClassInstallHeader.cbSize := SizeOf(TSPClassInstallHeader);
372374 DeviceInfoData.cbSize := SizeOf(TSPDevInfoData);
373375 // Get a handle to the Selected Item.
374376 if (not SetupDiEnumDeviceInfo(hDevInfo, SelectedItem, DeviceInfoData)) then
375377 begin
376378 Result := DCRErrEnumDeviceInfo;
377379 exit;
378380 end;
379381 // Set the PropChangeParams structure.
380382 PropChangeParams.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
381383 PropChangeParams.Scope := DICS_FLAG_GLOBAL;
382384 PropChangeParams.StateChange := NewState;
383385 if (not SetupDiSetClassInstallParams(hDevInfo, @DeviceInfoData,
384386 PSPClassInstallHeader(@PropChangeParams), SizeOf(PropChangeParams))) then
385387 begin
386388 Result := DCRErrSetClassInstallParams;
387389 exit;
388390 end;
389391 // Call the ClassInstaller and perform the change.
390392 if (not SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, hDevInfo, @DeviceInfoData)) then
391393 begin
392394 Result := DCRErrDIF_PROPERTYCHANGE;
393395 exit;
394396 end;
395397 Result := DCROK;
396398end;
397399
398400function GetRegistryProperty(PnPHandle: HDEVINFO;
399401 DevData: TSPDevInfoData; Prop: DWORD; Buffer: PChar;
400402 dwLength: DWord): Boolean;
401403var
402404 aBuffer: array[0..256] of Char;
403405begin
404406 dwLength := 0;
405407 aBuffer[0] := #0;
406408 SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, Prop, Prop, PBYTE(@aBuffer[0]), SizeOf(aBuffer), dwLength);
407409 StrCopy(Buffer, aBuffer);
408410 Result := Buffer^ <> #0;
409411end;
410412
411413function ConstructDeviceName(DeviceInfoSet: hDevInfo;
412414 DeviceInfoData: TSPDevInfoData; Buffer: PChar; dwLength: DWord): Boolean;
413415const
414416 UnknownDevice = '<Unknown Device>';
415417begin
416418 if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_FRIENDLYNAME, Buffer, dwLength)) then
417419 begin
418420 if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_DEVICEDESC, Buffer, dwLength)) then
419421 begin
420422 if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASS, Buffer, dwLength)) then
421423 begin
422424 if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASSGUID, Buffer, dwLength)) then
423425 begin
424426 dwLength := DWord(SizeOf(UnknownDevice));
425427 Buffer := Pointer(LocalAlloc(LPTR, Cardinal(dwLength)));
426428 StrCopy(Buffer, UnknownDevice);
427429 end;
428430 end;
429431 end;
430432 end;
431433 Result := true;
432434end;
433435
434436function LoadDevices(GUID_DevClass:TGUID):TStringList;
435437var
436438 DeviceInfoData: TSPDevInfoData;
437439 i: DWord;
438440 pszText: PChar;
439441
440442begin
441443 if (not LoadSetupAPI) then
442444 begin
443445 result:=nil;
444446 exit;
445447 end;
446448 DevInfo := nil;
447449 // Get a handle to all devices in all classes present on system
448450 DevInfo := SetupDiGetClassDevs(@GUID_DevClass, nil, 0, DIGCF_PRESENT);
449451 if (DevInfo = Pointer(INVALID_HANDLE_VALUE)) then
450452 begin
451453 result:=nil;
452454 exit;
453455 end;
454456 Result:=TStringList.Create;
455457 DeviceInfoData.cbSize := SizeOf(TSPDevInfoData);
456458 i := 0;
457459 // Enumerate though all the devices.
458460 while SetupDiEnumDeviceInfo(DevInfo, i, DeviceInfoData) do
459461 begin
460462 GetMem(pszText, 256);
461463 try
462464 // Get a friendly name for the device.
463465 ConstructDeviceName(DevInfo, DeviceInfoData, pszText, DWord(nil));
464466 Result.AddObject(pszText,Tobject(i));
465467 finally
466468 FreeMem(pszText);
467469 inc(i);
468470 end;
469471 end;
470472end;
471473
472474function EnableDevice(SelectedItem: DWord):TDeviceControlResult;
473475
474476begin
475477 result:=StateChange(DICS_ENABLE, SelectedItem , DevInfo);
476478end;
477479
478480function DisableDevice(SelectedItem: DWord):TDeviceControlResult;
479481
480482begin
481483 result:=StateChange(DICS_DISABLE, SelectedItem , DevInfo);
482484end;
483485
484486end.
485487```
486488
487489Exemple de programme qui liste tous les ports précédé d'un nombre.
488490
489491Entrez un nombre et le port sera désactivé. Entrez Retour à nouveau et le port sera activé à nouveau.
490492
491493``` pascal
492494program devicetest;
493495
494496{$mode delphi}{$H+}
495497
496498uses
497499 Classes, controlwindevice;
498500var
499501 sl:tstringlist;
500502 i:integer;
501503begin
502504 sl:=Loaddevices(GUID_DEVCLASS_PORT);
503505 for i:=0 to sl.count-1 do
504506 writeln(i,' : ',sl[i]);
505507 readln(i);
506508 if DisableDevice(i)=DCROK then
507509 writeln(sl[i],' disabled');
508510 readln;
509511 if EnableDevice(i)=DCROK then
510512 writeln(sl[i],' enabled');
511513 sl.Free;
512514 readln;
513515end.
514516```
515517
516518### Télécharger un fichier en utilisant urlmon
517519
518520Urlmon.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.
519521
520522Valable 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.
521523
522524``` pascal
523525function URLDownloadToFile(pCaller: pointer; URL: PChar; FileName: PChar; Reserved: DWORD; lpfnCB : pointer): HResult; stdcall; external 'urlmon.dll' name 'URLDownloadToFileA';
524526
525527procedure TForm1.Button1Click(Sender: TObject);
526528var Source, Dest: string;
527529begin
528530 Source:='http://lazarus.freepascal.org';
529531 Dest:='C:\Windows\temp\data.txt';
530532 if URLDownloadToFile(nil, PChar(Source), PChar(Dest), 0, nil)=0 then
531533 showmessage('Download ok!')
532534 else
533535 showMessage('Error downloading '+Source);
534536end;
535537```
536538
537539### Montrer/trouver des processus
538540
539541UTiliser 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) :
540542
541543``` pascal
542544program ProcessFindPID;
543545
544546{$mode objfpc}{$H+}
545547
546548uses
547549 Classes, Sysutils, Windows, JwaTlHelp32;
548550
549551function QueryFullProcessImageName(hProcess: HANDLE; dwFlags: DWORD; var lpExeName: LPTSTR;
550552var lpdwSize: LPDWORD): BOOL; stdcall; external 'KERNEL32.dll';
551553
552554function FindInProcesses(const PName: string): DWord;
553555 // Looks for process with PName executable and return
554556var
555557 i: integer;
556558 CPID: DWORD;
557559 CProcName: array[0..259] of char;
558560 S: HANDLE;
559561 PE: TProcessEntry32;
560562begin
561563 Result := 0;
562564 CProcName := '';
563565 S := CreateToolHelp32Snapshot(TH32CS_SNAPALL, 0); // Create snapshot
564566 PE.DWSize := SizeOf(PE); // Set size before use
565567 I := 1;
566568 if Process32First(S, PE) then
567569 repeat
568570 CProcName := PE.szExeFile;
569571 CPID := PE.th32ProcessID;
570572 //if CProcName = '' then Writeln(IntToStr(i) + ' - (' + IntToStr(CPID) + ') Failed to get a process name')
571573 Inc(i);
572574 if UpperCase(CProcName) = UpperCase(PName) then
573575 // Found the name. Set Result to the PID of process found
574576 Result := CPID;
575577 until not Process32Next(S, PE);
576578 CloseHandle(S);
577579end;
578580
579581begin
580582 writeln('Explorer.exe has process id '+inttostr(FindInProcesses('explorer.exe')));
581583end.
582584```
583585
584586### Identifier la version de Windows
585587
586588C'est un exemple de code de [[WindowsVersion/de]].
587589
588590---
589591*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