IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
logo

FAQ DelphiConsultez toutes les FAQ

Nombre d'auteurs : 124, nombre de questions : 929, dernière mise à jour : 31 décembre 2023  Ajouter une question

 

Cette FAQ a été réalisée à partir des questions fréquemment posées sur les forums Delphi et Delphi et bases de données de www.developpez.com et de l'expérience personnelle des auteurs.

Nous tenons à souligner que cette FAQ ne garantit en aucun cas que les informations qu'elle propose soient correctes. Les auteurs font le maximum, mais l'erreur est humaine. Cette FAQ ne prétend pas non plus être complète. Si vous souhaitez y apporter des corrections ou la compléter, contactez un responsable (lien au bas de cette page).

Nous espérons que cette FAQ saura répondre à vos attentes. Nous vous en souhaitons une bonne lecture.

L'équipe Delphi de Developpez.com.

SommaireSystèmeSystème - Divers (32)
précédent sommaire suivant
 

Le composant MiTeC System information récupère toutes les informations du système mais impose un écran de publicité dans l'exécutable.

Il existe d'autres composants sur Torry, rubrique System Info.

WMI
Un tutoriel en Delphi
La section Annexe contient quelques liens vers des bibliothèques de scripts VB assez aisées à convertir.

En revanche et avant d'aller plus loin il faut vérifier les postes cibles, certaines versions de Windows ne proposent pas nativement WMI. Dans ce cas, une installation est nécessaire. Du coup, la phase de déploiement n'est plus la même.

Mis à jour le 16 janvier 2014 Laurent Dardenne Thierry Laborde

Il peut être pratique d'accéder directement aux différents modules du panneau de configuration sans avoir à ouvrir celui-ci. Pour connaître la liste des modules disponibles sur votre ordinateur il vous suffit de rechercher dans le répertoire System32 de Windows les fichiers ayant l'extension .CPL.

Code delphi : Sélectionner tout
rundll32.exe shell32.dll, Control_RunDLL MONMODULE.CPL
La ligne de commande pour ouvrir les fichier CPL est, par exemple pour ouvrir le module Date et Heure (timedate.cpl) :
Code delphi : Sélectionner tout
WinExec(PChar('rundll32.exe shell32.dll,Control_RunDLL TIMEDATE.CPL'), SW_SHOWNORMAL);

Liste des noms de modules avec correspondance :
  • access.cpl : Options d'accessibilité ;
  • appwiz.cpl : Ajout / Suppression de programmes ;
  • BDEADMIN.CPL : Administrateur BDE ;
  • desk.cpl : Affichage ;
  • hdwwiz.cpl : Ajout de matériel ;
  • ibmgr.cpl : Interbase Manager ;
  • inetcpl.cpl : Propriétés Internet ;
  • intl.cpl : Options régionales ;
  • joy.cpl : Contrôleur de jeux ;
  • mmsys.cpl : Son et périphériques Audio ;
  • modem.cpl : Modems ;
  • ncpa.cpl : Accès Réseau à distance ;
  • nusrmgr.cpl : Comptes Utilisateurs (XP) ;
  • odbccp32.cpl : Administrateur de source ODBC ;
  • powercfg.cpl : Propriétés des Options d'alimentation ;
  • sysdm.cpl : Système ;
  • timedate.cpl : Date et Heure ;
  • main.cpl @0 : Souris ;
  • main.cpl @1 : Clavier ;
  • main.cpl @2 : Imprimantes ;
  • main.cpl @3 : Polices.

Selon le système d'exploitation que vous utilisez, vous aurez plus ou moins de modules. Il est conseillé de toujours vérifier la présence du fichier CPL avant de lancer le module.

Mis à jour le 18 octobre 2013 atlantis Tofalu

Pour obtenir la version de Windows installée sur le PC, Delphi fournit des variables de version dans l'unité SysUtils : Win32MajorVersion et Win32MinorVersion.

On peut en déduire la version de Windows à l'aide du code suivant :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
type 
  TOSVERSIONINFOEX = record 
    dwOSVersionInfoSize: DWORD; 
    dwMajorVersion: DWORD; 
    dwMinorVersion: DWORD; 
    dwBuildNumber: DWORD; 
    dwPlatformId: DWORD; 
    szCSDVersion: array[0..127] of AnsiChar; { Maintenance string for PSS usage } 
    wServicePackMajor: WORD; 
    wServicePackMinor: WORD; 
    wSuiteMask: WORD; 
    wProductType: BYTE; 
    wReserved: BYTE; 
  end; 
  
const 
  VER_SERVER_NT                      = DWORD($80000000); 
  {$EXTERNALSYM VER_SERVER_NT} 
  VER_WORKSTATION_NT                 = $40000000; 
  {$EXTERNALSYM VER_WORKSTATION_NT} 
  VER_SUITE_SMALLBUSINESS            = $00000001; 
  {$EXTERNALSYM VER_SUITE_SMALLBUSINESS} 
  VER_SUITE_ENTERPRISE               = $00000002; 
  {$EXTERNALSYM VER_SUITE_ENTERPRISE} 
  VER_SUITE_BACKOFFICE               = $00000004; 
  {$EXTERNALSYM VER_SUITE_BACKOFFICE} 
  VER_SUITE_COMMUNICATIONS           = $00000008; 
  {$EXTERNALSYM VER_SUITE_COMMUNICATIONS} 
  VER_SUITE_TERMINAL                 = $00000010; 
  {$EXTERNALSYM VER_SUITE_TERMINAL} 
  VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020; 
  {$EXTERNALSYM VER_SUITE_SMALLBUSINESS_RESTRICTED} 
  VER_SUITE_EMBEDDEDNT               = $00000040; 
  {$EXTERNALSYM VER_SUITE_EMBEDDEDNT} 
  VER_SUITE_DATACENTER               = $00000080; 
  {$EXTERNALSYM VER_SUITE_DATACENTER} 
  VER_SUITE_SINGLEUSERTS             = $00000100; 
  {$EXTERNALSYM VER_SUITE_SINGLEUSERTS} 
  VER_SUITE_PERSONAL                 = $00000200; 
  {$EXTERNALSYM VER_SUITE_PERSONAL} 
  VER_SUITE_BLADE                    = $00000400; 
  {$EXTERNALSYM VER_SUITE_BLADE} 
  
// 
// RtlVerifyVersionInfo() os product type values 
// 
  
  VER_NT_WORKSTATION       = $0000001; 
  {$EXTERNALSYM VER_NT_WORKSTATION} 
  VER_NT_DOMAIN_CONTROLLER = $0000002; 
  {$EXTERNALSYM VER_NT_DOMAIN_CONTROLLER} 
  VER_NT_SERVER            = $0000003; 
  {$EXTERNALSYM VER_NT_SERVER} 
  
procedure AddString(var Dest: string; const Source: string; const LineFeed: boolean = True); 
begin 
  if Dest = '' then 
    Dest:= Source 
  else 
    if LineFeed then 
      Dest:= Dest + #13#10 + Source 
    else Dest:= Dest + Source; 
end; 
  
procedure AddStrings(var Dest: string; const Header: string; 
  const Source: TStrings; const Prefix: string = '  '); 
var 
  i: integer; 
begin 
  if Source.Count = 1 then 
  begin 
    if Header <> '' then 
      AddString(Dest, Header + ' ' + Source[0]) 
    else 
      AddString(Dest, Source[0]); 
  end 
  else 
  begin 
    if Header <> '' then 
      AddString(Dest, Header); 
    for i:=0 to Source.Count-1 do 
      AddString(Dest, Prefix + Source[i]); 
  end; 
end; 
  
function SystemVersionText: string; 
type 
  THKEY = type Longword; 
var 
  osvi: TOSVERSIONINFOEX; 
  bOsVersionInfoEx: boolean; 
  
  Key: HKEY; 
  szProductType : PChar; 
  dwBufLen: DWORD; 
begin 
  result:= ''; 
  
  // Try calling GetVersionEx using the OSVERSIONINFOEX structure. 
  // If that fails, try using the OSVERSIONINFO structure. 
  
  FillChar(osvi, SizeOf(TOSVERSIONINFOEX), 0); 
  osvi.dwOSVersionInfoSize:= SizeOf(TOSVERSIONINFOEX); 
  
  bOsVersionInfoEx:= GetVersionEx(POSVERSIONINFO(@osvi)^); 
  if not bOsVersionInfoEx then 
  begin 
    // If OSVERSIONINFOEX doesn't work, try OSVERSIONINFO. 
    osvi.dwOSVersionInfoSize:= SizeOf(TOSVERSIONINFO); 
    if not GetVersionEx(POSVERSIONINFO(@osvi)^) then 
      exit; 
  end; 
  
  case osvi.dwPlatformId of 
    // Tests for Windows NT product family. 
    VER_PLATFORM_WIN32_NT: 
    begin 
      // Test for the product. 
      if osvi.dwMajorVersion <= 4 then 
