Récupérer le nom d'utilisateur d'un pc connecté en réseau

**pierrot67** · 21/11/2018, 15h44

Bonjour

J'ai trouvé un script sur le net mais ce dernier fonctionne que pour récupérer un utilisateur en local. mais je voudrais
récupérer le nom de l'utilisateur connecté sur un pc client en réseau.
le but étant de filtrer une table paradox sur le nom de l'utilisateur connecté.

Merci d'avance.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 function Username: string; 
var 
  buffer: array[0..80] of Char; 
  len: DWORD; 
begin 
  len := Sizeof(buffer); 
  GetUsername(buffer, len); 
  Result := buffer; 
end;

**ShaiLeTroll** · 21/11/2018, 16h48

Envoyé par pierrot67

je voudrais récupérer le nom de l'utilisateur connecté sur un pc client en réseau.

Le nom de l'utilisateur de la session en cours : voir GetCurrentUserName
Un programme lancé depuis un bureau à distance récupère le nom de la session utilisé pour lancer le TSE qui peut être différente de la session en cours du client
Genre ton compte nominatif et en TSE sur un serveur avec un compte Admin

Si c'est juste le nom du PC local : voir GetComputerName

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
//------------------------------------------------------------------------------
(*                SoLuTions is an Versatile Library for Delphi                 -
 *                                                                             -
 *  Version alternative publiée sur "www.developpez.net"                       -
 *  Post : "Problème avec la récupération de la version d'un bpl ? "           -
 *  Post Number : 2003215                                                      -
 *  Post URL = "http://www.developpez.net/forums/d324468/environnements-developpement/delphi/probleme-recuperation-version-d-bpl/#post2003215"
 *                                                                             -
 *  Copyright "SLT Solutions", (©2006)                                         -
 *  contributeur : ShaiLeTroll (2012) - Renommage Fichier et Correction XE2    -
 *  contributeur : ShaiLeTroll (2012) - Documentation Insight                  -
 *  contributeur : ShaiLeTroll (2013) - Reprise de la SLT<2006> sous Delphi 7 vers la SLT<2013> sous Delphi XE2
 *                                                                             -
 *                                                                             -
 * Ce logiciel est un programme informatique servant à aider les développeurs  -
 * Delphi avec une bibliothèque polyvalente, adaptable et fragmentable.        -
 *                                                                             -
 * Ce logiciel est régi par la licence CeCILL-C soumise au droit français et   -
 * respectant les principes de diffusion des logiciels libres. Vous pouvez     -
 * utiliser, modifier et/ou redistribuer ce programme sous les conditions      -
 * de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA    -
 * sur le site "http://www.cecill.info".                                       -
 *                                                                             -
 * En contrepartie de l'accessibilité au code source et des droits de copie,   -
 * de modification et de redistribution accordés par cette licence, il n'est   -
 * offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons,   -
 * seule une responsabilité restreinte pèse sur l'auteur du programme,  le     -
 * titulaire des droits patrimoniaux et les concédants successifs.             -
 *                                                                             -
 * A cet égard  l'attention de l'utilisateur est attirée sur les risques       -
 * associés au chargement,  à l'utilisation,  à la modification et/ou au       -
 * développement et à la reproduction du logiciel par l'utilisateur étant      -
 * donné sa spécificité de logiciel libre, qui peut le rendre complexe à       -
 * manipuler et qui le réserve donc à des développeurs et des professionnels   -
 * avertis possédant  des  connaissances  informatiques approfondies.  Les     -
 * utilisateurs sont donc invités à charger  et  tester  l'adéquation  du      -
 * logiciel à leurs besoins dans des conditions permettant d'assurer la        -
 * sécurité de leurs systèmes et ou de leurs données et, plus généralement,    -
 * à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.          -
 *                                                                             -
 * Le fait que vous puissiez accéder à cet en-tête signifie que vous avez      -
 * pris connaissance de la licence CeCILL-C, et que vous en avez accepté les   -
 * termes.                                                                     -
 *                                                                             -
 *----------------------------------------------------------------------------*)
unit SLT.Common.Winapi.Windows;
 
{$ALIGN ON}
{$MINENUMSIZE 4}
 
interface
 
uses Winapi.Windows;
 
type
  _USER_NAME_FORMAT = (NameUnknown,
    NameFullyQualifiedDN, NameSamCompatible,
    NameDisplay, NameUniqueId = 6,
    NameCanonical, NameUserPrincipal,
    NameCanonicalEx, NameServicePrincipal,
    NameDnsDomain = 12);
 TUserNameFormat = _USER_NAME_FORMAT;
 
/// <summary>la fonction GetCurrentUserName simplifie l'appel de GetUserName[Ex] pour récupérer le nom de l'utilisateur courant</summary>
/// <returns>le nom de l'utilisateur courant</returns>
function GetCurrentUserName(NameFormat: TUserNameFormat = NameUnknown): string;
 
/// <summary>la fonction GetCurrentUserDomainName simplifie l'appel de GetUserName et LookUpAccountName pour récupérer le nom du domaine pour l'utilisateur courant</summary>
/// <returns>le nom du domaine pour l'utilisateur courant</returns>
function GetCurrentUserDomainName(): string;
 
/// <summary>la fonction GetFileVersion retourne la version sous un format chaine ressemblant à X.X.X.X</summary>
/// <param name="NameExe">Nom du Programme Versionnné (cela peut-être aussi une DLL)</param>
/// <param name="Version">Version Chaine de sortie contenant la version</param>
/// <returns>Indique si la Version a été récupérée</returns>
function GetFileVersion(const NameExe: string; out Version: string): boolean;
 
/// <summary>la fonction GetComputerName simplifie l'appel de Winapi.Windows.GetComputerName(...) pour récupérer le nom du poste</summary>
/// <returns>le nom du poste</returns>
function GetComputerName(): string;
 
implementation
 
uses System.SysUtils;
 
const
  Secur32 = 'Secur32.dll';
  UNLEN = 256; // A buffer size of (UNLEN + 1) characters will hold the maximum length user name including the terminating null character. UNLEN is defined in Lmcons.h.
 
{* -----------------------------------------------------------------------------
la fonction GetCurrentUserName simplifie l'appel de GetUserName pour récupérer le nom de l'utilisateur courant
@return le nom de l'utilisateur courant
------------------------------------------------------------------------------ }
function GetCurrentUserName(NameFormat: TUserNameFormat = NameUnknown): string;
var
  AccountName: array[0..UNLEN] of WideChar;
  cbAccountName: DWORD;
  Secur32H: HMODULE;
  GetUserNameEx: function(NameFormat: TUserNameFormat; lpBuffer: PWideChar; var nSize: DWORD): BOOL; stdcall;
begin
  Result := '';
  cbAccountName := MAX_PATH;
  if NameFormat <> NameUnknown then
  begin
    Secur32H := LoadLibrary(Secur32);
    if Secur32H <> 0 then
    try
      GetUserNameEx := GetProcAddress(Secur32H, 'GetUserNameExW');
      if Assigned(GetUserNameEx) and GetUserNameEx(NameFormat, AccountName, cbAccountName) then
        Result := AccountName;
    finally
      FreeLibrary(Secur32H);
    end;
  end
  else
    if GetUserName(AccountName, cbAccountName) then
      Result := AccountName;
end;
 
{* -----------------------------------------------------------------------------
la fonction GetCurrentUserDomainName simplifie l'appel de GetUserName et LookUpAccountName pour récupérer le nom du domaine pour l'utilisateur courant
@return le nom du domaine pour l'utilisateur courant
------------------------------------------------------------------------------ }
function GetCurrentUserDomainName(): string;
var
  AccountName: array[0..UNLEN] of WideChar;
  ReferencedDomainName: array[0..UNLEN] of WideChar;
  cbReferencedDomainName: DWORD;
  Sid: PSID;
  cbSid: DWORD;
  peUse: SID_NAME_USE;