AddString(result, 'Microsoft Windows NT'); 
      if (osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 0) then 
AddString(result, 'Microsoft Windows 2000'); 
  
      if bOsVersionInfoEx then  // Use information from GetVersionEx. 
      begin 
// Test for the workstation type. 
if osvi.wProductType = VER_NT_WORKSTATION then 
begin 
  if (osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 1) then 
  AddString(result, 'Microsoft Windows XP'); 
  
  if (osvi.wSuiteMask and VER_SUITE_PERSONAL) <> 0 then 
    AddString(result, ' Home Edition', False) 
  else 
    AddString(result, ' Professional', False); 
end 
  
// Test for the server type. 
else if osvi.wProductType = VER_NT_SERVER then 
begin 
  if (osvi.dwMajorVersion = 5) and (osvi.dwMinorVersion = 1) then 
    AddString(result, 'Microsoft Windows .NET'); 
  
  if (osvi.wSuiteMask and VER_SUITE_DATACENTER) <> 0 then 
    AddString(result, ' DataCenter Server', False) 
  else if (osvi.wSuiteMask and VER_SUITE_ENTERPRISE) <> 0 then 
    if osvi.dwMajorVersion = 4 then 
      AddString(result, ' Advanced Server', False) 
    else 
      AddString(result, ' Enterprise Server', False) 
  else if osvi.wSuiteMask = VER_SUITE_BLADE then 
    AddString(result, ' Web Server', False) 
  else 
    AddString(result, ' Server', False); 
end 
      end 
      else   // Use the registry on early versions of Windows NT. 
      begin 
RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'SYSTEM\\CurrentControlSet\\Control\\ProductOptions', 
  0, KEY_QUERY_VALUE, Key ); 
szProductType:= StrAlloc(80); 
RegQueryValueEx(Key, 'ProductType', Nil, Nil, 
  PByte(szProductType), @dwBufLen); 
RegCloseKey(Key); 
if szProductType = 'WINNT' then 
  AddString(result, ' Professional', False); 
if szProductType = 'LANMANNT' then 
  AddString(result, ' Server', False); 
if szProductType = 'SERVERNT' then 
  AddString(result, ' Advanced Server', False); 
StrDispose(szProductType); 
      end; 
  
    // Display version, service pack (if any), and build number. 
  
      if osvi.dwMajorVersion <= 4  then 
AddString(result, Format('version %d.%d %s (Build %d)', 
  [osvi.dwMajorVersion, 
  osvi.dwMinorVersion, 
  osvi.szCSDVersion, 
  osvi.dwBuildNumber and $FFFF])) 
      else 
AddString(result, Format('%s (Build %d)', 
  [osvi.szCSDVersion, 
  osvi.dwBuildNumber and $FFFF])); 
    end; 
  
    // Test for the Windows 95 product family. 
    VER_PLATFORM_WIN32_WINDOWS: 
    begin 
      if (osvi.dwMajorVersion = 4) and (osvi.dwMinorVersion = 0) then 
      begin 
AddString(result, 'Microsoft Windows 95'); 
if (osvi.szCSDVersion[1] = 'C') or (osvi.szCSDVersion[1] = 'B') then 
  AddString(result, ' OSR2', False); 
      end; 
  
      if (osvi.dwMajorVersion = 4) and (osvi.dwMinorVersion = 10) then 
      begin 
AddString(result, 'Microsoft Windows 98'); 
if osvi.szCSDVersion[1] = 'A' then 
  AddString(result, ' SE', False); 
      end; 
  
      if (osvi.dwMajorVersion = 4) and (osvi.dwMinorVersion = 90) then 
AddString(result, 'Microsoft Windows Millennium Edition'); 
    end; 
  end; 
end;
Cette méthode permet d'obtenir simplement le nom du système d'exploitation. Il est possible d'obtenir des informations plus détaillées (numéro de construction, pro/perso, etc) en utilisant les fonctions API. Cette méthode un peu plus longue est donnée dans le fichier zip d'exemple en plus de la méthode ci-dessus.

Mis à jour le 18 octobre 2013 Pierre Castelain

La fonction API GetUserName permet d'obtenir l'identifiant de l'utilisateur. Ce nom est celui qui est saisie lors de l'authentification de l'utilisateur au démarrage de Windows.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
function UserName : string;  
var  
  Utilisateur : Array[0..255] Of Char;  
  Taille      : Cardinal;  
begin  
  Taille := SizeOf(Utilisateur);  
  If GetUserName(@Utilisateur,Taille) then  
    Result := strpas(Utilisateur)  
  else  
    Result :='';  
end;

Mis à jour le 18 octobre 2013 atlantis

L'API GetTickCount permet de récupérer le nombre de millisecondes qui se sont écoulées depuis le lancement de Windows. En utilisant cette API, il est donc possible de déterminer depuis combien de temps a démarré l'ordinateur.

Code delphi : Sélectionner tout
1
2
3
4
Function TimeBoot : TTime; 
Begin 
  Result := (GetTickCount/1000)/(24*3600); 
End;

Pour connaître la date et l'heure du dernier démarrage de l'ordinateur, il suffit de soustraire le temps écoulé depuis le lancement de Windows à la date et l'heure actuelle :
Code delphi : Sélectionner tout
1
2
3
4
Function DateBoot : TDateTime; 
Begin 
  Result := Now-(GetTickCount/1000)/(24*3600); 
End;
Tous les 47 jours, même si l'ordinateur n'est pas redémarré, le compteur repassera automatiquement à 0.

Mis à jour le 18 octobre 2013 atlantis

Il peut parfois être utile de récupérer le handle de la fenêtre principale d'un programme quand on connaît son identifiant de processus (par exemple avec un appel à CreateProcess).
Malheureusement, il est tout à fait possible que le programme possède plusieurs fenêtres et non une seule. Les programmes Delphi en sont un bon exemple car chaque programme créé avec Delphi possède 2 handles de fenêtre : celui de l'application et celui de la fenêtre principale. De plus il n'existe pas de fonction de l'API nous fournissant directement ces informations.
Il existe une solution relativement simple à ce problème. Nous devons parcourir toutes les fenêtres de plus haut niveau (celles qui n'ont pas de fenêtre parente) et vérifier si elles appartiennent au processus recherché. Pour ce faire, nous utilisons la fonction EnumWindows. Cette fonction prend comme argument, l'adresse d'une fonction qui sera appelée à chaque fois que EnumWindows trouve une nouvelle fenêtre ainsi qu'un paramètre entier libre. C'est ce que l'on appelle une fonction CallBack. Celle-ci recevra comme argument le handle de la fenêtre à étudier ainsi que le paramètre entier passé à EnumWindows. Ce paramètre nous permet donc de passer une structure à notre callback en utilisant un peu de transtypage. Cette structure sera composée de l'identifiant de processus recherché ainsi que d'une liste nous permettant de stocker les handles de fenêtre correspondant au processus.
Ne soyez pas effrayés par les (trop) nombreux transtypages utilisés. Ils nous permettent de contourner le typage fort de Delphi qui nous empêche de stocker des entiers là où des pointeurs sont attendus, etc.
Nous trouvons donc dans le code suivant : Une structure de données ainsi qu'un type pointeur correspondant, une fonction callback appelée EnumWindowsProc dont vous noterez la déclaration stdcall indispensable pour tout callback avec Windows, et enfin notre fonction appelée FindProcessWindows. Celle-ci possède deux arguments : ProcessID qui est l'identifiant du processus et Handles qui est une TList.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
type 
  PFindWindowsStruct = ^TFindWindowsStruct; 
  TFindWindowsStruct = record 
    ProcessID: DWORD; 
    HandleList: TList; 
  end; 
  
function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): boolean; stdcall; 
var 
  dwProcessId: DWORD; 
begin 
  if lParam <> 0 then 
  begin 
    GetWindowThreadProcessId(hwnd, dwProcessId); 
    with PFindWindowsStruct(lParam)^ do 
      if dwProcessID = ProcessID then 
        HandleList.Add(Pointer(hwnd)); 
    result:= true; 
  end 
  else 
    result:= false; 
end; 
  
procedure FindProcessWindows(ProcessID: Integer; Handles: TList); 
var 
  findWindowsStruct: TFindWindowsStruct; 
begin 
  findWindowsStruct.ProcessID:= ProcessID; 
  findWindowsStruct.HandleList:= Handles; 
  EnumWindows(@EnumWindowsProc, Integer(@findWindowsStruct)); 
end;
Voici un exemple d'utilisation basé sur une fenêtre contenant un simple TMemo que nous remplirons avec les handles des fenêtres trouvées. Dans cet exemple, nous affichons dans le titre de la fenêtre les handles de l'application et de la fenêtre elle-même afin de vérifier que nous récupérons bien les bons handles avec notre fonction.
Le code est placé dans le gestionnaire d'événement OnShow de la fenêtre.
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure TForm1.FormShow(Sender: TObject); 
var 
  handles: TList; 
  i: Integer; 
begin 
  Caption:= Format('Application : %d , Fenêtre courante : %d', 
    [Application.Handle, Handle]); 
  
  handles:= TList.Create; 
  Try 
    FindProcessWindows(GetCurrentProcessID, handles); 
    memo1.lines.Clear; 
    for i:= 0 to handles.Count - 1 do 
      Memo1.Lines.Add(IntToStr(Integer(Handles[i]))); 
  Finally 
    handles.Free; 
  End; 
end;

Mis à jour le 15 janvier 2014 Pierre Castelain

Les variables d'environnement peuvent être consultées grâce à la fonction GetEnvironmentVariable déclarée dans l'unité SysUtils. Attention de ne pas la confondre avec la fonction du même nom déclarée dans l'unité Windows. Il s'agit d'une fonction réalisant la même opération mais dont les arguments sont différents.
Pour plus d'information sur le sujet, vous pouvez consulter l'article plus complet ci-dessous :

Mis à jour le 17 janvier 2014 Pierre Castelain

Windows fournit les API nécessaires à la gestion du presse-papier : les fonctions SetClipboardViewer et ChangeClipboardChain, ainsi que les messages WM_CHANGECBCHAIN et WM_DRAWCLIPBOARD.

L'utilisation de ces fonctions est détaillée dans le programme ClipboardViewer disponible à l'adresse ci-dessous :

Mis à jour le 17 janvier 2014 Pierre Castelain

Il existe de nombreux utilitaires pour lire les ressources incluses dans les fichiers. Le plus connu dans les outils gratuits est ResHacker.

Ce programme peut aussi être piloté par Delphi afin d'effectuer des recherches sur une liste de fichiers. Le principe de cette recherche est expliqué dans l'article en lien ci-dessous :

Mis à jour le 17 janvier 2014 Pierre Castelain

L'API ExitWindowsEx permet l'arrêt ou le redémarrage de Windows. Elle envoie le message WM_QUERYENDSESSION à toutes les applications pour déterminer si elles peuvent s'arrêter.
Si une application renvoie False la procédure est annulée.

Unité Windows :

Code delphi : Sélectionner tout
Function ExitWindowsEx(uFlags: UINT; dwReserved: DWORD): BOOL; stdcall;
Valeurs de uFlags :
Pour terminer la session en cours : EWX_LOGOFF

Pour arrêter Windows ( n'arrête pas l'alimentation ) : EWX_SHUTDOWN
Sous Windows XP SP1, si l'ordinateur supporte l'arrêt logiciel de l'alimentation, dans ce cas elle est arrêtée.

Pour arrêter Windows et l'alimentation : EWX_POWEROFF

Pour redémarrer Windows : EWX_REBOOT

Pour forcer la fin des process avant le redémarrage de Windows : EWX_SHUTDOWN + EWX_ FORCE
Dans ce cas la fonction n'envoie pas le message WM_QUERYENDSESSION et WM_ENDSESSION ce qui peut entraîner des pertes de données. A n'utiliser qu'en cas d'urgence
Sous Windows XP, si l'ordinateur est verrouillé, la procédure d'arrêt échoue sauf si celle-ci est exécutée à partir d'un service.

Pour forcer l'arrêt des applications qui ne répondent pas au message WM_QUERYENDSESSION ou WM_ENDSESSION dans l'intervalle de temps alloué : EWX_SHUTDOWN + EWX_FORCEIFHUNG
Sous Windows NT et Windows Me/98/95: cette valeur n'est pas supportée.

dwReserved (le SDK indique : DWORD dwReason)
Indique la raison de l'arrêt. Zéro indique qu'il s'agit d'un arrêt 'non défini'. Vous pouvez spécifier un code indiquant la raison du arrêt du système.
Pour plus de détails
Si l'appel renvoie True rien ne vous assure que l'arrêt sera effectivement exécuté, le système ou une application pouvant l'annuler.
Si l'appel échoue la fonction renvoie False dans ce cas appellez l'API GetLastError pour obtenir des informations sur l'erreur.

Pour pouvoir exécuter cette fonction il faut positionner le privilège SE_SHUTDOWN_NAME avant l'appel
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Function ArretSystem: Boolean; 
Var 
 Token: THandle; 
 TokenPrivilege: TTokenPrivileges; 
 Outlen : Cardinal; 
 Error:Dword; 
  
Const 
 SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; 
  
Begin 
   Result:=False; 
   // Récupère les informations de sécurité pour ce process. 
   if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, Token) 
    then Exit; 
  try 
  
   FillChar(TokenPrivilege, SizeOf(TokenPrivilege),0); 
     // Valeur de retour 
   Outlen := 0; 
     // Un seul privilége à positionner 
   TokenPrivilege.PrivilegeCount := 1; 
  
     // Récupère le LUID pour le privilége 'shutdown'. 
     // un Locally Unique IDentifier est une valeur générée unique jusqu'a ce 
     // que le système soit redémarré 
   LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, TokenPrivilege.Privileges[0].Luid); 
  
     // Positionne le privilége shutdown pour ce process. 
   TokenPrivilege.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED; 
   AdjustTokenPrivileges(Token, False, TokenPrivilege, SizeOf(TokenPrivilege),nil, OutLen); 
  
   Error:=GetLastError; 
   If Error <> ERROR_SUCCESS 
    then Exit; 
  
     // Arrête le système 
   if ExitWindowsEx(EWX_POWEROFF, 0)=False 
      then Exit; 
   Result:=True; 
  
  finally 
   CloseHandle(Token); 
  end; 
end;
Pour rebooter un poste distant voir l'API InitiateSystemShutdownEx.

Mis à jour le 15 janvier 2014 Laurent Dardenne

Pour gérer les sessions utilisateur, Windows utilise le programme winlogon.
Celui-ci émet des notifications à des "paquets de notification" lors de différents événements.
Ces paquets de notification sont référencés dans la base de registre à la clé HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify\.

Pour être averti de l'ouverture d'une session, vous devez donc créer votre propre paquet de notification. Il consiste en une DLL exportant une procédure par notification souhaitée. Cette procédure est définie par Windows et est déclarée comme suit :

Code delphi : Sélectionner tout
1
2
3
4
procedure ProcedureDeNotification(pInfo: pWLX_NOTIFICATION_INFO);  
begin  
  //Code  
end;
où le type pWLX_NOTIFICATION_INFO est un pointeur sur le type WLX_NOTIFICATION_INFO :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
type  
  pWLX_NOTIFICATION_INFO = ^WLX_NOTIFICATION_INFO;  
  WLX_NOTIFICATION_INFO = record  
    Size: Cardinal;  
    Flags: Cardinal;  
    UserName: pWideChar;  
    Domain  : pWideChar;  
    WindowStation: pWideChar;  
    hToken  : THandle;  
    hDesktop: HDESK;  
    pStatusCallback: pointer; //Réservé pour utilisation interne  
  end;
Ce type n'étant déclaré dans aucune unité Delphi, vous aurez à le déclarer vous-mêmes dans votre DLL.

Voici une DLL et les entrées de registre à effectuer pour être notifié de l'ouverture d'une session :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
library LogonNotification;  
  
uses  
  SysUtils, Windows;  
  
{$R *.res}  
  
type  
  pWLX_NOTIFICATION_INFO = ^WLX_NOTIFICATION_INFO;  
  WLX_NOTIFICATION_INFO = record  
    Size: Cardinal;  
    Flags: Cardinal;  
    UserName: pWideChar;  
    Domain  : pWideChar;  
    WindowStation: pWideChar;  
    hToken  : THandle;  
    hDesktop: HDESK;  
    pStatusCallback: pointer; //Réservé pour utilisation interne  
  end;  
  
procedure WLEventLogon(pInfo: pWLX_NOTIFICATION_INFO); stdcall;  
var  
  F: Text;  
begin  
  if (pInfo = nil) or (pInfo^.UserName = nil) then  
    Exit;  
  
  AssignFile(F, 'events.txt');  
  
  if FileExists('events.txt') then  
    Append(F) //Création du fichier  
  else  
    Rewrite(F); //ou ajout en fin de fichier  
  
  //Ecriture de la date/heure de connexion suivie du login de session  
  Writeln(F, '[' + DateTimeToStr(Now) + ']' + ' Logon: ' + WideCharToString(pInfo^.UserName));  
  
  CloseFile(F);  
end;  
  
exports  
  WLEventLogon  name 'WLEventLogon';  
  