begin
  Result := '';
 
  StrLCopy(AccountName, PWideChar(GetCurrentUserName()), MAX_PATH - 1);
  if StrLen(AccountName) > 0 then
  begin
    cbReferencedDomainName := MAX_PATH;
    cbSid := 0;
    // Il est nécessaire d'interroger une première fois pour connaitre la taible du SID
    if not LookUpAccountName(nil, AccountName, nil, cbSid, ReferencedDomainName, cbReferencedDomainName, peUse) then
    begin
      if GetLastError() = ERROR_INSUFFICIENT_BUFFER then
      begin
        GetMem(Sid, cbSid);
        try
          if LookUpAccountName(nil, AccountName, Sid, cbSid, ReferencedDomainName, cbReferencedDomainName, peUse) then
            Result := ReferencedDomainName;
        finally
          FreeMem(Sid);
        end;
      end;
    end
    else
      Result := ReferencedDomainName;
  end;
end;
 
{* -----------------------------------------------------------------------------
la fonction GetFileVersion retourne la version sous un format chaine ressemblant à X.X.X.X
@param NameExe Nom du Programme Versionné (cela peut-être aussi une DLL)
@param Version Chaine de sortie contenant la version
@return Version récupérée
------------------------------------------------------------------------------ }
function GetFileVersion(const NameExe: string; out Version: string): boolean;
var
  dwVerSize : Integer; // Taille de la structure des données de version de ce fichier
  hMem : HGLOBAL; // Memoire Alloué
  LpData : LPSTR; // Buffer sécurisé
  dwVerHandle : LongWord; // C'est une valeur interne à GetFileVersionInfo...
  nStrLong : LongWord; // Longueur des Données
  ChaineCC : string; // Chaine temporaire de Format de la fonction VerQueryValue
  Lp : Pointer; // Pointeur sur Buffer si les données sont complètes
  cStartBuf : array[0..4] of char;
  cResBuf : array[0..255] of char; // Chaine de Format de la fonction VerQueryValue
  FileInfo : PVSFixedFileInfo;
 
  function GetStringVersion(): Boolean;
  begin
    // Traduit LpData dans FileInfo
    Result := VerQueryValue(LpData, '\', Pointer(FileInfo), nStrLong);
    if Result then
    begin
      // Pour comprendre ce Formatage, il faut comprendre la structure Packed PVSFixedFileInfo (Windows.pas)
      Version := Format('%d.%d.%d.%d', [ FileInfo.dwFileVersionMS shr 16,
                                         FileInfo.dwFileVersionMS and $FFFF,
                                         FileInfo.dwFileVersionLS shr 16,
                                         FileInfo.dwFileVersionLS and $FFFF ]);
    end;
  end;
 
begin
  Result := False;
  // Récupère la Taille de la structure des données de version de ce fichier
  dwVerSize := GetFileVersionInfoSize(PChar(NameExe), dwVerHandle);
  Version := 'Non Disponible';
  if dwVerSize = 0 then
    Exit;
 
  // Allocation de la mémoire avec un petit surplus
  hMem:= GlobalAlloc(GMEM_ZEROINIT, dwVerSize + 100);
  // Fourni un pointeur "non relatif" de la mémoire allouée qui ne peut pas être déplacé par les optimisations de Windows
  LpData:= GlobalLock(hMem);
  try
    // Retourne dans le buffer LpData les données de version de NameExe
    GetFileVersionInfo(PChar(NameExe), dwVerHandle, dwVerSize, LpData);
    // Détermine les paramètres régionaux sont spécifiques
    if not VerQueryValue(LpData,'\VarFileInfo\Translation', Lp, nStrLong) then
      if GetStringVersion() then
        Exit;
 
    // Le format de la version est standard Delphi
    try
      // Copie une chaîne Pascal dans une chaîne terminée par le caractère Null.
      StrPcopy(cStartBuf, PChar(Lp));
      // Pour comprendre ce Formatage, il fau comprendre la structure Packed PVSFixedFileInfo (Windows.pas)
      ChaineCC := Format('\StringFileInfo\%.2x%.2x%.2x%.2x\', [ byte(cStartBuf[1]),
                                                                byte(cStartBuf[0]),
                                                                byte(cStartBuf[3]),
                                                                byte(cStartBuf[2]) ]);
    except
      Exit;
    end;
 
    // Traduit Lp dans FileInfo selon la Chaine de Format de la fonction VerQueryValue cResBuf
    StrCopy(cResBuf, Pchar(ChaineCC + 'FileVersion'));
    if VerQueryValue(LpData, cResBuf, Lp, nStrLong) then
    begin
      StrPcopy(cResBuf,PChar(Lp));
      // C'est pour le cas si on veut le Copyright StrPas(cResBuf);
      Version := StrPas(cResBuf);
      Result := True;
    end;
 
    // Il n'est pas possible d'utiliser le format régional donc je reprends la méthode normale
    if not result then
      Result := GetStringVersion();
  finally
    GlobalUnLock(hMem);
    GlobalFree(hmem);
  end;
end;
 
{* -----------------------------------------------------------------------------
la fonction GetComputerName simplifie l'appel de Winapi.Windows.GetComputerName(...) pour récupérer le nom du poste
@return le nom du poste
------------------------------------------------------------------------------ }
function GetComputerName(): string;
var
  Buffer: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  nSize: DWORD;
begin
  nSize:= MAX_COMPUTERNAME_LENGTH;
  if Winapi.Windows.GetComputerName(Buffer, nSize) then
    Result := Buffer
  else
  begin
    if GetLastError() = ERROR_BUFFER_OVERFLOW then
    begin
      SetLength(Result, nSize - 1);
      Winapi.Windows.GetComputerName(PChar(Result), nSize);
    end;
  end;
end;
 
end.

Si c'est juste le nom du PC client d'une session TSE : voir TSliteModuleTool.GetClientComputerOfRemoteSession

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
//------------------------------------------------------------------------------
(*                     Slite is Dirty Wrapper for SLT                          -
 *                                                                             -
 *  Copyright "SLT Solutions", (©2006)                                         -
 *  contributeur : ShaiLeTroll (2012) - Création de l'enveloppe Slite          -
 *                                                                             -
 *                                                                             -
 * Ce logiciel est un programme informatique servant à aider les développeurs  -
 * Delphi a intégrer la bibliothèque SLT en fournissant des enveloppes         -
 * facilitant son utilisation au sacrifice de sa fragmentation                 -
 *                                                                             -
 * Ce logiciel est régi par la licence CeCILL-C soumise au droit français et   -
 * respectant les principes de diffusion des logiciels libres. Vous pouvez     -
 * utiliser, modifier et/ou redistribuer ce programme sous les conditions      -
 * de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA    -
 * sur le site "http://www.cecill.info".                                       -
 *                                                                             -
 * En contrepartie de l'accessibilité au code source et des droits de copie,   -
 * de modification et de redistribution accordés par cette licence, il n'est   -
 * offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons,   -
 * seule une responsabilité restreinte pèse sur l'auteur du programme,  le     -
 * titulaire des droits patrimoniaux et les concédants successifs.             -
 *                                                                             -
 * A cet égard  l'attention de l'utilisateur est attirée sur les risques       -
 * associés au chargement,  à l'utilisation,  à la modification et/ou au       -
 * développement et à la reproduction du logiciel par l'utilisateur étant      -
 * donné sa spécificité de logiciel libre, qui peut le rendre complexe à       -
 * manipuler et qui le réserve donc à des développeurs et des professionnels   -
 * avertis possédant  des  connaissances  informatiques approfondies.  Les     -
 * utilisateurs sont donc invités à charger  et  tester  l'adéquation  du      -
 * logiciel à leurs besoins dans des conditions permettant d'assurer la        -
 * sécurité de leurs systèmes et ou de leurs données et, plus généralement,    -
 * à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.          -
 *                                                                             -
 * Le fait que vous puissiez accéder à cet en-tête signifie que vous avez      -
 * pris connaissance de la licence CeCILL-C, et que vous en avez accepté les   -
 * termes.                                                                     -
 *                                                                             -
 *----------------------------------------------------------------------------*)
unit Slite.Misc;
 
interface
 
{$ALIGN ON}
{$MINENUMSIZE 4}
 