begin  
end.
Admettons que cette DLL est enregistrée sous "C:\TestWinlogon\LogonNotification.dll". Pour qu'elle soit prise en compte par le système, ajoutez une sous-clé à la clé HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify\, que nous nommerons pour
l'exemple "LogonNotification". Dans cette nouvelle clé, créez au minimum les valeurs suivantes :
  • Asynchronous de type REG_DWORD que vous affecterez de la valeur 0 ou 1, la valeur 1 indiquant que la fonction de votre DLL sera appelée dans un nouveau thread pour ne pas bloquer l'exécution du processus d'ouverture de session.
  • Impersonate de type REG_DWORD, que vous mettrez par défaut à 0. Référez-vous à la page MSDN donnée en lien pour des informations sur cette valeur.
  • DllName de type REG_EXPAND_SZ (Valeur de chaîne extensible) qui doit contenir le chemin complet vers votre DLL.
  • Logon de type REG_SZ (Valeur chaîne) qui doit contenir le nom de la fonction exportée de la DLL censée gérer la notification d'ouverture de session.


Dans le cas de notre exemple, DllName vaut "C:\TestWinlogon\LogonNotification.dll" et Logon vaut "WLEventLogon".

À présent, testez la DLL en vous déconnectant de votre session et en vous reconnectant ou en ouvrant la session d'un autre utilisateur : le fichier "C:\Windows\System32\events.txt" est créé et rempli des informations de connexion/déconnexion.

Si dans votre DLL vous devez ouvrir un autre progamme, utilisez l'API CreateProcessAsUser en utilisant le champ UserName de la structure fournie, sans quoi votre application ne s'ouvrira pas sur le bureau de l'utilisateur.

Les notifications possibles sont au nombre de 9. Une liste exhaustive se trouve sur cette page de la librairie MSDN.

Cette méthode ne fonctionne que pour Windows XP et Windows 2000 Professionnel.
Pour les systèmes d'exploitation antérieur, vous pouvez créer un programme qui sera appelé au démarrage de chaque session en enregistrant son chemin dans la clé HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\.

Mis à jour le 15 janvier 2014 Bestiol

L'API ExitWindows permet de terminer le session utilisateur courante sans rebooter ou arrêter Windows. Elle envoie le message WM_QUERYENDSESSION à toutes les applications pour déterminer si elle peuvent s'arrêter.

Si une application renvoie False la procédure est annulée.

Code delphi : Sélectionner tout
1
2
// Les valeurs doivent être à zéro. 
 ExitWindows(0,0)

Mis à jour le 15 janvier 2014 Laurent Dardenne

Il est possible d'obtenir de nombreuses informations sur la langue du système grâce à la fonction GetLocaleInfo de l'API Windows.
En voici un exemple qui récupère la langue de la session de l'utilisateur. Celle-ci peut être différente de celle du système d'exploitation sur les versions multilingues de Windows.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
function GetUserLanguage: string; 
var 
  sz: Integer; 
begin 
  // Le premier appel nous sert uniquement à déterminer la longueur de la chaîne 
  sz:= GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SNATIVELANGNAME, nil, 0); 
  
  // Nous modifions la chaîne de résultat pour qu'elle puisse 
  // contenir le texte complet. 
  SetLength(result, sz - 1); // - 1 car la longueur contient le zéro terminal 
  
  // Le deuxième appel nous retourne le nom de la langue dans la langue 
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SNATIVELANGNAME, 
    Pchar(result), sz); 
end;
Le paramètre LOCALE_USER_DEFAULT peut être remplacé par LOCALE_SYSTEM_DEFAULT pour obtenir la langue du système. Le paramètre LOCALE_SNATIVELANGNAME indique à la fonction que nous voulons obtenir le nom de la langue dans la langue elle-même. C'est à dire que pour la langue française, la fonction retournera "français" et pour la langue anglaise, elle retournera "english". Vous pouvez remplacer le paramètre LOCALE_SNATIVELANGNAME par de nombreux autres déclarés dans l'unité Windows.

Mis à jour le 15 janvier 2014 Pierre Castelain

En se penchant de près sur l'unité shellApi, nous pouvons découvrir les trois routines suivantes :

  1. procedure DragAcceptFiles; external shell32 name 'DragAcceptFiles';
    Procédure permettant de spécifier à une fenêtre Windows d'accepter les Drop Files.
  2. function DragQueryFile; external shell32 name 'DragQueryFileA';
    Fonction qui permet de récupérer soit le nombre de fichiers qui vont être déposés sur notre fenêtre, soit les noms de ces fichiers.
  3. procedure DragFinish; external shell32 name 'DragFinish';
    Procédure qui indique à Windows la fin d'un glisser/déposer.

Recommandations :

Vous devez dans votre unité déclarer l'unité shellApi dans la clause Uses.
Dans un nouveau projet et en mode conception, déposez un TListBox sur la fenêtre principale.
Reprenez le code ci-dessous.

Utilisation :

À l'exécution ; glissez-déposez un ou plusieurs fichiers de l'explorateur Windows vers la fenêtre de votre application.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
unit main; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  shellapi, StdCtrls ; 
  
type 
  TForm1 = class(TForm) 
    ListBox1: TListBox; 
    procedure FormCreate(Sender: TObject); 
  private 
    { Déclarations privées } 
  protected 
     procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES; 
  public 
    { Déclarations publiques } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
  
{$R *.DFM} 
  
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  //la fenêtre accepte le glissement d'objets 
  DragAcceptFiles(Handle, True); 
end; 
  
procedure TForm1.WMDropFiles(var Msg: TMessage);  
var hDeposer: THandle;  
    countFiles, i: integer;  
    FileName: Array[0..255]Of Char;  
begin  
  
  //Récupérer dans hDeposer le handle envoyé par le message WM_DROPFILES  
  hDeposer := THandle(Msg.wParam);  
  
  //Compter le nombre de fichiers déposés.  
  countFiles := DragQueryFile(hDeposer, UINT(-1), nil, 0);  
  
  for i := 0 to pred(countFiles) do  
  begin  
    //Déterminer le nom du ième fichier déposé  
    DragQueryFile(hDeposer, i, FileName, 255);  
  
    //Ajouter le nom du fichier dans le listbox 
    ListBox1.Items.Add(FileName);  
  end;  
  
  //Indiquer à Windows la fin du déposer  
  DragFinish(hDeposer);  
end;  
  
end.

Le code suivant permet aux anciennes versions de Delphi d'ajouter, pour les versions de Windows postérieures à XP, les messages à écouter :

Code Delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
var 
  ChangeWindowMessageFilter : function(Msg: uint; dwFlag : dword):BOOL; stdcall; 
const 
  MSGFLT_ADD = 1; 
  WM_COPYGLOBALDATA = $49; 
  
procedure TForm1.Button1Click(Sender: TObject); 
var 
  lbrHandle: THandle; 
begin 
  lbrHandle := SafeLoadLibrary('User32.dll'); 
 if lbrHandle <> 0 then 
 try 
   ChangeWindowMessageFilter := GetProcAddress(lbrHandle, 'ChangeWindowMessageFilter'); 
   if Assigned(ChangeWindowMessageFilter) then begin 
     ChangeWindowMessageFilter(WM_DROPFILES, MSGFLT_ADD); 
     ChangeWindowMessageFilter(WM_COPYGLOBALDATA, MSGFLT_ADD); 
   end; 
 finally 
   FreeLibrary(lbrHandle); 
 end; 
end;
Ne déclarez pas cette fonction comme statique si votre application doit encore supporter Windows XP.

Mis à jour le 15 janvier 2014 Andnotor Cirec Pascal Jankowski

Sur certaines machines dotées de processeur Intel le problème lié à l'HyperThreading peut provoquer l'erreur 216.
Pour rappel l'hyperthreading correspond schématiquement à une 'simulation de processeur'. On peut visualiser ce type de processeur dans le gestionnaire de tâches par la présence de 2 processeurs alors que la carte mère n'est équipée que d'un seul processeur.

Le symptôme est le suivant, l'application fonctionne correctement sur la majorité du parc mais pas sur quelques unes récentes où son exécution déclenche l'erreur 216.

Comment résoudre ce problème ?

Si vous utilisez la JVCL inférieure à la version 3 (le problème semble corrigé depuis la version 1.9) la solution proposée sur le forum par fusef est la suivante :
Le problème se situe dans la fonction GetCPUSpeed. Un processeur trop rapide (plus que 3Ghz) provoque une division par 0. Il s'agit de remplacer la procédure GetCPUSpeed de l'unité JclSysInfo.pas par le code suivant :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
function GetCPUSpeed(var CpuSpeed: TFreqInfo): Boolean;  
{$IFDEF LINUX}  
begin  
   Result := False;  
end;  
{$ENDIF LINUX}  
{$IFDEF MSWINDOWS}  
var  
   T0, T1: Int64;  
   CountFreq: Int64;  
   Freq, Freq2, Freq3, Total: Int64;  
   TotalCycles, Cycles: Int64;  
   Stamp0, Stamp1: Int64;  
   TotalTicks, Ticks: Double;  
   Tries, Priority: Integer;  
   Thread: THandle;  
begin  
   Stamp0 := 0;  
   Stamp1 := 0;  
   Freq  := 0;  
   Freq2 := 0;  
   Freq3 := 0;  
   Tries := 0;  
   TotalCycles := 0;  
   TotalTicks := 0;  
   Total := 0;  
  
   Thread := GetCurrentThread();  
   Result := QueryPerformanceFrequency(CountFreq);  
   if Result then  
   begin  
     while ((Tries < 3 ) or ((Tries < 20) and ((Abs(3 * Freq - Total) >  
3) or  
       (Abs(3 * Freq2 - Total) > 3) or (Abs(3 * Freq3 - Total) > 3)))) do  
     begin  
       Inc(Tries);  
       Freq3 := Freq2;  
       Freq2 := Freq;  
       QueryPerformanceCounter(T0);  
       T1 := T0;  
  
       Priority := GetThreadPriority(Thread);  
       if Priority <> THREAD_PRIORITY_ERROR_RETURN then  
         SetThreadPriority(Thread, THREAD_PRIORITY_TIME_CRITICAL);  
       try  
         while T1 - T0 < 50 do  
         begin  
           QueryPerformanceCounter(T1);  
           Stamp0 := ReadTimeStampCounter;  
         end;  
         T0 := T1;  
  
         while T1 - T0 < 1000 do  
         begin  
           QueryPerformanceCounter(T1);  
           Stamp1 := ReadTimeStampCounter;  
         end;  
       finally  
         if Priority <> THREAD_PRIORITY_ERROR_RETURN then  
           SetThreadPriority(Thread, Priority);  
       end;  
  
       Cycles := Stamp1 - Stamp0;  
       Ticks := T1 - T0;  
       Ticks := Ticks * 100000;  
  
       // avoid division by zero  
       if CountFreq = 0 then  
         Ticks := High(Int64)  
       else  
         Ticks := Ticks / (CountFreq / 10);  
  
       TotalTicks := TotalTicks + Ticks;  
       TotalCycles := TotalCycles + Cycles;  
  
       // avoid division by zero  
       if Ticks = 0 then  
         Freq := High(Freq)  
       else  
         Freq := Round(Cycles / Ticks);  
  
       Total := Freq + Freq2 + Freq3;  
     end;  
  
     // avoid division by zero  
     if TotalTicks = 0 then  
     begin  
       Freq3 := High(Freq3);  
       Freq2 := High(Freq2);  
       CpuSpeed.RawFreq := High(CpuSpeed.RawFreq);  
     end  
     else  
     begin  
       Freq3 := Round((TotalCycles *  10) / TotalTicks); // freq. in  
multiples of 10^5 Hz  
       Freq2 := Round((TotalCycles * 100) / TotalTicks); // freq. in  
multiples of 10^4 Hz  
       CpuSpeed.RawFreq := Round(TotalCycles / TotalTicks);  
     end;  
  
     CpuSpeed.NormFreq := CpuSpeed.RawFreq;  
  
     if Freq2 - (Freq3 * 10) >= 6 then  
       Inc(Freq3);  
  
  
     Freq := CpuSpeed.RawFreq * 10;  
     if (Freq3 - Freq) >= 6 then  
       Inc(CpuSpeed.NormFreq);  
  
     CpuSpeed.ExTicks := Round(TotalTicks);  
     CpuSpeed.InCycles := TotalCycles;  
  
     CpuSpeed.NormFreq := RoundFrequency(CpuSpeed.NormFreq);  
     Result := True;  
   end;  
end;  
{$ENDIF MSWINDOWS}
Cette solution a été préconisée par M. Obones, développeur de la jvcl.

Sinon :
  • Vérifiez si le code de démonstration de tri de Delphi, utilisant des thread, fonctionne.
  • Si le problème persiste assurez vous que le problème ne vient pas de votre code.
  • Testez en désactivant l'Hyperthreading dans le BIOS de la machine.
  • Essayez ce fix de Microsoft

Mis à jour le 15 janvier 2014 Laurent Dardenne

L'unité SysUtils met à notre disposition la variable CurrencyString qui nous permet de connaître le symbole monétaire courant. La valeur initiale de cette variable est recupérée du registre à l'aide de la fonction GetLocaleInfo. En fouillant dans l'unité SysUtils, on retrouve ceci :

Code delphi : Sélectionner tout
CurrencyString := GetLocaleStr(DefaultLCID, LOCALE_SCURRENCY, '');
CurrencyString est une chaîne de charactère; on peut donc par exemple informer l'utilisateur du symbole monétaire courant par une boite de dialogue simple. Par exemple, dans le OnClick d'un bouton, on peut écrire :
Code delphi : Sélectionner tout
ShowMessage('Le symbole monétaire courant est ' + CurrencyString);
Cette variable est utilisée lors des conversions de type flottant à décimal.

Mis à jour le 15 janvier 2014 Pierre Castelain

La fonction LockWorkStation déclarée dans l'unité Windows permet de simuler la combinaison de touches [Ctrl+Alt+Suppr].

Attention cette fonction n'est valable que pour Windows 2000 Pro/Server, XP, Server 2003. Il donc préférable de tester la version de Windows avant l'appel.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Program Lock; 
  
{$APPTYPE CONSOLE} 
  
uses 
  Windows; 
begin 
  // Windows 2000 et supérieure 
  if Win32MajorVersion >= 5  then //test de la version de Windows 
   if Not LockWorkStation 
    then Writeln('Impossible de verrouiller le poste de travail') 
     // Call GetlastError pour plus d'information sur la cause de l'erreur 
    else 
  else Writeln('Nécessite la version Windows 2000 ou supérieure') 
end.
Pour les versions plus anciennes de Delphi, déclarez, dans la partie implementation, la fonction de la manière suivante :
Code delphi : Sélectionner tout
Function LockWorkStation:Bool; External 'User32.dll';
Un autre approche consiste à réunir, au sein d'une fonction, les tests de la version de Windows et l'appel du verrouillage :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Function SecuredLockWorkStation : Boolean ; 
{ 
Demande un verrouillage de la station. 
Renvoie TRUE si le verrouillage a été déclenché. 
Renvoie FALSE si l'OS ne supporte pas la fonction, ou si le verrouillage est  
impossible. 
} 
Type 
    PLockFunction = Function : Cardinal ; stdcall ; 
Var 
   HDLL : THandle       ; 
   Lock : PLockFunction ; 
Begin 
     Result:=False; 
     If Win32Platform=VER_PLATFORM_WIN32_NT Then 
        Begin 
        HDLL:=LoadLibrary('USER32.DLL'); 
        If (HDLL<>0) Then 
           Begin 
           @Lock:=GetProcAddress(HDLL,'LockWorkStation'); 
           If Assigned(@Lock) Then 
              Result:=(Lock<>0) ; 
           FreeLibrary(HDLL); 
           End; 
        End; 
End ;

Mis à jour le 15 janvier 2014 Laurent Dardenne Mac LAK

Le format CF_HDROP du presse papier, permet de spécifier ce type de document.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
uses  
  ClipBrd, ShlObj;  
  
procedure CopyFilesToClipboard(Filenames: TStrings);  
var  
  i, len: Integer;  
  hMem: THandle;  
  ptr: PByte;  
  dropfiles: PDropFiles;  
begin  
  // On commence par récupérer la longueur totale de la "liste" de chaînes  
  len:= 0;  
  for i:= 0 to Filenames.Count - 1 do  
    Inc(len, Length(Filenames[i]) + 1);  
  
  if len <> 0 then  
  begin  
    Inc(len); // Ajout d'un octet pour le zéro terminal  
  
    // Allocation d'un buffer pour la structure _DROPFILES + la chaîne complète  
    hMem:= GlobalAlloc(GMEM_MOVEABLE, SizeOf(_DROPFILES) + len);  
    dropFiles:= GlobalLock(hMem);  
  
    dropFiles.pFiles:= SizeOf(_DROPFILES);  
    dropFiles.pt:= Point(0, 0);  
    dropFiles.fNC:= false;  
    dropFiles.fWide:= false;  
  
    // On positionne un pointeur juste après la structure  
    ptr:= Pointer(Integer(dropFiles) + SizeOf(_DROPFILES));  
  
    // Et on copie les chemins en les séparant par des zéros  
    for i:= 0 to Filenames.Count - 1 do  
    begin  
      Move(Filenames[i][1], ptr^, Length(Filenames[i]));  
      Inc(Integer(ptr), Length(Filenames[i]));  
      ptr^:= 0;  
      Inc(Integer(ptr));  
    end;  
    // La "liste" de chaînes doit être terminée par un autre zéro  
    ptr^:= 0;  
    // On a donc : StructureChemin1#0Chemin2#0#0  
  
    // Ne pas oublier de déverrouiller la zone mémoire  
    GlobalUnlock(hMem);  
  
    // Il ne reste plus qu'à injecter ça dans le presse-papier  
    with ClipBoard do  
    begin  
      Open;  
      Clear;  
      SetAsHandle(CF_HDROP, hMem);  
      Close  
    end;  
  end;  
  
  // Remarque : la zone allouée n'est pas libérée car elle est maintenant  
  // gérée par le presse-papier. C'est un des rares cas où il ne faut pas  
  // libérer ce que l'on a créé.  