uses System.Classes, System.SysUtils, System.Types, System.StrUtils,
  Winapi.Windows,
  Vcl.Themes, Vcl.Forms, Vcl.ExtCtrls, Vcl.Controls, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Graphics, Vcl.Menus, Vcl.Dialogs,
  SLT.Common.Tracing, SLT.Common.SystemEx, SLT.Common.DateUtilsEx, SLT.Common.Crypto, SLT.Common.RTTI,
  SLT.Common.Winapi.Windows, SLT.Common.Winapi.ShellApi, SLT.Common.TCP, SLT.Common.ThreadUtils,
  SLT.Controls.VCL.DialogsEx, SLT.Controls.VCL.FormsEx, SLT.Controls.VCL.GraphicsEx, SLT.Common.ICMP;
 
type
  { Forward class declarations }
  TSliteTextLog = class;
  TSliteProcessNotification = class;
 
  { aliases class declarations }
  TSliteISO8601Conversion = TSLTISO8601DateTime;
  TSliteRTTI = TSTLTypInfoRTTIWrapper;
  TSliteComponentStreaming = TSTLComponentStreaming;
  TSliteReadWriteSynchronizer = TSLTReadWriteSynchronizer;
  {$IFDEF DEBUG}
  TSliteDebugLog = TSLTDebugLogger;
  {$ENDIF DEBUG}
  {$IFDEF MSWINDOWS}
  TSliteCopyDataMessenger = TSLTCopyDataMessenger;
  TSliteShellLink = TSLTShellLink;
  TSliteShellExecuteWrapper = TSLTShellExecuteWrapper;
  TSliteRemoteMessenger = TSLTRemoteMessenger;
  TSliteRemoteMessageSocketHandle = TSLTRemoteMessageSocketHandle;
  TSliteRemoteMessengerClientInfo = TSLTRemoteMessengerClientInfo;
  TSliteRemoteMessageState = TSLTRemoteMessageState;
  TSliteICMPRequest = TSLTICMPRequest;
  {$ENDIF MSWINDOWS}
 
  { class declarations }
 
  TSliteTextLog = class(TSLTSimpleLogger)
  public
    class function WriteTrace(const LogName: TFileName; const TraceMessage: string; RemoveLineBreak: Boolean = False): string;
    class function WriteLogWarning(const LogName: TFileName; const WarningMessage: string; RemoveLineBreak: Boolean = False): string;
    class function WriteLogError(const LogName: TFileName; const ErrorMessage: string; RemoveLineBreak: Boolean = False): string;
    class function WriteLogException(const LogName: TFileName; AExceptClass: ExceptClass; const ExceptMessage: string): string;
  end;
 
  TSlitePassWordEncrypter = class(TSLTSimpleEncrypter)
  public
    class function Encrypt(const Value: string): string; override;
    class function Decrypt(const Value: string): string; override;
  end;
 
  TSliteProcessNotifyToken = TSLTProcessNotifyToken;
  TSliteProcessNotifyListener = TSLTProcessNotifyListener;
  TSliteProcessNotification = class(TSLTProcessNotification)
    class function GlobalNotifier(): TSliteProcessNotification; static;
  end;
 
  TSliteMainFormBackground = class(TComponent)
  private
    FForm: TForm;
    FBackground: TSLTBackgroundWindowHook;
    FBackgroundOnTitle: Boolean;
  public
    constructor Create(AOwner: TComponent); overload; override;
    constructor Create(AForm: TForm); reintroduce; overload;
    destructor Destroy(); override;
 
    procedure SetBackground(const ABackgroundResName: string);
    procedure SetBackgroundOnTitle(const ABackgroundResName: string);
 
    property Form: TForm read FForm;
  end;
 
  TSliteModuleTool = class(TObject)
  public
    // Types Publiques
    type
      TShellExecuteProcessIdList = TSliteShellExecuteWrapper.TProcessIdList;
  private
    class var FSessionType: (rsNone, rsLocal, rsRemoted);
    class function GetShellExecuteProcessIdList(): TShellExecuteProcessIdList; static;
  public
    class function GetTemporaryPath(const AModuleSuffix: string = ''): TFileName; static;
    class function GetTemporaryFileName(const aPrefixe: string = ''): TFileName; static;
    class function GetExeName(IncludePath: Boolean = True): string; static;
    class function GetExeVersion(): string; static;
    class function GetExeParams(): string; static;
    class function FindCmdLineSimpleSwitch(const ASwitch: string): Boolean; static;
    class procedure ShowBackground(const ABackgroundResName: string; AAllForms: Boolean = False); static;
    class function GetWindowsSession(): string; static;
    class function GetCurrentUserPrincipalName(): string; static;
    class function GetWindowsComputer(): string; static;
    class function GetCurrentUserDomainName(): string; static;
    class function IsRemoteDirectory(APath: string): Boolean; static;
    class function IsRemoteSession(): Boolean; static;
    class function GetClientComputer(): string; static;
    class function GetClientComputerOfRemoteSession(out AClientComputer: string): Boolean; static;
    class procedure ApplicationRestart(); static;
    class function ShellExecute(AFileName: TFileName; AShowCmd: Integer = SW_SHOW; const AData: Pointer = nil; const ADataSize: DWORD = 0; const AExtraParam: string = ''): Boolean; static;
    class function AutoUpdate(const AUpdateRepository: string): Boolean; static;
 
    class property ShellExecuteProcessIdList: TShellExecuteProcessIdList read GetShellExecuteProcessIdList;
  end;
 
  TSlitePatience = record
  private
    const
      AnimateName = 'TSlitePatience_SimpleAnimation';
    type
      TFormDiscret = class(TForm)
      protected
        procedure CreateParams(var Params: TCreateParams); override;
      end;
  public
    class function Create(const AMsg: string = ''; AParent: TWinControl = nil): TObject; static;
    class procedure Show(APatience: TObject); static;
    class procedure Hide(APatience: TObject); static;
    class procedure ChangeMessage(APatience: TObject; const AMsg: string); static;
 
    class function CreateSplash(const ASplashResName: string): TObject; static;
    class procedure ShowSplash(APatience: TObject); static;
    class procedure HideSplash(APatience: TObject); static;
 
    class function CreateSimpleAnimation(const AMsg: string = ''): TObject; static;
    class procedure ShowSimpleAnimation(APatience: TObject); static;
    class procedure HideSimpleAnimation(APatience: TObject); static;
    class procedure RefreshSimpleAnimation(APatience: TObject); static;
 
  end;
 
  TSliteFormZoom = record
  public
    class function BuildChangeZoomMenu(AMenuZoom: TMenuItem; ADefaultZoom: Integer = -1; AMaxZoom: Integer = 200): Integer; static;
    class procedure Zoom(AForm: TForm); static;
    class procedure ZoomControl(AWinControl: TWinControl); static;
    class function ZoomTo(AForm: TForm; AZoom: Integer): Integer; static;
    class procedure UnregisterZoom(AForm: TForm); static;
    class procedure UnZoom(AForm: TForm); static;
    class function CurrentZoom(): Integer; static;
    class function HaveZoom(): Boolean; static;
    class procedure ResetStatusBarZoom(AStatusBar: TStatusBar); static;
    class procedure SetBeforeZoomEventHandler(AEventHandler: TFormScaleSLTAssistantBeforeZoomEvent); static;
    class procedure SetAfterZoomEventHandler(AEventHandler: TFormScaleSLTAssistantAfterZoomEvent); static;
  end;
 
  TSliteFormFlasher = record
  public
    class procedure Flash(AForm: TForm); static;
  end;
 
  TSlitePointerTool = record
    /// <summary>IsObject permet de savoir si un Pointer contient un TObject</summary>
    class function IsObject(APointer: Pointer): Boolean; static;
    /// <summary>TObject.InheritsFrom ne permet de déterminer si un pointeur contient un objet, cet assistant permet de savoir si un pointeur est un objet et en plus de type AClass</summary>
    class function InheritsFrom(APointer: Pointer; AClass: TClass): Boolean; static;
    /// <summary>dynamic_cast est un opérateur de transtypage C++, en voici son équivalent Delphi.</summary>
    /// <remarks>En C++, la différence entre une référence et un pointeur est quasi-inexistante, c'est la même chose en Delphi même si c'est moins visible (la référence est un pointeur masqué) et comme il n'existe pas d'opérateur pour transformer un pointeur en référence, la méthode Dynamic_Cast jouera ce rôle comme on le ferait naturellement en C++Builder.</remarks>
    /// <example><para>if Dynamic_Cast(ptr, AClass, Obj) then ...</para>
    /// <para>s'écrirait en C++ :</para>
    /// <para>Obj = dynamic_cast&lt;AClass&gt;(ptr);</para>
    /// <para>if (Obj) { ... }</para></example>
    class function Dynamic_Cast(APointer: Pointer; AClass: TClass; var Obj): Boolean; static;
    /// <summary>RealAssigned vérifie qu'un objet est non nul et vérifie si il est véritablement allouée</summary>
    class function RealAssigned(var Obj): Boolean; static;
  end;
 
  TSliteInterfacedObject = TSLTInterfacedReferencableObject;
 
  TSliteRTTI<T> = class
    class function EnumToString(Value: Integer): string; static;
  end;
 
 
  /// <summary>Type simplifiant la séparation des canaux en français dans un TColor </summary>
  TSliteColor = record
    case Integer of
      0:
        (
          Rouge, Vert, Bleu, Transparence: Byte;
        );
      1:
        (
          Color: TColor;
        );
    end;
 