end;  
  
procedure Test;  
var  
  sl: TStringList;  
begin  
  sl:= TStringList.Create;  
  sl.Add('c:\autoexec.bat');  
  sl.Add(Application.Exename);  
  CopyFilesToClipboard(sl);  
  sl.Free;  
end;

Mis à jour le 15 janvier 2014 Pierre Castelain

Cela est possible sous Windows en utilisant la Tool Help Library. Sous ce nom se cachent quelques fonctions qui permettent d'obtenir des informations sur les applications en cours d'exécution.

Pour lister les processus actifs, la première étape est de prendre un "instantané" ( Snapshot) de l'état actuel du système, ceci grâce à la fonction CreateToolhelp32Snapshot.
Ensuite, grâce aux deux fonctions Process32First et Process32Next, on parcourt cet instantané pour y récupérer les informations des processus en cours d'exécution.

La procédure suivante affiche le nom de chaque processus en cours d'exécution dans une ListBox passée en paramètre :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
procedure ListerProcessus(ListBox: TCustomListBox); 
var 
  SnapShot: Cardinal; 
  ProcessEntry: TProcessEntry32; 
begin 
  //Création de "l'instantané" 
  SnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); 
  
  //En cas d'erreur on sort 
  If SnapShot = 0 then Exit; 
  
  ProcessEntry.dwSize := SizeOf(ProcessEntry); 
  
  //Lecture du premier processus de la liste 
  If Process32First(SnapShot, ProcessEntry) then 
  begin 
    ListBox.Items.Add(ProcessEntry.szExeFile); 
  
    //Tant qu'il reste un processus, ajouter son nom à la liste 
    while Process32Next(SnapShot, ProcessEntry) do 
      ListBox.Items.Add(ProcessEntry.szExeFile); 
  end; 
  
  //Libération de l'instantané 
  CloseHandle(SnapShot); 
  
end;
Dans ce code, l'appel à CreateToolhelp32Snapshot se fait en passant le flag TH32CS_SNAPPROCESS pour indiquer que l'ont veut récupérer la liste des processus actifs et les informations qui les concernent.

Les appels à Process32First et à Process32Next se font en passant l'identifiant de l'instantané créé, et une structure TProcessEntry32 qui contiendra les informations du processus.

Ces informations sont diverses (liste non exhaustive, référez-vous à l'aide pour plus de détails) :
  • th32ProcessID : Identificateur du processus
  • th32ModuleID : Identificateur du module pour le process (utilisable uniquement avec les fonctions de la Tool Help Library)
  • cntThreads : nombre de threads d'exécution créés par le process
  • th32ParentProcessID : Identificateur du processus qui a créé ce processus
  • pcPriClassBase : Priorité de base pour les threads créés par ce processus
  • szExeFile : Nom de fichier de l'exécutable

Mis à jour le 15 janvier 2014 Bestiol

Cela est possible sous Windows en utilisant la Tool Help Library. Sous ce nom se cachent quelques fonctions qui permettent d'obtenir des informations sur les applications en cours d'exécution.

Pour lister les threads d'un processus, la première étape est de prendre un "instantané" ( Snapshot) de l'état actuel du système, ceci grâce à la fonction CreateToolhelp32Snapshot.
Ensuite, grâce aux deux fonctions Thread32First et Thread32Next, on parcourt cet instantané pour y récupérer les informations des threads actuellement ouverts sur le système.
Un champ nous renseigne le ProcessId du processus auquel chaque thread appartient. Il n'y a qu'à comparer cette valeur au ProcessId du processus voulu pour identifier chacun de ses threads.

La procédure suivante affiche l'identificateur de chaque thread du processus en cours :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
procedure ListerModules(ListBox: TCustomListBox); 
var 
  SnapShot: Cardinal; 
  ThreadEntry: TThreadEntry32; 
begin 
  //Création de "l'instantané" 
  SnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, GetCurrentProcessId); 
  
  //En cas d'erreur on sort 
  If SnapShot = 0 then Exit; 
  
  ThreadEntry.dwSize := SizeOf(ThreadEntry); 
  
  //Lecture du premier thread de la liste 
  If Thread32First(SnapShot, ThreadEntry) then 
  begin 
    //On n'ajoute que si le thread appartient à notre process 
    If ThreadEntry.th32OwnerProcessID = GetCurrentProcessID then 
      ListBox.Items.Add('Thread ID : ' + IntToStr(ThreadEntry.th32ThreadID)); 
  
    //Tant qu'il reste un thread, ajouter son nom à la liste 
    While Thread32Next(SnapShot, ThreadEntry) do 
      If ThreadEntry.th32OwnerProcessID = GetCurrentProcessID then 
        ListBox.Items.Add('Thread ID : ' + IntToStr(ThreadEntry.th32ThreadID)); 
  end; 
  
  //Libération de l'instantané 
  CloseHandle(SnapShot); 
  
end;
Dans ce code, l'appel à CreateToolhelp32Snapshot se fait en passant le flag TH32CS_SNAPTHREAD pour indiquer que l'on veut récupérer la liste des threads du système.

Les appels à Thread32First et à Thread32Next se font en passant l'identifiant de l'instantané créé, et une structure TThreadEntry32 qui contiendra les informations de chaque thread.

Ces informations sont diverses :
  • cntUsage : Nombre de références au thread
  • th32ThreadID : Identificateur du thread
  • th32OwnerProcessID : Identificateur du processus propriétaire du thread
  • tpBasePri : Priorité initiale assignée au thread
  • tpDeltaPri : Modification relative de la priorité du thread par rapport à tpBasePri

Si vous souhaitez lister les threads d'un autre processus, il vous faut son ProcessId. La liste des processus actifs et leur ProcessId peut-être récupérée grâce à la même méthode : voyez Comment lister les processus actifs ?

Mis à jour le 15 janvier 2014 Bestiol

Cela est possible sous Windows en utilisant la Tool Help Library. Sous ce nom se cachent quelques fonctions qui permettent d'obtenir des informations sur les applications en cours d'exécution.

Pour lister les modules d'un processus, la première étape est de prendre un "instantané" ( Snapshot) de l'état actuel d'un processus en particulier, ceci grâce à la fonction CreateToolhelp32Snapshot.
Ensuite, grâce aux deux fonctions Module32First et Module32Next, on parcourt cet instantané pour y récupérer les informations des modules du processus choisi.

La procédure suivante affiche le nom de chaque module du processus en cours, avec son chemin d'accès entre parenthèses :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
procedure ListerModules(ListBox: TCustomListBox); 
var 
  SnapShot: Cardinal; 
  ModuleEntry: TModuleEntry32; 
begin 
  //Création de "l'instantané" 
  SnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, GetCurrentProcessId); 
  
  //En cas d'erreur on sort 
  If SnapShot = 0 then Exit; 
  
  ModuleEntry.dwSize := SizeOf(ModuleEntry); 
  
  //Lecture du premier module de la liste 
  If Module32First(SnapShot, ModuleEntry) then 
  begin 
    ListBox.Items.Add(ModuleEntry.szModule + ' (' + ModuleEntry.szExePath + ')'); 
  
    //Tant qu'il reste un module, ajouter son nom à la liste 
    While Module32Next(SnapShot, ModuleEntry) do 
      ListBox.Items.Add(ModuleEntry.szModule + ' (' + ModuleEntry.szExePath + ')'); 
  end; 
  
  //Libération de l'instantané 
  CloseHandle(SnapShot); 
  
end;
Dans ce code, l'appel à CreateToolhelp32Snapshot se fait en passant le flag TH32CS_SNAPMODULE pour indiquer que l'ont veut récupérer la liste des modules chargés par le processus identifié par le second paramètre (ici le processus en cours).

Les appels à Module32First et à Module32Next se font en passant l'identifiant de l'instantané créé, et une structure TModuleEntry32 qui contiendra les informations de chaque module.

Ces informations sont diverses :
  • th32ModuleID : Identificateur du module
  • th32ProcessID : Identificateur du processus
  • GlblcntUsage : Nombre d'utilisations global du module
  • ProccntUsage : Nombre d'utilisations dans le contexte du processus propriétaire
  • modBaseAddr : Adresse de base du module dans le contexte du processus propriétaire
  • modBaseSize : Taille en octets du module
  • hModule : Handle du module dans le contexte du processus propriéaire
  • szModule : Nom du module
  • szExePath : Chemin de fichier du module

Si vous souhaitez lister les modules d'un autre processus, il vous faut son ProcessId. La liste des processus actifs et leur ProcessId peut-être récupérée grâce à la même méthode : voyez Comment lister les processus actifs ?

Mis à jour le 15 janvier 2014 Bestiol

Cet exemple fait appel à trois fiches. La première, Form1 ne sert qu'à l'appel des deux autres via deux boutons.

La fiche Form2 comme la fiche Form3 comporte un label.
En provoquant un glisser-déplacer du label de la fiche Form2 vers le label de la fiche Form3, on attribue à ce dernier les propriétés Caption, Font et Color du label de la fiche Form2.
De plus la fiche Form3, prend alors la focalisation.

L'unité Unit2 possède le gestionnaire d'événement OnMouseDown qui autorise le commencement du drag & drop si c'est le bouton gauche de la souris qui a été enfoncé en survolant le label.

L'unité Unit3 implémente les gestionnaires des événements OnDragOver et OnDragDrop pour le contrôle Label.
Le premier positionne le booléen Accept à TRUE si le bouton de la souris est relâché sur le label de la fiche Form3.
Le deuxième réalise les attributions de propriétés et provoque la prise de focalisation de la fiche Form3.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
//------------------------------------------------------------------------------ 
program DD; 
//------------------------------------------------------------------------------ 
  
uses 
  Forms, 
  DragDrop in 'DragDrop.pas' {Form1}, 
  Unit2 in 'Unit2.pas' {Form2}, 
  Unit3 in 'Unit3.pas' {Form3};  
{$R *.res}      
begin 
  Application.Initialize; 
  Application.CreateForm(TForm1, Form1); 
  Application.CreateForm(TForm2, Form2); 
  Application.CreateForm(TForm3, Form3); 
  Application.Run; 
end. 
  
//------------------------------------------------------------------------------ 
unit DragDrop; 
//------------------------------------------------------------------------------ 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, Unit2, Unit3;     
type 
  TForm1 = class(TForm) 
    Button2: TButton; 
    Button3: TButton; 
    procedure Button2Click(Sender: TObject); 
    procedure Button3Click(Sender: TObject); 
  end;    
var 
  Form1: TForm1; 
  
implementation 
  
{$R *.dfm} 
//______________________________________________________________________________ 
// 
//       B U T T O N   2    C L I C K 
// 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Form2.Show;    {appeler la fiche 2 en mode non modal} 
end;  // Button2Click 
//______________________________________________________________________________ 
// 
//       B U T T O N   3   C L I C K 
// 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  Form3.Show ;   {appeler la fiche 3 en mode non modal} 
end; //Button3Click   
end. 
  
//------------------------------------------------------------------------------ 
unit Unit2; 
//------------------------------------------------------------------------------ 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls;    
type 
  TForm2 = class(TForm) 
    Label1: TLabel; 
    procedure Label1MouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
  end;   
var 
  Form2: TForm2; 
  
implementation 
  
{$R *.dfm} 
//______________________________________________________________________________ 
// 
//       L A B E L 1     M O U S E    D O W N 
// 
procedure TForm2.Label1MouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if Button = mbLeft then     { ne glisser que si le bouton gauche est enfoncé } 
    with Sender as TLabel do  { traiter Sender comme TLabel } 
       BeginDrag(False);      { si tel est le cas, le faire glisser } 
end; // Label1MouseDown      
end. 
  
//------------------------------------------------------------------------------ 
unit Unit3; 
//------------------------------------------------------------------------------ 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
type 
  TForm3 = class(TForm) 
    Label1: TLabel; 
    procedure Label1DragOver(Sender, Source: TObject; X, Y: Integer;  
    State: TDragState; var Accept: Boolean); 
    procedure Label1DragDrop(Sender, Source: TObject; X, Y: Integer); 
  end;   
var 
  Form3: TForm3; 
  
implementation 
  
{$R *.dfm}    
//______________________________________________________________________________ 
// 
//       L A B E L 1     D R A G    O V E R 
// 
procedure TForm3.Label1DragOver(Sender, Source: TObject; X, Y: Integer; 
  State: TDragState; var Accept: Boolean); 
begin 
  if Source is TLabel then Accept := True 
  else Accept := False; 
end; // Label1DragOver       
//______________________________________________________________________________ 
// 
//       L A B E L 1     D R A G    D R O P 
// 
procedure TForm3.Label1DragDrop(Sender, Source: TObject; X, Y: Integer); 
begin 
  if (Sender is TLabel) and (Source is TLabel) then begin 
    with (Sender as TLabel) do begin 
      Caption := (Source as TLabel).Caption;  {le Label de la fiche 3 devient } 
      Font    := (Source as TLabel).Font;     {identique à celui de la fiche 2} 
      Color   := (Source as TLabel).Color; 
    end; 
  
    SetFocus;                      {et en plus la fiche 3 prend la focalisation} 
  end; 
end;  // Label1DragDrop      
end.

Mis à jour le 15 janvier 2014 jcs2

La fonction GetTempPath de l'unité Windows permet de retrouver le chemin temporaire utilisé par Windows.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
uses Windows 
  
// il y a '\' à la fin (par ex : C:\temp\) 
function RepertoireTemporaireWindows: String; 
var 
  lpBuffer : array[0..255] of char; 
begin 
  GetTempPath(SizeOf (lpBuffer), lpBuffer); 
  result := lpBuffer; 
end;

Mis à jour le 15 janvier 2014 Keke des Iles

Certaines variables, récupérées par l'API GetEnvironmentVariable, peuvent être paramétrées, c'est à dire qu'elles peuvent être au format %Systemroot%\Temp.
Dans ce cas l'appel à l'API ExpandEnvironmentStrings est nécessaire. Elle développe les variables d'environnement et les remplace avec les valeurs définies pour l'utilisateur courant.
Cette API est aussi utilisée avec les clés de registre de type REG_EXPAND_SZ. Par exemple la clé de registre suivante :

Code other : Sélectionner tout
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders
contient la valeur :
Code other : Sélectionner tout
%ALLUSERSPROFILE%\Documents
Pour obtenir et développer le nom complet vous devez appeler ExpandEnvironmentStrings.

Voici un exemple :
Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
function ExpandCurrentProcessEnvVar(const Contenu: string): string;  
// Type d'appel : Writeln(ExpandCurrentProcessEnvVar(MaVariable));  
var  
  nSize: DWord;  
begin  
  Result:= '';  
  nSize:= 0;  
  nSize:=ExpandEnvironmentStrings(PChar(Contenu), Nil, nSize);  
     // Si AnsiString -1 si String Unicode -2  
  SetLength(Result, nSize - 2);  
  if ExpandEnvironmentStrings(PChar(Contenu), PChar(Result), nSize)=0  
     then raise Exception.Create(SysErrorMessage(GetlastError))  
end;
Note : La taille renvoyée dépend du type de chaine utilisé, voir le SDK pour plus de détails.

Mis à jour le 17 janvier 2014 Laurent Dardenne

L'API GetEnvironmentVariable permet, en spécifiant le nom de la variable, de récupérer le contenu d'une variable d'environnement système.

Voici un exemple pour récupérer le contenu de Temp qui contient le répertoire temporaire de la session :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
function GetCurrentProcessEnvVar(const VariableName: string): string;  
// Type d'appel : Writeln(GetCurrentProcessEnvVar('TEMP'));  
var  
  nSize: DWord;  
begin  
  Result:= '';  
  nSize:= 0;  
  nSize:= GetEnvironmentVariable(PChar(VariableName), Nil, nSize);  
  if nSize > 0 then  
  begin  
    SetLength(Resultat, nSize - 1);  
    if GetEnvironmentVariable(PChar(VariableName), PChar(Result), nSize)=0  
     then raise Exception.Create(SysErrorMessage(GetlastError))  
  end;  
end;

Mis à jour le 17 janvier 2014 Laurent Dardenne Pedro

Dans l'unité UxTheme, se trouve une fonction UseThemes qui retourne un booléen indiquant si les thèmes sont activés ou non.

Pour les versions de Delphi n'ayant pas cette unité, il reste toujours possible de savoir si les thèmes sont activés ou non en consultant la valeur ThemeActive de la clé du registre HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager qui vaut 1 si actif et 0 si non.

Mis à jour le 15 janvier 2014 portu

C'est très simple, il suffit de surcharger la méthode WndProc de la fiche principale.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
TForm1=class(TForm) 
  ... 
public 
  ... 
  procedure WndProc(var Msg: TMessage); override; 
  ... 
end; 
  
... 
  
procedure TForm1.WndProc(var Msg: TMessage); 
begin 
  inherited; 
  if Msg.Msg = WM_THEMECHANGED then 
  begin 
    ShowMessage('Le thème a changé !'); 
  end; 
end; 
end;

Mis à jour le 15 janvier 2014 delphichem

Dans certaines fonctions de l'API Windows, il est parfois demandé de fournir un LANGID.
Le paramètre correspondant à un tel ID est souvent appelé wLanguage.

Ce LANGID, ou identificateur de langue est un Word (entier non signé de 2 octets) composé d'un Primary Language ID, nombre décrivant une langue (Français, Anglais, Allemand…), et d'un SubLanguage ID, nombre décrivant la variante de la langue concernée (Suisse/Belge/Canadien, UK/US/Australie etc.).