implementation
 
uses System.Math,
  OraError, IdException,
  SLT.Common.StrUtilsEx, SLT.Common.FileUtilsEx, SLT.Common.AutoUpdate,
  SLT.Controls.VCL.StdCtrlsEx,
  SLT.Common.DesignPattern;
 
resourcestring
  SWait = 'Patientez ...';
 
{ TSliteTextLog }
 
//------------------------------------------------------------------------------
class function TSliteTextLog.WriteLogError(const LogName: TFileName; const ErrorMessage: string; RemoveLineBreak: Boolean = False): string;
begin
  if RemoveLineBreak then
    Result := CharReplace(CharReplace(ErrorMessage, LineFeed, VerticalTab), #13, Space)
  else
    Result := ErrorMessage;
 
  TSliteTextLog.WriteLog(LogName, '[ERROR]', Result);
end;
 
//------------------------------------------------------------------------------
class function TSliteTextLog.WriteLogException(const LogName: TFileName; AExceptClass: ExceptClass; const ExceptMessage: string): string;
begin
  if AExceptClass.InheritsFrom(EOraError) then
    Result := AExceptClass.ClassName() + ' -> ' + CharReplace(ExceptMessage, LineFeed, VerticalTab)
  else if AExceptClass.InheritsFrom(EIdException) then
    Result := AExceptClass.ClassName() + ' -> ' + CharReplace(CharReplace(ExceptMessage, LineFeed, VerticalTab), #13, Space)
  else
    Result := AExceptClass.ClassName() + ' -> ' + ExceptMessage;
 
  TSliteTextLog.WriteLog(LogName, '[EXCEPTION]', Result);
end;
 
//------------------------------------------------------------------------------
class function TSliteTextLog.WriteLogWarning(const LogName: TFileName; const WarningMessage: string; RemoveLineBreak: Boolean = False): string;
begin
  if RemoveLineBreak then
    Result := CharReplace(CharReplace(WarningMessage, LineFeed, VerticalTab), #13, Space)
  else
    Result := WarningMessage;
 
  TSliteTextLog.WriteLog(LogName, '[WARNING]', Result);
end;
 
//------------------------------------------------------------------------------
class function TSliteTextLog.WriteTrace(const LogName: TFileName; const TraceMessage: string; RemoveLineBreak: Boolean = False): string;
var
  SectionName: string;
begin
  if RemoveLineBreak then
    Result := CharReplace(CharReplace(TraceMessage, LineFeed, VerticalTab), #13, Space)
  else
    Result := TraceMessage;
 
  if TraceMessage <> '' then
    SectionName := '[TRACE]'
  else
    SectionName := '';
 
  TSliteTextLog.WriteLog(LogName, SectionName, Result, TraceMessage <> '');
end;
 
{ TSlitePassWordEncrypter }
 
//------------------------------------------------------------------------------
class function TSlitePassWordEncrypter.Decrypt(const Value: string): string;
var
  RawValue, RawKey, RawResult: RawByteString;
begin
  // Base64 -> AES -> UTF8 -> Unicode
  RawValue := RawByteString(TSLTBase64.Decode(Value));
  SetLength(RawKey, GetKeySize());
  Move(PByte(GetKeyData())^, RawKey[1], GetKeySize());
  RawResult := TSLTAES128ECB.Decrypt(RawValue, RawKey);
  Result := UTF8ToString(RawResult);
end;
 
//------------------------------------------------------------------------------
class function TSlitePassWordEncrypter.Encrypt(const Value: string): string;
var
  RawValue, RawKey, RawResult: RawByteString;
begin
  // Unicode -> UTF8 -> AES -> Base64
  RawValue := Utf8Encode(Value);
  SetLength(RawKey, GetKeySize());
  Move(PByte(GetKeyData())^, RawKey[1], GetKeySize());
  RawResult := TSLTAES128ECB.Encrypt(RawValue, RawKey);
  Result := TSLTBase64.Encode(string(RawResult));
end;
 
{ TSliteProcessNotification }
 
//------------------------------------------------------------------------------
class function TSliteProcessNotification.GlobalNotifier(): TSliteProcessNotification;
begin
  Result := TSLTSingleton<TSliteProcessNotification>.Instance;
end;
 
{ TSliteModuleTool }
 
//------------------------------------------------------------------------------
class procedure TSliteModuleTool.ApplicationRestart();
begin
  if TSLTShellExecuteWrapper.Execute(Application.ExeName) then
    Application.Terminate();
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.AutoUpdate(const AUpdateRepository: string): Boolean;
begin
  TSLTModuleAutoUpdate.EngineClass := TSLTModuleAutoUpdateByDOSBatchEngine;
  Result := TSLTModuleAutoUpdate.GetLastVersion(AUpdateRepository);
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.FindCmdLineSimpleSwitch(const ASwitch: string): Boolean;
var
  I: Integer;
begin
  // FindCmdLineSwitch ne gère pas correctement le Switch sans prefixe
  for I := 1 to ParamCount do
    if SameText(ParamStr(I), ASwitch) then
      Exit(True);
 
  Result := False;
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetClientComputer(): string;
begin
  if not GetClientComputerOfRemoteSession(Result) then
    Result := GetWindowsComputer();
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetClientComputerOfRemoteSession(out AClientComputer: string): Boolean;
// http://codeverge.com/embarcadero.delphi.non-tech/remote-desktop-question/1086940
const
  WTS_CURRENT_SERVER_HANDLE: THandle = 0;
  WTS_CURRENT_SESSION: DWORD = DWORD(-1);
type
  WTS_INFO_CLASS = (
    WTSInitialProgram, WTSApplicationName, WTSWorkingDirectory, WTSOEMId, WTSSessionId, WTSUserName, WTSWinStationName, WTSDomainName,
    WTSConnectState, WTSClientBuildNumber, WTSClientName, WTSClientDirectory, WTSClientProductId, WTSClientHardwareId, WTSClientAddress,
    WTSClientDisplay, WTSClientProtocolType, WTSIdleTime, WTSLogonTime, WTSIncomingBytes, WTSOutgoingBytes, WTSIncomingFrames, WTSOutgoingFrames,
    WTSClientInfo, WTSSessionInfo, WTSSessionInfoEx, WTSConfigInfo, WTSValidationInfo, WTSSessionAddressV4, WTSIsRemoteSession
  );
type
  TWTSQuerySessionInformationFunction = function(hServer: THandle; SessionId: DWORD; WTSInfoClass: WTS_INFO_CLASS; var ppBuffer: PChar; var pBytesReturned: DWORD): BOOL; stdcall;
  TWTSFreeMemoryProcedure = procedure(pMemory: Pointer); stdcall;
var
  LibHandle: HMODULE;
  WTSQuerySessionInformation: TWTSQuerySessionInformationFunction;
  WTSFreeMemory: TWTSFreeMemoryProcedure;
  Buffer: PChar;
  BytesReturned: DWORD;
begin
  Result := False;
 
  if IsRemoteSession() then
  begin
    LibHandle := LoadLibrary('wtsapi32.dll');
    if LibHandle <> 0 then
    begin
      try
        @WTSQuerySessionInformation := GetProcAddress(LibHandle, {$IFDEF UNICODE}'WTSQuerySessionInformationW'{$ELSE}'WTSQuerySessionInformationA'{$ENDIF});
        @WTSFreeMemory := GetProcAddress(LibHandle, 'WTSFreeMemory');
 
        if Assigned(WTSQuerySessionInformation) and Assigned(WTSFreeMemory) then
        begin
          if WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, WTS_CURRENT_SESSION, WTSClientName, Buffer, BytesReturned) then
          begin
            try
              AClientComputer := Buffer;
              Result := True;
            finally
              WTSFreeMemory(Buffer);
            end;
          end;
        end;
      finally
        FreeLibrary(LibHandle);
      end;
    end;
  end;
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetCurrentUserDomainName(): string;
begin
  Result := SLT.Common.Winapi.Windows.GetCurrentUserDomainName();
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetCurrentUserPrincipalName(): string;
begin
  Result := GetCurrentUserName(NameUserPrincipal);
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetExeName(IncludePath: Boolean = True): string;
var
  ModuleFileName: array[0..MAX_PATH - 1] of Char;
begin
  GetModuleFileName(0, ModuleFileName, MAX_PATH); // 0 c'est pour l'EXE même si depuis une DLL, avec HInstance cela fournirait le nom de la DLL
  if IncludePath then
    Result := ModuleFileName
  else
    Result := ExtractFileName(ModuleFileName);
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetExeParams(): string;
var
  ExeName: string;
  I: Integer;
begin
  Result := Winapi.Windows.GetCommandLine();
  // Cela contient le nom du programme en 1er paramètre, il faut le retirer
  ExeName := GetExeName(False);
  I := Pos(ExeName, Result);
  if I > 0 then
  begin
    I := PosEx(' ', Result, I  + Length(ExeName));
    if I > 0 then
      Result := Copy(Result, I + 1);
  end;
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetExeVersion(): string;
begin
  if not SLT.Common.Winapi.Windows.GetFileVersion(GetExeName(), Result) then
    Result := '?';
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetShellExecuteProcessIdList(): TShellExecuteProcessIdList;
begin
  Result := TSLTShellExecuteWrapper.ProcessIdList;
end;
 
//------------------------------------------------------------------------------
// Retourne le nom du dossier des fichiers temporaires
//------------------------------------------------------------------------------------
class function TSliteModuleTool.GetTemporaryPath(const AModuleSuffix: string): TFileName;
begin
  Result := SLT.Common.FileUtilsEx.GetTemporaryPathForProcess('', AModuleSuffix);
end;
 
//------------------------------------------------------------------------------------
// Retourne le nom d'un fichier inexistant dans le dossier des fichiers temporaires
//------------------------------------------------------------------------------------
class function TSliteModuleTool.GetTemporaryFileName(const aPrefixe: string = ''): TFileName;
var
  TempFile: array[0..MAX_PATH - 1] of Char;
  TempPath: array[0..MAX_PATH - 1] of Char;
begin
  GetTempPath(MAX_PATH, TempPath);
  if GetTempFileName(TempPath, PChar(aPrefixe), 0, TempFile) = 0 then
    raise Exception.Create('GetTempFileName API failed. ' + SysErrorMessage(GetLastError));
  Result := TempFile;
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetWindowsComputer(): string;
begin
  Result := GetComputerName();
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.GetWindowsSession(): string;
begin
  Result := GetCurrentUserName(NameUnknown);
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.IsRemoteDirectory(APath: string): Boolean;
begin
  Result := GetDriveType(PChar(APath)) = DRIVE_REMOTE;
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.IsRemoteSession(): Boolean;
const
  TERMINAL_SERVER_KEY = 'SYSTEM\CurrentControlSet\Control\Terminal Server\';
  GLASS_SESSION_ID    = 'GlassSessionId';
var
  hRegKey: HKEY;
  dwGlassSessionId: DWORD;
  cbGlassSessionId: DWORD;
  dwCurrentSessionId: DWORD;
  dwType: DWORD;
begin
  if FSessionType = rsNone then
  begin
    if LongBool(GetSystemMetrics(SM_REMOTESESSION)) then
      FSessionType := rsRemoted;
 
    (* You should not use GetSystemMetrics(SM_REMOTESESSION) to determine
    if your application is running in a remote session in Windows 8 and later or Windows Server 2012 and later
    if the remote session may also be using the RemoteFX vGPU improvements to the Microsoft Remote Display Protocol (RDP).
    In this case, GetSystemMetrics(SM_REMOTESESSION) will identify the remote session as a local session.
 
    Your application can check the following registry key to determine whether the session is a remote session that uses RemoteFX vGPU.
    If a local session exists, this registry key provides the ID of the local session : HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Terminal Server\GlassSessionId
    If the ID of the current session in which the application is running is the same as in the registry key, the application is running in a local session.
    Sessions identified as remote session in this way include remote sessions that use RemoteFX vGPU. *)
    if (FSessionType = rsNone) and CheckWin32Version(6, 2) then
    begin
      try
        if RegOpenKeyEx(HKEY_LOCAL_MACHINE, TERMINAL_SERVER_KEY, 0, KEY_READ, hRegKey) = ERROR_SUCCESS then
        begin
          cbGlassSessionId := SizeOf(dwGlassSessionId);
 
          if RegQueryValueEx(hRegKey, GLASS_SESSION_ID, nil, @dwType, PByte(@dwGlassSessionId), @cbGlassSessionId) = ERROR_SUCCESS then
            if ProcessIdToSessionId(GetCurrentProcessId(), &dwCurrentSessionId) then
              if dwCurrentSessionId <> dwGlassSessionId then
                FSessionType := rsRemoted;
        end;
      finally
        if hRegKey <> 0 then
          RegCloseKey(hRegKey);
      end;
    end;
 
    if FSessionType = rsNone then
      FSessionType := rsLocal;
  end;
 
  Result := FSessionType = rsRemoted;
end;
 
//------------------------------------------------------------------------------
class function TSliteModuleTool.ShellExecute(AFileName: TFileName; AShowCmd: Integer = SW_SHOW; const AData: Pointer = nil; const ADataSize: DWORD = 0; const AExtraParam: string = ''): Boolean;
begin
  Result := TSLTShellExecuteWrapper.Execute(AFileName, AData, ADataSize, AShowCmd, AExtraParam);
end;
 
//------------------------------------------------------------------------------
class procedure TSliteModuleTool.ShowBackground(const ABackgroundResName: string; AAllForms: Boolean = False);
begin
  try
    if ABackgroundResName <> '' then
      TSLTBackgroundFormStyleHook.Background.LoadFromResourceName(HInstance, ABackgroundResName)
    else
      TSLTBackgroundFormStyleHook.Background := nil;
 
    TSLTBackgroundFormStyleHook.TransparentOnDarkStyle := True;
    TSLTBackgroundFormStyleHook.MainFormOnly := not AAllForms;
    TStyleManager.Engine.RegisterStyleHook(TCustomForm, TSLTBackgroundFormStyleHook); // Selon l'ordre des "uses", il semble que le RegisterStyleHook sur TCustomForm ne soit pas systématiquement fiable
    TStyleManager.Engine.RegisterStyleHook(TForm, TSLTBackgroundFormStyleHook); // Le plus important
  except
    on E: Exception do
      OutputDebugString(PChar(E.Message));
  end;
end;
 
{ TSliteMainFormBackground }
 
//------------------------------------------------------------------------------
constructor TSliteMainFormBackground.Create(AForm: TForm);
begin
  inherited Create(AForm);
 
  FForm := AForm;
end;
 
//------------------------------------------------------------------------------
constructor TSliteMainFormBackground.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 
  FForm := AOwner as TForm;
end;
 
//------------------------------------------------------------------------------
destructor TSliteMainFormBackground.Destroy();
begin
  FreeAndNil(FBackground);
 
  inherited Destroy();
end;
 
//------------------------------------------------------------------------------
procedure TSliteMainFormBackground.SetBackground(const ABackgroundResName: string);
begin
  if not Assigned(FBackground) then
    FBackground := TSLTBackgroundWindowHook.Create(FForm);
 
  FBackground.LoadBackgroundByResName(ABackgroundResName);
  FBackground.BackgroundOnTitle := FBackgroundOnTitle;
  FForm.Invalidate();
end;
 
//------------------------------------------------------------------------------
procedure TSliteMainFormBackground.SetBackgroundOnTitle(const ABackgroundResName: string);
begin
  FBackgroundOnTitle := True;
  SetBackground(ABackgroundResName);
end;
 
{ TSlitePatience }
 
(*Cet ajout relie la ressource AVI aviCopyFiles similaire à celle de Windows XP pour Windows 6.x *)
// l'unité ShellAnimations contient toutes les inclusions de ressources
{$R CopyFiles.res }
 
//------------------------------------------------------------------------------
class procedure TSlitePatience.ChangeMessage(APatience: TObject; const AMsg: string);
var
  Patience: TForm absolute APatience;
  Control: TControl;
  I, W: Integer;
begin
  if APatience is TForm then
  begin
    for I := 0 to Patience.ControlCount -1 do
    begin
      Control := Patience.Controls[I];
      if Control is TPanel then
      begin
        W := TFontSLTToolHelp.GetTextWidth(AMsg, TPanel(Control).Font) + 8;
        if W > Patience.ClientWidth then
          Patience.ClientWidth := System.Math.Min(W, Screen.WorkAreaWidth - (Patience.Width - Patience.ClientWidth));
 
        TPanel(Control).Caption := AMsg;
        TPanel(Control).Refresh();
        Exit;
      end;
    end;
  end;
end;
 
//------------------------------------------------------------------------------
class function TSlitePatience.Create(const AMsg: string = ''; AParent: TWinControl = nil): TObject;
var
  Patience: TForm absolute Result;
begin
  Result := TFormDiscret.CreateNew(nil, 0);
  with Patience do
  begin
    Position := poScreenCenter;
    BorderStyle := bsToolWindow;
    BorderIcons := [];
    Caption := SWait;
    FormStyle := fsStayOnTop;
    if Assigned(AParent) then
    begin
      Parent := AParent;
      Position := poDesigned;
      Top := (Parent.ClientHeight - (Height - ClientHeight) * 2) div 2;
      Left := 10;
      Width := Parent.ClientWidth - 20;
    end
    else
      Width := Screen.WorkAreaWidth div 4;
 
    Height := (Height - ClientHeight) * 4; // Une fenêtre fine de la taille de 4 barres de titre (Titre + Espace + Texte + Espace)
 
    with TPanel.Create(Patience) do
    begin
      Parent := Patience;
      Align := alClient;
      if AMsg <> '' then
        Caption := AMsg
      else
        Caption := SWait;
      Visible := True;
    end;
  end;
end;
 
//------------------------------------------------------------------------------
class function TSlitePatience.CreateSimpleAnimation(const AMsg: string = ''): TObject;
var
  Patience: TForm absolute Result;
  AniHeight, AniWidth: Integer;
begin
  Result := TFormDiscret.CreateNew(nil, 0);
  with Patience do
  begin
    Position := poScreenCenter;
    BorderStyle := bsToolWindow;
    BorderIcons := [];
    AutoSize := True;
    Caption := SWait;
    FormStyle := fsStayOnTop;
 
    with TAnimate.Create(Patience) do
    begin
      Name := AnimateName;
      Parent := Patience;
      CommonAVI := aviCopyFiles;
      Visible := True;
      Active := True; // Nécessite un Application.ProcessMessages !
      AniHeight := Height;
      AniWidth := Width;
    end;
 
    if AMsg <> '' then
    begin
      with TPanel.Create(Patience) do
      begin
        Top := AniHeight;
        Width := AniWidth;
        Parent := Patience;
        Caption := AMsg;
        BevelInner := bvRaised;
        BevelOuter := bvLowered;
        Visible := True;
      end;
    end;
  end;
end;
 
//------------------------------------------------------------------------------
class function TSlitePatience.CreateSplash(const ASplashResName: string): TObject;
var
  Patience: TForm absolute Result;
  lRect: TRect;
  lText: string;
begin
  Result := TFormDiscret.CreateNew(nil, 0);
  with Patience do
  begin
    Position := poScreenCenter;
    BorderStyle := bsNone;
    BorderIcons := [];
    AutoSize := True;
    FormStyle := fsStayOnTop;
    Enabled := False;
 
    with TImage.Create(Patience) do
    begin
      Parent := Patience;
      AutoSize := True;
      try
        with Picture.Bitmap do
        begin
          LoadFromResourceName(HInstance, ASplashResName);
          lRect := Rect(0, 0, Width, Height);
          lText := SWait;
          Canvas.Font.Height := Width div Length(lText);
          lRect.Top := lRect.Height - Canvas.Font.Height * 2;
          Canvas.Font.Color := TCanvasSLTAssistant.GetConstratedColor(Canvas.Pixels[lRect.CenterPoint.X, lRect.Top]);
          Canvas.Brush.Style := bsClear;
          Canvas.TextRect(lRect, lText, [tfCenter, tfSingleLine, tfVerticalCenter]);
        end;
      except
        on E: Exception do
          OutputDebugString(PChar(E.Message));
      end;
      Visible := True;
    end;
  end;
end;
 
//------------------------------------------------------------------------------
class procedure TSlitePatience.Hide(APatience: TObject);
begin
  if APatience is TForm then
    TForm(APatience).Hide();
end;
 
//------------------------------------------------------------------------------
class procedure TSlitePatience.HideSimpleAnimation(APatience: TObject);
begin
  Hide(APatience);
end;
 
//------------------------------------------------------------------------------
class procedure TSlitePatience.HideSplash(APatience: TObject);
begin
  Hide(APatience);
end;
 
//------------------------------------------------------------------------------
class procedure TSlitePatience.RefreshSimpleAnimation(APatience: TObject);
var
  Cpt: TComponent;
begin
  if APatience is TForm then
  begin
    Cpt := TForm(APatience).FindComponent(AnimateName);
    if Cpt is TAnimate then
      Application.ProcessMessages();
  end;
end;
 
//------------------------------------------------------------------------------
class procedure TSlitePatience.Show(APatience: TObject);
begin
  if APatience is TForm then
  begin
    TForm(APatience).Show();
    TForm(APatience).Refresh();
  end;
end;
 
//------------------------------------------------------------------------------
class procedure TSlitePatience.ShowSimpleAnimation(APatience: TObject);
begin
  Show(APatience);
end;
 
//------------------------------------------------------------------------------
class procedure TSlitePatience.ShowSplash(APatience: TObject);
begin
  Show(APatience);
end;
 
{ TSlitePatience.TFormDiscret }
 
//------------------------------------------------------------------------------
procedure TSlitePatience.TFormDiscret.CreateParams(var Params: TCreateParams);
begin
  Params.ExStyle := Params.ExStyle and not WS_EX_NOACTIVATE;
 
  inherited CreateParams(Params);
end;
 
{ TSliteFormZoom }
 
//------------------------------------------------------------------------------
class function TSliteFormZoom.BuildChangeZoomMenu(AMenuZoom: TMenuItem; ADefaultZoom: Integer = -1; AMaxZoom: Integer = 200): Integer;
begin
  Result := TFormScaleSLTAssistant.BuildChangeZoomMenu(AMenuZoom, TFormScaleSLTAssistant.ZoomClickDefaultEventHandler, ADefaultZoom, AMaxZoom);
end;
 
//------------------------------------------------------------------------------
class function TSliteFormZoom.CurrentZoom(): Integer;
begin
  Result := TFormScaleSLTAssistant.CurrentZoom;
end;
 
//------------------------------------------------------------------------------
class function TSliteFormZoom.HaveZoom(): Boolean;
begin
  Result := TFormScaleSLTAssistant.CurrentZoom <> TFormScaleSLTAssistant.ReferenceZoom;
end;
 
//------------------------------------------------------------------------------
class procedure TSliteFormZoom.UnregisterZoom(AForm: TForm);
begin
  TFormScaleSLTAssistant.UnregisterZoom(AForm);
end;
 
//------------------------------------------------------------------------------
class procedure TSliteFormZoom.ResetStatusBarZoom(AStatusBar: TStatusBar);
var
  DefaultFont: TFont;
begin
  AStatusBar.Height := 19;
  DefaultFont := TFont.Create();
  try
    AStatusBar.Font.Assign(DefaultFont);
  finally
    DefaultFont.Free();
  end;
  AStatusBar.Perform(CM_RECREATEWND, 0, 0);
end;
 
//------------------------------------------------------------------------------
class procedure TSliteFormZoom.SetAfterZoomEventHandler(AEventHandler: TFormScaleSLTAssistantAfterZoomEvent);
begin
  TFormScaleSLTAssistant.AfterZoom := AEventHandler;
end;
 
//------------------------------------------------------------------------------
class procedure TSliteFormZoom.SetBeforeZoomEventHandler(AEventHandler: TFormScaleSLTAssistantBeforeZoomEvent);
begin
  TFormScaleSLTAssistant.BeforeZoom := AEventHandler;
end;
 
//------------------------------------------------------------------------------
class procedure TSliteFormZoom.UnZoom(AForm: TForm);
begin
  TFormScaleSLTAssistant.CancelZoom(AForm);
end;
 
//------------------------------------------------------------------------------
class procedure TSliteFormZoom.Zoom(AForm: TForm);
begin
  TFormScaleSLTAssistant.ApplyCurrentZoom(AForm);
end;
 
//------------------------------------------------------------------------------
class procedure TSliteFormZoom.ZoomControl(AWinControl: TWinControl);
begin
  TFormScaleSLTAssistant.ApplyCurrentZoomToControl(AWinControl);
end;
 
//------------------------------------------------------------------------------
class function TSliteFormZoom.ZoomTo(AForm: TForm; AZoom: Integer): Integer;
begin
  Result := TFormScaleSLTAssistant.ApplySpecificZoom(AForm, AZoom);
end;
 
{ TSliteFormFlasher }
 
//------------------------------------------------------------------------------
class procedure TSliteFormFlasher.Flash(AForm: TForm);
var
  pfwi: FLASHWINFO;
begin
  pfwi.cbSize := SizeOf(pfwi);
  pfwi.hwnd := AForm.Handle;
  pfwi.uCount := 5;
  pfwi.dwFlags := FLASHW_ALL;
  pfwi.dwTimeout := 50;
  FlashWindowEx(pfwi);
end;
 
{ TSlitePointerTool }
 
//------------------------------------------------------------------------------
class function TSlitePointerTool.Dynamic_Cast(APointer: Pointer; AClass: TClass; var Obj): Boolean;
begin
  Result := InheritsFrom(APointer, AClass);
  if Result then
    TObject(Obj) := APointer;
end;
 
//------------------------------------------------------------------------------
class function TSlitePointerTool.InheritsFrom(APointer: Pointer; AClass: TClass): Boolean;
begin
  Result := False;
  if Assigned(APointer) then
  begin
    try
      Result := TObject(APointer).InheritsFrom(AClass);
    except
      on E: Exception do
        Result := False;
    end;
  end;
end;
 
//------------------------------------------------------------------------------
class function TSlitePointerTool.IsObject(APointer: Pointer): Boolean;
begin
  Result := InheritsFrom(APointer, TObject);
end;
 
 
//------------------------------------------------------------------------------
class function TSlitePointerTool.RealAssigned(var Obj): Boolean;
begin
  Result := SLT.Common.SystemEx.RealAssigned(Obj);
end;
 
{ TSliteRTTI<T> }
 
//------------------------------------------------------------------------------
class function TSliteRTTI<T>.EnumToString(Value: Integer): string;
begin
  Result := TSliteRTTI.EnumToString(TypeInfo(T), Value);
end;
 
end.

Si c'est depuis un poste A savoir qui est connecté sur B
N'ayant jamais eu besoin de le savoir mais une requêtre WMI depuis A sur B cela sera une piste

En VBS

Code VBS :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
strComputer = InputBox("Entrer le nom de l'ordinateur cible","Utilisateur distant")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
Set colComputer = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
For Each objComputer in colComputer
	Wscript.Echo objComputer.UserName
Next

Pas les droits, cela ne me surprend pas !

Nom : Sans titre.jpg
Affichages : 2618
Taille : 73,8 Ko

**pierrot67** · 21/11/2018, 19h56

Merci pour vos réponses mais mon problème est plus simple. je veux juste créer un filtre sur le nom de l'utilisateur qui vient de se loguer sur
un pc intégré au domaine. c'est tout.
concernant le filtre je m'en charge je cherche juste à récupérer le nom d'utilisateur qui vient de se loguer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
dans ce style...
filtre:='Utilisateur=''' + UserName* +'*''';
filter:=filtre
filtered:=True

* nom d'utilisateur existants dans l'appli que je veux filtrer.

**cincap** · 22/11/2018, 09h41

Bonjour à toutes et à tous,

@ pierrot66, as tu essayé avec ce lien pour vérifier si c'est bien cela que tu recherches :

https://www.nirsoft.net/utils/wirele...k_watcher.html

Après on peut imaginer un fichier *.bat que tu pourras lancer avec un ShellExecute.

@+,

cincap

**ShaiLeTroll** · 22/11/2018, 09h55

Envoyé par pierrot67

Merci pour vos réponses mais mon problème est plus simple. ... je cherche juste à récupérer le nom d'utilisateur qui vient de se loguer.

Je ne comprends donc pas la question, pour moi vous avez tous les éléments en main, ce n'est pas clair

**cincap** · 22/11/2018, 10h54

@ ShaiLeTroll, j'ai constaté en tous les cas sous Windows 10 64bits que le nom de l'utilisateur est limité à 5 caractères.

J'ai utilisé plusieurs méthodes, une me donne le nom de mon Pc et l'autre l'username.

J'ai aussi testé avec GetcomputerName.

Même en utilisant le fichier bat.

@+,

cincap

**BuzzLeclaire** · 22/11/2018, 19h28

Bonsoir,

Ceci peut surement t'aider...

https://www.developpez.net/forums/d3...ateur-paradox/

**ShaiLeTroll** · 23/11/2018, 18h52

Envoyé par cincap

@Windows 10 64bits que le nom de l'utilisateur est limité à 5 caractères.

Voici une information intéressante

J'ai vu sur une API qu'il y avait une note à partir de Windows 8 mais je ne sais plus laquelle

**cincap** · 23/11/2018, 20h01

Bonsoir à toutes et à tous,

En ce qui concerne la limite du nom de l'username à 5 caractères qui est peut être propre à ma configuration, voici le contenu d'un fichier "test.bat" pour tester sur d'autres Os.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
@ECHO off
echo %username%
echo %date%
echo %time%
@PAUSE

@+,

cincap

**pierrot67** · 24/11/2018, 12h06

merci à tous
je vais faire encore plus simple existe-t-il un script pour delphi equivalent à un script .bat du style

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

echo %username%

car ce script fonctionne sur un pc en domaine je récupère bien l'utilisateur qui vient de se loguer.

**cincap** · 25/11/2018, 10h48

Bonjour à toutes et à tous,

@ pierrot67 a tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
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;

Utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Var
 User: String;
begin
 User := Username;
 Showmessage(user);
end;

Sinon avec ton fichier *.bat tu crées un fichier "test.txt" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
@echo off >test.txt
echo username >> test.txt
echo %username% >> test.txt
@PAUSE

Et depuis ton fichier "*.bat" tu récupères l'username de ton fichier texte dans un Tedit avec la fenêtre dos invisible :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
procedure TForm1.Button4Click(Sender: TObject);
var
UnStringList:TStringList;
begin
 
ShellExecute(Handle, nil,pchar('test.bat'),nil, nil, 0);
 
//Création du STringList
  UnStringList:=TStringList.Create;
  try
     //Chargement du fichier texte
     UnStringList.LoadFromFile('test.txt');
 
     edit1.Text:=UnStringList.strings[UnStringList.Count-1];
 
  finally
 
     //Destruction du StringList
     UnStringList.Free;
  end;
end;

@+,

cincap

**guillemouze** · 26/11/2018, 10h47

Envoyé par pierrot67

merci à tous
je vais faire encore plus simple existe-t-il un script pour delphi equivalent à un script .bat du style

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

echo %username%

car ce script fonctionne sur un pc en domaine je récupère bien l'utilisateur qui vient de se loguer.

La fonction ExpandEnvironmentStrings.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ExpandEnvironmentStrings('%username%', buff, taille_buff);

avec un premier appel sans buffer pour récupérer la taille à allouer.

**cincap** · 27/11/2018, 11h02

Bonjour à toutes et à tous,

@ guillemouze, pour ne pas mourir idiot et si ce n'est pas trop de te le demander, comment l'utilise tu ?

ExpandEnvironmentStrings('%username%', buff, taille_buff);

Sur Windows 10 ceci fonctionne tout simplement sans fonction mais il faudrait tester sur un Pc et réseau comme je l'avais demandé avec le contenu de mon fichier *.bat, cité plus haut :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Edusername.Text := GetEnvironmentVariable('USERNAME'); //Ou USERDOMAIN pour le nom du Pc ou autres informations !

@+,

cincap

**SergioMaster** · 27/11/2018, 12h04

Bonjour,

J'ai beau avoir suivi toute la discussion et ce depuis le début, je n'arrive toujours pas à comprendre et ça commence à me monter au nez !

De quoi parle t'on exactement car c'est loin d'être clair, tout est mélangé.
Tout d'abord on ne sait même pas à quelle version de Delphi on a à faire ! Or le passage à l'unicode D2009 change quelque peu la donne
Que vient faire Paradox dans cette galère ? On se f..t de savoir à quoi peut bien servir la valeur obtenue à moins que ce soit une valeur que l'on doit obtenir auprès de Paradox (post et lien de BuzzLeclair)

D'où doit t-on tirer cette information (username) ce n'est pas clair
1.echo %username% indiquerai que c'est à partir du PC "Client" en gros, le pc qui exécute le programme, si j'indique client c'est qu'il semblerai que la table Paradox semble se trouver sur une autre poste ? cette partie n'est pas très claire.
2. Comme l'a justement fait remarquer ShaileTroll il pourrait très bien s'agir d'une session TSE , ce qui semble être écarté.
3. Pourrait-il encore s'agir du nom de l'utilisateur connecté sur un lecteur réseau pouvant donc être différent de l'utilisateur d'ouverture de session ?
4. Et enfin , autre possibilité, n'est-il pas envisageable que ce soit le poste "serveur" (celui qui héberge la table Paradox) qui demande cette information ?

Je ne sais même pas si j'ai fait le tour de la question, il y a peut être d'autres cas envisageables

MERCI DE METTRE AU CLAIR CES POINTS << Je sais, ça pique, c'est voulu pour

Pour le point 1, la FAQ Comment-obtenir-le-nom-de-l-utilisateur aurait du suffire toutefois comme la version Unicode peut jouer l'équivalent de echo %username% pourrait se coder pour les versions 2009 et + par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
program Project2;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
  System.SysUtils, Winapi.Windows;
 
function getCurUserName: String;
const
  UNLEN = 256;
var
  BufSize: DWord;
begin
  BufSize := UNLEN + 1;
  SetLength(Result, BufSize);
  if GetUserName(PChar(Result), BufSize) then
    SetLength(Result, BufSize-1)
  else
    RaiseLastOSError;
end;
 
begin
  try
    WriteLn(GetCurUsername);
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Pour ce qui est de Paradox, en réseau,

franchement il serait temps de "moderniser"

**cincap** · 27/11/2018, 12h45

@ SergioMaster, je pensais avoir compris que le topic concernait la possibilité de trouver qui se connectait sur un Pc client en réseau afin d'adapter sa table de type Paradox.

Ou tu as aussi raison c'est au minimum de connaitre la version de Delphi et l'Os qu'utilisent les Pc en réseau.

Par contre il y a eu au moins une réaction de pierrot67 suite à la commande "%username%" de mon fichier *.bat que je demandais de tester !

car ce script fonctionne sur un pc en domaine je récupère bien l'utilisateur qui vient de se loguer.

D'où diverse solutions proposées avec patience.

@+,

cincap

**SergioMaster** · 27/11/2018, 15h04

Envoyé par cincap

la possibilité de trouver qui se connectait sur un Pc client en réseau afin d'adapter sa table de type Paradox.

ça n'était pas aussi évident que ça d'où ma demande sur le choix 1..4

Envoyé par cincap

D'où diverse solutions proposées avec patience.

Patience, c'est le mot ! mais les réponses de pierrot67 sont succinctes et portent à confusion

en PS GetEnvironmentVariable('USERNAME') est AMHA la plus "portable" des solutions, dommage je n'ai pas de truc à la pomme pour tester

**guillemouze** · 28/11/2018, 10h55

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
function ExpandEnv(const Value: string): String;
var
  n: integer;
begin
  n := ExpandEnvironmentStrings(PChar(Value), nil, 0);
  SetLength(Result, n);
  ExpandEnvironmentStrings(PChar(Value), PChar(Result), n);
end;
 
//qui s'utilise comme ca :
Label1.Caption := ExpandEnv('%username%');
//ou meme
Label1.Caption := ExpandEnv('%temp%\monfichier.txt');

**cincap** · 28/11/2018, 13h01

Bonjour à toutes et à tous,

@guillemouze, merci pour ta réponse,

J'avais bidouillé ceci en attendant ta réaction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
function fGetUserName(): String;
var
vlDomainName : array[0..30] of char;
vlSize : ^DWORD;
begin
New(vlSize);
vlSize^ := 30;
ExpandEnvironmentStrings(PChar('%USERNAME%'), vlDomainName, vlSize^);
Dispose(vlSize);
Result := vlDomainName;
end;

Utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
procedure TForm1.Button7Click(Sender: TObject);
begin
Edit1.Text := fGetUserName();
end;

Je pense qu'il y a assez d'exemples à exploiter même avec le fichier *.bat qui permet beaucoup de chose, Andnotor avait aussi une solution qui ne peut être testée que sur un pc et serveur.

https://www.developpez.net/forums/d6...n/#post3984824

@+,

cincap

**ShaiLeTroll** · 28/11/2018, 14h27

cincap , tu pas en total hors sujet et je ne crois pas que Pierrot67 s'y retrouve, lui qui avait juste un problème entre la gestion d'un user local, en workgroup ou sur un domaine (genre Domaine\User ou User.Domain)

**cincap** · 28/11/2018, 14h51

@ ShaiLeTroll, je restais sur la réponse de pierrot67 qui avait écrit suite à la description du contenu de mon fichier *.bat et je proposais différents test:

Quand à l'Username, Microsoft avait bien décidé de le ramener à 5 caractères depuis au moins Seven.

merci à tous

je vais faire encore plus simple existe-t-il un script pour delphi equivalent à un script .bat du style

Code :
echo %username%

car ce script fonctionne sur un pc en domaine je récupère bien l'utilisateur qui vient de se loguer.

Ceci étant, il faudrait que pierrot67 se manifeste au cas ou il aurait trouvé une autre solution et répondre aux questions poséees.

@+,

cincap

Récupérer le nom d'utilisateur d'un pc connecté en réseau

Delphi

Discussions similaires

Partager

Partager