Selon la MSDN, un LANGID est construit comme suit :

Code other : Sélectionner tout
1
2
3
4
+-------------------------+-------------------------+ 
|     SubLanguage ID      |   Primary Language ID   | 
+-------------------------+-------------------------+ 
15                    10  9                         0   bit
Les 10 bits de poids faible représentent la langue, et les 6 bits de poids fort sa variante.
Pour le langage C++, Microsoft fournit une macro nommée MAKELANGID pour générer un LANGID à partir de l'identificateur de la langue et de sa variante. Cette macro n'a pas été réimplémentée dans Delphi, et il faut donc l'implémenter nous-même :
Code delphi : Sélectionner tout
1
2
3
4
function MakeLangId(LangId, SubLangId: Byte): Word; 
begin 
  Result := (SubLangId shl 10) or LangId; 
end
Dans Windows.pas sont définies les constantes de langues et de leurs variantes. Un exemple d'utilisation de MakeLangId serait :
Code delphi : Sélectionner tout
LangId := MakeLangId(LANG_FRENCH, SUBLANG_FRENCH);
Pour obtenir la liste des LANG_* et SUBLANG_* disponibles, référez-vous à la MSDN.

Mis à jour le 16 janvier 2014 Bestiol

Le programme suivant inclut une procédure qui permet d'arrêter un processus à partir de son nom.

La chaîne passée à la procédure doit être formée du nom et de l'extension du fichier exécutable, sans son chemin.

Code : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
program KillTask; 
 
uses 
  SysUtils, Windows, TlHelp32; 
 
procedure MyKillTask(ExeFileName: string); 
const 
  PROCESS_TERMINATE = $0001; 
var 
  ContinueLoop: Boolean; 
  FSnapshotHandle: THandle; 
  FProcessEntry32: TProcessEntry32; 
begin 
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); 
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32); 
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); 
  while ContinueLoop do 
  begin 
    if (UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) 
    or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName)) then 
      TerminateProcess(OpenProcess(PROCESS_TERMINATE, False, FProcessEntry32.th32ProcessID), 0); 
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); 
  end; 
  CloseHandle(FSnapshotHandle); 
end; 
 
begin 
  if ParamCount = 1 then 
    MyKillTask(ExtractFileName(ParamStr(1))); 
end.
Le programme proposé en exemple reçoit en paramètre le nom du processus à arrêter, y compris éventuellement son chemin.

On peut utiliser le programme en faisant glisser sur son icône, au moyen de la souris, l'icône de l'application dont on veut interrompre l'exécution.

Mis à jour le 30 mars 2014 Roland Chastain Sub0


Voici une fonction permettant d'obtenir la cible d'un raccourci de type LNK :

Code : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
type 
  TSLTShellLink = class(TObject) 
  public 
    class function ExtractTarget(const AShellLinkFileName: TFileName): TFileName; 
  end; 
 
{ TSLTShellLink } 
 
class function TSLTShellLink.ExtractTarget(const AShellLinkFileName: TFileName): TFileName; 
const 
  IID_IPersistFile: TGUID = '{0000010B-0000-0000-C000-000000000046}'; 
var 
  LResult: HRESULT; 
  LSHellLink: IShellLink; 
  LPersistFile: IPersistFile; 
  LFindData: TWin32FindData; 
  FileName: array[0..MAX_PATH - 1] of Char; 
begin 
  Result := ''; 
  LResult := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IID_IShellLinkW, LShellLink); 
  if LResult = S_OK then 
  begin 
    if Supports(LShellLink, IID_IPersistFile, LPersistFile) then 
    begin 
      LResult := LPersistFile.Load(PChar(AShellLinkFileName), STGM_READ); 
      if LResult = S_OK then 
      begin 
        LResult := LSHellLink.GetPath(FileName, MAX_PATH, LFindData, SLGP_UNCPRIORITY); 
        if LResult = S_OK then 
          Result := Trim(FileName); 
      end; 
    end; 
  end; 
end;

Les unités suivantes sont requises :

Code : Sélectionner tout
  Winapi.Windows, Winapi.ShellApi, Winapi.ShlObj, Winapi.Messages, Winapi.ActiveX,

La fonction sera appelée de la façon suivante :

Code : Sélectionner tout
1
2
3
4
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Caption := TSLTShellLink.ExtractTarget('C:\Users\xxx\Desktop\Delphi XE2.lnk'); 
end;

Mis à jour le 7 décembre 2015 Roland Chastain ShaiLeTroll

Le gestionnaire de mémoire de Delphi permet de savoir si votre programme libère bien toute la mémoire que vous avez allouée. Il suffit d'ajouter à votre programme ReportMemoryLeaksOnShutdown := true;, ou ReportMemoryLeaksOnShutdown := DebugHook <> 0; pour n'activer cette fonctionnalité qu'en débogage.

Voici un exemple permettant d'expérimenter le fonctionnement du gestionnaire de mémoire.

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
unit Unit1; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
  
type 
  PRec = ^Rec; 
  
  Rec = record 
    A,B : integer; 
  end; 
  
  TObjetInterne = class(TObject) 
  end; 
  
  TObjetPrincipal = class(TObject) 
  public 
    FObjetInterne : TObjetInterne; 
    FRec : PRec ; 
    constructor Create; 
    destructor  Destroy; override; 
  end; 
  
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
  private 
    { Déclarations privées } 
  public 
    { Déclarations publiques } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
  
{$R *.dfm} 
{ TObjetPrincipal } 
constructor TObjetPrincipal.Create; 
begin 
   inherited; 
   FObjetInterne := TObjetInterne.Create; 
   New(FRec); 
end; 
  
destructor TObjetPrincipal.Destroy; 
begin 
  FObjetInterne.Free; 
  Dispose(FRec); 
  inherited; 
end; 
  
procedure TForm1.Button1Click(Sender: TObject); 
var ObjetPrincipal : TObjetPrincipal; ptr : Pointer; 
begin 
   ReportMemoryLeaksOnShutdown := DebugHook <> 0 ; 
   ObjetPrincipal := TObjetPrincipal.Create; 
   ptr := AllocMem(10000); 
end; 
  
end.

En cliquant quatre fois sur le bouton puis en fermant l'application, on obtient le message suivant :

Mis à jour le 11 mars 2014 gb_68 Roland Chastain

Le composant TTrayIcon permet un affichage de votre écran dans la barre des tâches quand vous allez le réduire. Il suffit de le poser sur votre projet et de lui affecter un PopupMenu pour l'utiliser.
Pour pousser un peu plus et obtenir quelque chose de plus esthétique, il est possible d'ouvrir une TForm à la place du menu.

Lors du clic sur le bouton pour réduire l'application, il faut cacher l'écran et afficher l'icône dans la barre des tâches :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
procedure TPrincipal.ReduireApplication; 
begin 
   // on cache la fenêtre et on la minimise	 
   Self.Hide; 
   WindowState      := wsMinimized; 
   // affichage de l'icône dans la barre des tâches 
   TrayIcon.Visible := True; 
end;


Le TTrayIcon contient plusieurs événements dont un OnMouseDown, celui ci est intéressant car il donne le bouton utilisé lors du clic ainsi que la position de la souris.

Supposons que la fenêtre qui doit s'ouvrir à la place du menu s'appelle FFormTrayIcon avec un FormStyle fsStayOnTop. Elle est créée dans l’événement FormCreate de la fenêtre principale et libérée dans le FormCloseQuery.

Lors du clic sur l'icône de la barre des tâches :

Code delphi : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
procedure TPrincipal.TrayIconMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
   // lors du clic avec le bouton gauche de la souris 
   // on va revenir sur notre écran principal    
   if Button = mbLeft then 
   begin 
      // on masque la fenêtre ouverte avec le TrayIcon  
      FFormTrayIcon.Hide; 
	  // il faut enlever l'icône de la barre des tâches 
	  TrayIcon.Visible := False; 
	  // et afficher notre fenêtre 
      WindowState      := wsNormal; 
      Self.Show; 
      Self.BringToFront; 
   end 
   // sinon on affiche notre fenêtre qui fait office de menu 
   else 
   begin	 
	  // gestion de la position pour que l'écran s'ouvre 
	  // à côté de la souris de l'utilisateur 
      FFormTrayIcon.Left := X - FFormTrayMenu.Width; 
      FFormTrayIcon.Top  := Y - FFormTrayMenu.Height - 10; // marge de 10px 
	  // affichage en premier plan 
      FFormTrayIcon.Show; 
      FFormTrayIcon.BringToFront; 
   end; 
end;

Mis à jour le 28 novembre 2016 retwas

Proposer une nouvelle réponse sur la FAQ

Ce n'est pas l'endroit pour poser des questions, allez plutôt sur le forum de la rubrique pour ça


Réponse à la question

Liens sous la question
précédent sommaire suivant
 

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2024 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.