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

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Codes sources à télécharger Delphi Discussion :

TSystemInfo - Une Classe pour la collecte d’informations système Windows


Sujet :

Codes sources à télécharger Delphi

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre expérimenté
    Avatar de XeGregory
    Homme Profil pro
    Passionné par la programmation
    Inscrit en
    Janvier 2017
    Messages
    633
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : Passionné par la programmation
    Secteur : High Tech - Matériel informatique

    Informations forums :
    Inscription : Janvier 2017
    Messages : 633
    Billets dans le blog
    1
    Par défaut TSystemInfo - Une Classe pour la collecte d’informations système Windows
    Je vous propose un nouvel élément à utiliser : TSystemInfo - Une Classe pour la collecte d’informations système Windows

    TSystemInfo est une classe qui centralise la collecte d’informations système Windows (Windows 10/11) en combinant WMI et API Windows.

    Nom : Capture d'écran 2025-10-31 175407.png
Affichages : 334
Taille : 120,1 Ko

    Principales méthodes exposées :

    • GetOSInfo : nom, version, build, architecture, date d’installation.
    • GetCPUInfo : nom, fabricant, identifiant, nombre de cœurs/threads, fréquence max.
    • GetMemoryInfo : mémoire totale/disponible, pourcentage d’utilisation, mémoire virtuelle.
    • GetDiskInfo : lecteurs logiques (taille et espace libre formatés).
    • GetNetworkAdapters : adaptateurs IP activés, adresses MAC/IP, passerelle, DNS.
    • GetGPUInfo : contrôleurs vidéo, RAM adaptateur formatée.
    • GetBIOSInfo / GetBaseBoardInfo / GetBatteryInfo — informations matérielles.
    • GetUsers : comptes locaux.
    • GetHotFixes : correctifs installés.
    • GetPrinters / GetServices / GetProcesses : imprimantes, services (état, mode démarrage), processus en cours.
    • GetTimeZoneAndLocale : fuseau horaire et locale utilisateur.
    • GetPowerPlan : GUID du plan d’alimentation actif.
    • GetHostAndUptime : nom d’hôte et durée de fonctionnement (WMI ou fallback).


    TSystemInfo :

    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
    unit SystemInfo;
     
    interface
     
    uses
      System.Classes,
      System.SysUtils,
      Winapi.Windows,
      System.Variants,
      ComObj,
      ActiveX,
      Registry,
      TlHelp32,
      Winapi.ShellAPI;
     
    type
      /// Classe pour récupérer des informations système via WMI et API Windows.
      TSystemInfo = class
      private
        function WMIQuerySingleValue(const WMIClass, PropName: string): string;
        function WMIQueryList(const WMIClass: string; const Props: array of string)
          : TStringList;
        function GetUptimeFromWMI: string;
        function GetActivePowerSchemeGUID: string;
      public
        constructor Create;
        destructor Destroy; override;
     
        function GetOSInfo: TStringList;
        function GetCPUInfo: TStringList;
        function GetMemoryInfo: TStringList;
        function GetDiskInfo: TStringList;
        function GetNetworkAdapters: TStringList;
        function GetGPUInfo: TStringList;
     
        function GetBIOSInfo: TStringList;
        function GetBaseBoardInfo: TStringList;
        function GetBatteryInfo: TStringList;
        function GetUsers: TStringList;
        function GetHotFixes: TStringList;
        function GetHostAndUptime: TStringList;
     
        function GetPrinters: TStringList;
        function GetServices: TStringList;
        function GetProcesses: TStringList;
        function GetTimeZoneAndLocale: TStringList;
        function GetPowerPlan: TStringList;
     
        class function FormatSize(Bytes: UInt64): string; static;
      end;
     
    implementation
     
    { TSystemInfo }
     
    constructor TSystemInfo.Create;
    begin
      inherited;
      // Initialisation COM pour WMI
      CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
    end;
     
    destructor TSystemInfo.Destroy;
    begin
      // Libération COM
      CoUninitialize;
      inherited;
    end;
     
    /// Exécute une requête WMI et retourne la première valeur trouvée.
    function TSystemInfo.WMIQuerySingleValue(const WMIClass,
      PropName: string): string;
    var
      WbemLocator, WMIService, Items, Item: OLEVariant;
      Enum: IEnumVARIANT;
      Value: Cardinal;
    begin
      Result := '';
      try
        WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
        WMIService := WbemLocator.ConnectServer('.', 'root\cimv2', '', '');
        Items := WMIService.ExecQuery(Format('SELECT %s FROM %s',
          [PropName, WMIClass]), 'WQL', 0);
        Enum := IUnknown(Items._NewEnum) as IEnumVARIANT;
        if Enum.Next(1, Item, Value) = 0 then
        begin
          try
            Result := VarToStr(Item.Properties_.Item(PropName).Value);
          finally
            Item := Unassigned;
          end;
        end;
      except
        Result := '';
      end;
    end;
     
    /// Exécute une requête WMI et construit une TStringList (chaque ligne = propriétés concaténées).
    function TSystemInfo.WMIQueryList(const WMIClass: string;
      const Props: array of string): TStringList;
    var
      WbemLocator, WMIService, Items, Item: OLEVariant;
      Enum: IEnumVARIANT;
      Value: Cardinal;
      i: Integer;
      s: string;
    begin
      Result := TStringList.Create;
      try
        WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
        WMIService := WbemLocator.ConnectServer('.', 'root\cimv2', '', '');
        Items := WMIService.ExecQuery(Format('SELECT * FROM %s', [WMIClass]),
          'WQL', 0);
        Enum := IUnknown(Items._NewEnum) as IEnumVARIANT;
        while Enum.Next(1, Item, Value) = 0 do
        begin
          s := '';
          for i := Low(Props) to High(Props) do
          begin
            try
              s := s + Props[i] + ': ' +
                VarToStr(Item.Properties_.Item(Props[i]).Value);
            except
              s := s + Props[i] + ': ';
            end;
            if i < High(Props) then
              s := s + ' ; ';
          end;
          Result.Add(s);
          Item := Unassigned;
        end;
      except
        on E: Exception do
        begin
          Result.Clear;
          Result.Add('Erreur: ' + E.Message);
        end;
      end;
    end;
     
    /// Informations processeur (WMI)
    function TSystemInfo.GetCPUInfo: TStringList;
    var
      sl: TStringList;
    begin
      sl := TStringList.Create;
      try
        sl.Add('Nom: ' + WMIQuerySingleValue('Win32_Processor', 'Name'));
        sl.Add('Fabricant: ' + WMIQuerySingleValue('Win32_Processor',
          'Manufacturer'));
        sl.Add('Identifiant Processeur: ' + WMIQuerySingleValue('Win32_Processor',
          'ProcessorId'));
        sl.Add('Nombre Coeurs: ' + WMIQuerySingleValue('Win32_Processor',
          'NumberOfCores'));
        sl.Add('Nombre Threads Logiques: ' + WMIQuerySingleValue('Win32_Processor',
          'NumberOfLogicalProcessors'));
        sl.Add('Frequence Max MHz: ' + WMIQuerySingleValue('Win32_Processor',
          'MaxClockSpeed'));
        Result := sl;
      except
        sl.Free;
        raise;
      end;
    end;
     
    /// Informations disques logiques (WMI) + conversion taille.
    function TSystemInfo.GetDiskInfo: TStringList;
    var
      i: Integer;
      line: string;
      parts: TArray<string>;
      dev, fs, sizeStr, freeStr, vol: string;
      sizeNum, freeNum: Int64;
    begin
      Result := WMIQueryList('Win32_LogicalDisk WHERE DriveType=3',
        ['DeviceID', 'FileSystem', 'Size', 'FreeSpace', 'VolumeName']);
      try
        i := 0;
        while i < Result.Count do
        begin
          line := Result[i];
          parts := line.Split([' ; ']);
     
          dev := '';
          fs := '';
          sizeStr := '';
          freeStr := '';
          vol := '';
          if Length(parts) > 0 then
            dev := parts[0];
          if Length(parts) > 1 then
            fs := parts[1];
          if Length(parts) > 2 then
            if parts[2].StartsWith('Size:') then
              sizeStr := Trim(parts[2].Substring(Length('Size:')));
          if Length(parts) > 3 then
            if parts[3].StartsWith('FreeSpace:') then
              freeStr := Trim(parts[3].Substring(Length('FreeSpace:')));
          if Length(parts) > 4 then
            vol := parts[4];
     
          sizeNum := 0;
          freeNum := 0;
          if (sizeStr <> '') and TryStrToInt64(sizeStr, sizeNum) then
            sizeStr := TSystemInfo.FormatSize(UInt64(sizeNum));
          if (freeStr <> '') and TryStrToInt64(freeStr, freeNum) then
            freeStr := TSystemInfo.FormatSize(UInt64(freeNum));
     
          Result[i] :=
            Format('Lecteur: %s ; Système Fichiers: %s ; Taille: %s ; Espace Libre: %s ; Etiquette: %s',
            [dev, fs, sizeStr, freeStr, vol]);
          Inc(i);
        end;
      except
        // Ne pas lever d'exception ici : retourner ce qui est disponible.
      end;
    end;
     
    /// Informations GPU (WMI) ; conversion RAM adaptateur si possible.
    function TSystemInfo.GetGPUInfo: TStringList;
    var
      i, j: Integer;
      line: string;
      parts: TArray<string>;
      ramStr: string;
      ramNum: Int64;
    begin
      Result := WMIQueryList('Win32_VideoController', ['Name', 'DriverVersion',
        'AdapterRAM', 'VideoProcessor']);
      try
        i := 0;
        while i < Result.Count do
        begin
          line := Result[i];
          parts := line.Split([' ; ']);
          for j := 0 to High(parts) do
          begin
            if parts[j].StartsWith('AdapterRAM:') then
            begin
              ramStr := Trim(parts[j].Substring(Length('AdapterRAM:')));
              ramNum := 0;
              if (ramStr <> '') and TryStrToInt64(ramStr, ramNum) then
                parts[j] := 'RAM Adaptateur: ' + TSystemInfo.FormatSize
                  (UInt64(ramNum));
            end;
            // Remplacer libellés anglais
            parts[j] := parts[j].Replace('Name:', 'Nom:').Replace('DriverVersion:',
              'Version Driver:').Replace('VideoProcessor:', 'Processeur Video:');
          end;
          Result[i] := String.Join(' ; ', parts);
          Inc(i);
        end;
      except
      end;
    end;
     
    /// Informations mémoire via GlobalMemoryStatusEx
    function TSystemInfo.GetMemoryInfo: TStringList;
    var
      TotalPhys, AvailPhys: UInt64;
      memStatus: TMemoryStatusEx;
      sl: TStringList;
    begin
      sl := TStringList.Create;
      memStatus.dwLength := SizeOf(memStatus);
      if GlobalMemoryStatusEx(memStatus) then
      begin
        TotalPhys := memStatus.ullTotalPhys;
        AvailPhys := memStatus.ullAvailPhys;
        sl.Add('Memoire Physique Totale: ' + FormatSize(TotalPhys));
        sl.Add('Memoire Physique Disponible: ' + FormatSize(AvailPhys));
        sl.Add('Chargement Memoire Pourcent: ' +
          IntToStr(memStatus.dwMemoryLoad) + '%');
        sl.Add('Memoire Virtuelle Totale: ' +
          FormatSize(memStatus.ullTotalVirtual));
        sl.Add('Memoire Virtuelle Disponible: ' +
          FormatSize(memStatus.ullAvailVirtual));
      end
      else
        sl.Add('Global Memory StatusEx a échoué');
      Result := sl;
    end;
     
    /// Adaptateurs réseau (WMI)
    function TSystemInfo.GetNetworkAdapters: TStringList;
    var
      i: Integer;
    begin
      Result := WMIQueryList
        ('Win32_NetworkAdapterConfiguration WHERE IPEnabled=True',
        ['Description', 'MACAddress', 'IPAddress', 'IPSubnet', 'DefaultIPGateway',
        'DNSHostName']);
      i := 0;
      while i < Result.Count do
      begin
        Result[i] := Result[i].Replace('Description:', 'Description:')
          .Replace('MACAddress:', 'Adresse MAC:').Replace('IPAddress:',
          'Adresse IP:').Replace('IPSubnet:', 'Masque:')
          .Replace('DefaultIPGateway:', 'PasserelleParDefaut:')
          .Replace('DNSHostName:', 'NomDNS:');
        Inc(i);
      end;
    end;
     
    /// Informations OS (WMI)
    function TSystemInfo.GetOSInfo: TStringList;
    var
      sl: TStringList;
      csd, buildNumber, caption, version, arch: string;
    begin
      sl := TStringList.Create;
      caption := WMIQuerySingleValue('Win32_OperatingSystem', 'Caption');
      version := WMIQuerySingleValue('Win32_OperatingSystem', 'Version');
      csd := WMIQuerySingleValue('Win32_OperatingSystem', 'CSDVersion');
      buildNumber := WMIQuerySingleValue('Win32_OperatingSystem', 'BuildNumber');
      arch := WMIQuerySingleValue('Win32_OperatingSystem', 'OSArchitecture');
      sl.Add('Nom OS: ' + caption);
      sl.Add('Version OS: ' + version);
      sl.Add('Num Build: ' + buildNumber);
      sl.Add('Architecture: ' + arch);
      sl.Add('CSD Version: ' + csd);
      sl.Add('Numero Serie OS: ' + WMIQuerySingleValue('Win32_OperatingSystem',
        'SerialNumber'));
      sl.Add('Date Installation: ' + WMIQuerySingleValue('Win32_OperatingSystem',
        'InstallDate'));
      Result := sl;
    end;
     
    /// BIOS (WMI)
    function TSystemInfo.GetBIOSInfo: TStringList;
    var
      i: Integer;
    begin
      Result := WMIQueryList('Win32_BIOS', ['Manufacturer', 'Name', 'Version',
        'SerialNumber', 'ReleaseDate']);
      i := 0;
      while i < Result.Count do
      begin
        Result[i] := Result[i].Replace('Manufacturer:', 'Fabricant:')
          .Replace('Name:', 'Nom:').Replace('SerialNumber:', 'Numero Serie:')
          .Replace('ReleaseDate:', 'DateSortie:');
        Inc(i);
      end;
    end;
     
    /// Carte mère (Win32_BaseBoard)
    function TSystemInfo.GetBaseBoardInfo: TStringList;
    var
      i: Integer;
    begin
      Result := WMIQueryList('Win32_BaseBoard', ['Manufacturer', 'Product',
        'SerialNumber', 'Version']);
      i := 0;
      while i < Result.Count do
      begin
        Result[i] := Result[i].Replace('Manufacturer:', 'Fabricant:')
          .Replace('Product:', 'Produit:').Replace('SerialNumber:',
          'Numero Serie:');
        Inc(i);
      end;
    end;
     
    /// Batterie (Win32_Battery)
    function TSystemInfo.GetBatteryInfo: TStringList;
    var
      i: Integer;
    begin
      Result := WMIQueryList('Win32_Battery',
        ['Name', 'Status', 'EstimatedChargeRemaining', 'BatteryStatus']);
      i := 0;
      while i < Result.Count do
      begin
        Result[i] := Result[i].Replace('Name:', 'Nom:').Replace('Status:', 'Etat:')
          .Replace('EstimatedChargeRemaining:', 'Charge Restante Pourcent:')
          .Replace('BatteryStatus:', 'Statut Batterie:');
        Inc(i);
      end;
    end;
     
    /// Utilisateurs locaux (WMI)
    function TSystemInfo.GetUsers: TStringList;
    var
      i: Integer;
    begin
      Result := WMIQueryList('Win32_UserAccount WHERE LocalAccount=True',
        ['Name', 'FullName', 'SID', 'Status']);
      i := 0;
      while i < Result.Count do
      begin
        Result[i] := Result[i].Replace('Name:', 'Nom:').Replace('FullName:',
          'Nom Complet:').Replace('Status:', 'Etat:');
        Inc(i);
      end;
    end;
     
    /// Correctifs (WMI)
    function TSystemInfo.GetHotFixes: TStringList;
    var
      i: Integer;
    begin
      Result := WMIQueryList('Win32_QuickFixEngineering',
        ['HotFixID', 'Description', 'InstalledOn']);
      i := 0;
      while i < Result.Count do
      begin
        Result[i] := Result[i].Replace('HotFixID:', 'Correctif ID:')
          .Replace('InstalledOn:', 'Installe Le:');
        Inc(i);
      end;
    end;
     
    /// Parse LastBootUpTime et calcule l'uptime en secondes
    function TSystemInfo.GetUptimeFromWMI: string;
    var
      sBoot: string;
      bootDate: TDateTime;
      bootDateStr: string;
      osUpSeconds: Int64;
      nowDT: TDateTime;
    begin
      Result := '';
      sBoot := WMIQuerySingleValue('Win32_OperatingSystem', 'LastBootUpTime');
      if sBoot = '' then
        Exit;
      try
        if Length(sBoot) >= 14 then
        begin
          bootDateStr := Copy(sBoot, 1, 14);
          bootDate := EncodeDate(StrToInt(Copy(bootDateStr, 1, 4)),
            StrToInt(Copy(bootDateStr, 5, 2)), StrToInt(Copy(bootDateStr, 7, 2))) +
            EncodeTime(StrToInt(Copy(bootDateStr, 9, 2)),
            StrToInt(Copy(bootDateStr, 11, 2)),
            StrToInt(Copy(bootDateStr, 13, 2)), 0);
          nowDT := Now;
          osUpSeconds := Trunc((nowDT - bootDate) * 24 * 3600);
          Result := Format
            ('Dernier Demarrage: %s ; Duree Fonctionnement Secondes: %d',
            [DateTimeToStr(bootDate), osUpSeconds]);
        end;
      except
        Result := '';
      end;
    end;
     
    /// Nom hôte et uptime (WMI puis fallback)
    function TSystemInfo.GetHostAndUptime: TStringList;
    var
      sl: TStringList;
      host: array [0 .. MAX_COMPUTERNAME_LENGTH + 1] of Char;
      sizeName: DWORD;
      uptimeStr: string;
    begin
      sl := TStringList.Create;
      sizeName := Length(host);
      if GetComputerName(host, sizeName) then
        sl.Add('Nom Hote: ' + string(host))
      else
        sl.Add('Nom Hote: (echec)');
     
      uptimeStr := GetUptimeFromWMI;
      if uptimeStr <> '' then
        sl.Add(uptimeStr)
      else
        sl.Add('Duree Fonctionnement Secondes: ' +
          UIntToStr(GetTickCount64 div 1000));
     
      Result := sl;
    end;
     
    /// Imprimantes (WMI)
    function TSystemInfo.GetPrinters: TStringList;
    var
      WbemLocator, WMIService, Items, Item: OLEVariant;
      Enum: IEnumVARIANT;
      Value: Cardinal;
      s: string;
    begin
      Result := TStringList.Create;
      try
        try
          WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
          WMIService := WbemLocator.ConnectServer('.', 'root\cimv2', '', '');
          Items := WMIService.ExecQuery
            ('SELECT Name, SystemName, DriverName, PortName, Default FROM Win32_Printer',
            'WQL', 0);
          Enum := IUnknown(Items._NewEnum) as IEnumVARIANT;
          while Enum.Next(1, Item, Value) = 0 do
          begin
            try
              s := Format
                ('Nom: %s ; Systeme: %s ; Pilote: %s ; Port: %s ; Defaut: %s',
                [VarToStr(Item.Name), VarToStr(Item.SystemName),
                VarToStr(Item.DriverName), VarToStr(Item.PortName),
                VarToStr(Item.Default)]);
            except
              s := 'Imprimante: (erreur lecture propriétés)';
            end;
            Result.Add(s);
            Item := Unassigned;
          end;
        except
          on E: Exception do
            Result.Add('Erreur récupération imprimantes: ' + E.Message);
        end;
      except
        Result.Free;
        raise;
      end;
    end;
     
    /// Services (WMI)
    function TSystemInfo.GetServices: TStringList;
    var
      WbemLocator, WMIService, Items, Item: OLEVariant;
      Enum: IEnumVARIANT;
      Value: Cardinal;
      Name, displayName, state, startMode: string;
    begin
      Result := TStringList.Create;
      try
        try
          WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
          WMIService := WbemLocator.ConnectServer('.', 'root\cimv2', '', '');
          Items := WMIService.ExecQuery
            ('SELECT Name, DisplayName, State, StartMode FROM Win32_Service',
            'WQL', 0);
          Enum := IUnknown(Items._NewEnum) as IEnumVARIANT;
          while Enum.Next(1, Item, Value) = 0 do
          begin
            try
              name := VarToStr(Item.Name);
              displayName := VarToStr(Item.displayName);
              state := VarToStr(Item.state);
              startMode := VarToStr(Item.startMode);
              Result.Add
                (Format('Nom Service: %s ; Nom Affiche: %s ; Etat: %s ; Mode Demarrage: %s',
                [name, displayName, state, startMode]));
            except
              Result.Add('Service: (erreur lecture propriétés)');
            end;
            Item := Unassigned;
          end;
        except
          on E: Exception do
            Result.Add('Erreur récupération services: ' + E.Message);
        end;
      except
        Result.Free;
        raise;
      end;
    end;
     
    /// Processus en cours (snapshot ToolHelp)
    function TSystemInfo.GetProcesses: TStringList;
    var
      hSnap: THandle;
      pe: TProcessEntry32;
    begin
      Result := TStringList.Create;
      hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
      if hSnap = INVALID_HANDLE_VALUE then
      begin
        Result.Add('Erreur creation snapshot processus');
        Exit;
      end;
      try
        pe.dwSize := SizeOf(pe);
        if Process32First(hSnap, pe) then
        begin
          repeat
            Result.Add(Format('PID: %d ; Nom: %s ; Threads: %d',
              [pe.th32ProcessID, string(pe.szExeFile), pe.cntThreads]));
          until not Process32Next(hSnap, pe);
        end
        else
          Result.Add('Aucun processus trouvé ou droits insuffisants');
      finally
        CloseHandle(hSnap);
      end;
    end;
     
    /// Fuseau horaire et locale (API Windows)
    function TSystemInfo.GetTimeZoneAndLocale: TStringList;
    var
      tzInfo: TTimeZoneInformation;
      langID: LCID;
      localeName: array [0 .. LOCALE_NAME_MAX_LENGTH] of Char;
      res: Cardinal;
    begin
      Result := TStringList.Create;
      if GetTimeZoneInformation(tzInfo) <> DWORD(TIME_ZONE_ID_INVALID) then
        Result.Add('Fuseau Horaire: ' + String(tzInfo.StandardName))
      else
        Result.Add('Fuseau Horaire: (echec)');
     
      langID := GetUserDefaultLCID;
      res := LCIDToLocaleName(langID, localeName, LOCALE_NAME_MAX_LENGTH + 1, 0);
      if res <> 0 then
        Result.Add('Locale: ' + string(PChar(@localeName[0])))
      else
        Result.Add('Locale: (echec)');
     
      Result.Add('Langue Utilisateur ID: ' + IntToStr(GetUserDefaultLangID));
    end;
     
    /// Récupère le GUID du plan d'alimentation actif (powrprof.dll)
    function TSystemInfo.GetActivePowerSchemeGUID: string;
    type
      TPowerGetActiveScheme = function(UserRootPowerKey: Pointer;
        var SchemeGuid: TGUID): DWORD; stdcall;
    var
      PowerGetActiveScheme: TPowerGetActiveScheme;
      hPowrProf: THandle;
      guid: TGUID;
    begin
      Result := '';
      hPowrProf := GetModuleHandle('powrprof.dll');
      if hPowrProf = 0 then
        Exit;
      @PowerGetActiveScheme := GetProcAddress(hPowrProf, 'PowerGetActiveScheme');
      if not Assigned(PowerGetActiveScheme) then
        Exit;
      if PowerGetActiveScheme(nil, guid) = 0 then
      begin
        Result := GUIDToString(guid);
        if (Length(Result) > 0) and (Result[1] = '{') and
          (Result[Length(Result)] = '}') then
          Result := Copy(Result, 2, Length(Result) - 2);
      end;
    end;
     
    /// Wrapper pour renvoyer le GUID du plan d'alimentation actif
    function TSystemInfo.GetPowerPlan: TStringList;
    var
      guid: string;
    begin
      Result := TStringList.Create;
      guid := GetActivePowerSchemeGUID;
      if guid <> '' then
        Result.Add('GUID Plan Alimentatio nActif: ' + guid)
      else
        Result.Add('GUID Plan Alimentation Actif: (non disponible)');
    end;
     
    /// Convertit octets en chaîne lisible
    class function TSystemInfo.FormatSize(Bytes: UInt64): string;
    const
      KB = 1024;
      MB = KB * 1024;
      GB = MB * 1024;
    begin
      if Bytes >= GB then
        Result := FormatFloat('0.## GB', Bytes / GB)
      else if Bytes >= MB then
        Result := FormatFloat('0.## MB', Bytes / MB)
      else if Bytes >= KB then
        Result := FormatFloat('0.## KB', Bytes / KB)
      else
        Result := Format('%d octets', [Bytes]);
    end;
     
    end.
    Exemple d’utilisation de TSystemInfo (console) :

    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
    uses
      System.SysUtils,
      System.Classes,
      System.Math,
      SystemInfo in 'SystemInfo.pas';
     
    procedure GetInfoSystem(const Titre: string; SL: TStringList);
    var
      i: Integer;
    begin
      Writeln('--- ' + Titre + ' ---');
      if (SL = nil) or (SL.Count = 0) then
      begin
        Writeln('(aucune donnée)');
        Exit;
      end;
      for i := 0 to SL.Count - 1 do
        Writeln(SL[i]);
      Writeln;
    end;
     
    var
      SI: TSystemInfo;
      SL: TStringList;
    begin
      try
        SI := TSystemInfo.Create;
        try
          // Informations OS
          SL := SI.GetOSInfo;
          try
            GetInfoSystem('Informations OS', SL);
          finally
            SL.Free;
          end;
     
          // Processeur
          SL := SI.GetCPUInfo;
          try
            GetInfoSystem('Processeur', SL);
          finally
            SL.Free;
          end;
     
          // Mémoire
          SL := SI.GetMemoryInfo;
          try
            GetInfoSystem('Mémoire', SL);
          finally
            SL.Free;
          end;
     
          // Disques
          SL := SI.GetDiskInfo;
          try
            GetInfoSystem('Disques', SL);
          finally
            SL.Free;
          end;
     
          // Réseau
          SL := SI.GetNetworkAdapters;
          try
            GetInfoSystem('Adaptateurs réseau', SL);
          finally
            SL.Free;
          end;
     
          // GPU
          SL := SI.GetGPUInfo;
          try
            GetInfoSystem('Carte graphique', SL);
          finally
            SL.Free;
          end;
     
          // Services (extrait pour lisibilité)
          SL := SI.GetServices;
          try
            Writeln('--- Services ---');
            if SL.Count = 0 then
              Writeln('(aucun service)')
            else
              for var i := 0 to Min(29, SL.Count - 1) do
                Writeln(SL[i]);
            Writeln;
          finally
            SL.Free;
          end;
     
          // Processus
          SL := SI.GetProcesses;
          try
            GetInfoSystem('Processus en cours', SL);
          finally
            SL.Free;
          end;
     
          // Hôte et uptime
          SL := SI.GetHostAndUptime;
          try
            GetInfoSystem('Hôte et durée de fonctionnement', SL);
          finally
            SL.Free;
          end;
     
        finally
          SI.Free;
        end;
      except
        on E: Exception do
          Writeln('Exception: ', E.ClassName, ' - ', E.Message);
      end;
     
      Writeln('Appuyez sur Entrée pour quitter...');
      Readln;
    end.
    Compatible avec Delphi 2009 et versions ultérieures (Delphi XE2 … Delphi 10.x / 11.x / ...)
    On ne peut pas faire confiance à un code qu'on n'a pas entièrement écrit soi‑même, et encore moins à celui qu'on a écrit entièrement. :aie:

  2. #2
    Membre Expert

    Homme Profil pro
    Retraité
    Inscrit en
    Novembre 2007
    Messages
    3 535
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 64
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : Novembre 2007
    Messages : 3 535
    Par défaut
    Tout ce que tu proposes ici est très intéressant !
    Ce serait bien si tu proposais tous ces éléments sur un site qui reprendrait l'ensemble où retrouver chaque élément dans le futur.
    J-L aka Papy pour les amis

  3. #3
    Membre Expert
    Avatar de Charly910
    Homme Profil pro
    Ingénieur TP
    Inscrit en
    Décembre 2006
    Messages
    2 545
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur TP
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : Décembre 2006
    Messages : 2 545
    Par défaut
    Bonjour,

    bravo pour ton unité SystemInfo. J'aime bien les unités qui fonctionnent à la fois sur D7 et D12CE. Je l'ai modifiée et testée sur les 2 :

    TestSystem2.zip

    A+
    Charly

  4. #4
    Membre expérimenté
    Avatar de XeGregory
    Homme Profil pro
    Passionné par la programmation
    Inscrit en
    Janvier 2017
    Messages
    633
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : Passionné par la programmation
    Secteur : High Tech - Matériel informatique

    Informations forums :
    Inscription : Janvier 2017
    Messages : 633
    Billets dans le blog
    1
    Par défaut
    Citation Envoyé par Charly910 Voir le message
    Je l'ai modifiée et testée sur les 2
    Bonjour Charly,

    Super, merci pour l’ajustement D7.

    Je vais certainement l’adapter afin d’extraire uniquement les données désirées :

    Exemple :

    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
    unit SystemInfo.Core;
     
    interface
     
    uses
      System.SysUtils, System.Variants, Winapi.Windows, Winapi.ActiveX, ComObj;
     
    type
      TProcessorInfo = record
      private
        FInitialized: Boolean;
        FName: string;
        FManufacturer: string;
        FProcessorId: string;
        FNumberOfCores: string;
        FNumberOfLogicalProcessors: string;
        FMaxClockSpeed: string;
        procedure InitIfNeeded;
        function WMIQuerySingleValue(const WMIClass, PropName: string): string;
        function GetName: string;
        function GetManufacturer: string;
        function GetID: string;
        function GetNumberCores: string;
        function GetNumberThreads: string;
        function GetMaxFrequency: string;
      public
        property Name: string read GetName;
        property Manufacturer: string read GetManufacturer;
        property ID: string read GetID;
        property NumberCores: string read GetNumberCores;
        property NumberThreads: string read GetNumberThreads;
        property MaxFrequency: string read GetMaxFrequency;
        procedure Refresh;
      end;
     
    var
      Processor: TProcessorInfo;
     
    implementation
     
    { TProcessorInfo }
     
    function TProcessorInfo.WMIQuerySingleValue(const WMIClass, PropName: string): string;
    var
      WbemLocator, WMIService, Items, Item: OLEVariant;
      Enum: IEnumVARIANT;
      Value: Cardinal;
    begin
      Result := '';
      try
        WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
        WMIService := WbemLocator.ConnectServer('.', 'root\cimv2', '', '');
        Items := WMIService.ExecQuery(Format('SELECT %s FROM %s', [PropName, WMIClass]), 'WQL', 0);
        Enum := IUnknown(Items._NewEnum) as IEnumVARIANT;
        if Enum.Next(1, Item, Value) = 0 then
        begin
          Result := VarToStr(Item.Properties_.Item(PropName).Value);
          Item := Unassigned;
        end;
      except
        Result := '';
      end;
    end;
     
    procedure TProcessorInfo.InitIfNeeded;
    begin
      if FInitialized then
        Exit;
     
      FName := WMIQuerySingleValue('Win32_Processor', 'Name');
      FManufacturer := WMIQuerySingleValue('Win32_Processor', 'Manufacturer');
      FProcessorId := WMIQuerySingleValue('Win32_Processor', 'ProcessorId');
      FNumberOfCores := WMIQuerySingleValue('Win32_Processor', 'NumberOfCores');
      FNumberOfLogicalProcessors := WMIQuerySingleValue('Win32_Processor', 'NumberOfLogicalProcessors');
      FMaxClockSpeed := WMIQuerySingleValue('Win32_Processor', 'MaxClockSpeed');
     
      FInitialized := True;
    end;
     
    function TProcessorInfo.GetName: string;
    begin
      InitIfNeeded;
      Result := FName;
    end;
     
    function TProcessorInfo.GetManufacturer: string;
    begin
      InitIfNeeded;
      Result := FManufacturer;
    end;
     
    function TProcessorInfo.GetID: string;
    begin
      InitIfNeeded;
      Result := FProcessorId;
    end;
     
    function TProcessorInfo.GetNumberCores: string;
    begin
      InitIfNeeded;
      Result := FNumberOfCores;
    end;
     
    function TProcessorInfo.GetNumberThreads: string;
    begin
      InitIfNeeded;
      Result := FNumberOfLogicalProcessors;
    end;
     
    function TProcessorInfo.GetMaxFrequency: string;
    begin
      InitIfNeeded;
      Result := FMaxClockSpeed;
    end;
     
    procedure TProcessorInfo.Refresh;
    begin
      FInitialized := False;
    end;
     
    { Gestion COM pour l'unité }
    var
      GCoInitialized: Boolean = False;
      GCoInitResult: HRESULT = S_OK;
     
    initialization
      GCoInitResult := CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
      if Succeeded(GCoInitResult) then
        GCoInitialized := True
      else
        GCoInitialized := False;
     
    finalization
      if GCoInitialized then
        CoUninitialize;
     
    end.
    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
    begin
      try
        try
          Writeln('Nom : ', Processor.Name);
          Writeln('Fabricant : ', Processor.Manufacturer);
          Writeln('Identifiant Processeur : ', Processor.ID);
          Writeln('Nombre Coeurs : ', Processor.NumberCores);
          Writeln('Nombre Threads : ', Processor.NumberThreads);
          Writeln('Frequence Max MHz : ', Processor.MaxFrequency);
        except
          on E: Exception do
          begin
            Writeln('Erreur : ', E.ClassName, ' - ', E.Message);
          end;
        end;
        Writeln;
        Writeln('Appuyez sur Entrée pour quitter...');
        Readln;
      except
        on E: Exception do
          Writeln('Erreur : ', E.ClassName, ' - ', E.Message);
      end;
    end.
    Nom : Capture d'écran 2025-11-02 113025.png
Affichages : 133
Taille : 27,5 Ko
    On ne peut pas faire confiance à un code qu'on n'a pas entièrement écrit soi‑même, et encore moins à celui qu'on a écrit entièrement. :aie:

  5. #5
    Rédacteur/Modérateur
    Avatar de Andnotor
    Inscrit en
    Septembre 2008
    Messages
    5 988
    Détails du profil
    Informations personnelles :
    Localisation : Autre

    Informations forums :
    Inscription : Septembre 2008
    Messages : 5 988
    Par défaut
    WMIService pourrait être initialisé une seule fois dans le constructeur et CoInitializeEx plutôt dans un class constructor.

    Les gestionnaires d'exception sont trop nombreux (voire inutiles).
    Si tu as des erreurs c'est parce que tu veux récupérer n'importe quelle propriété sous forme de chaîne alors que certaines sont des tableaux. Teste VarIsArray et le cas échéant récupères les valeurs par une boucle de 0 à VarArrayHighBound, tu n'auras plus d'exception

    Tu devrais passer une TStrings en paramètre plutôt qu'en retourner une. Ca éviterait de devoir la détruire entre chaque appel et permettrait de retourner un booléen à la place.
    Cette liste en résultat n'est d'ailleurs pas toujours bien gérée. Si GetCPUInfo devait se planter, Result serait indéfini et pourrait provoquer une VA chez l'appelant (Dans les faits ça n'arrivera pas puisque WMIQuerySingleValue est déjà protégé ; c'est un des gestionnaires inutiles).

    Tout est formaté pour de l'affichage et ça c'est très dommage, ça rend d'autres types de traitement très compliqués. Tu devrais juste retourner une liste propriété=valeur ce qui permettrait ensuite cette simple lecture NbCores := sl.Values['NumberOfCores'].ToInteger;. Libre au développeur final de les afficher (dans la langue et le formatage de son choix).

  6. #6
    Membre expérimenté
    Avatar de XeGregory
    Homme Profil pro
    Passionné par la programmation
    Inscrit en
    Janvier 2017
    Messages
    633
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : Passionné par la programmation
    Secteur : High Tech - Matériel informatique

    Informations forums :
    Inscription : Janvier 2017
    Messages : 633
    Billets dans le blog
    1
    Par défaut
    Citation Envoyé par Andnotor Voir le message
    WMIService pourrait être initialisé une seule fois dans le constructeur et CoInitializeEx plutôt dans un class constructor.

    Les gestionnaires d'exception sont trop nombreux (voire inutiles).
    Si tu as des erreurs c'est parce que tu veux récupérer n'importe quelle propriété sous forme de chaîne alors que certaines sont des tableaux. Teste VarIsArray et le cas échéant récupères les valeurs par une boucle de 0 à VarArrayHighBound, tu n'auras plus d'exception

    Tu devrais passer une TStrings en paramètre plutôt qu'en retourner une. Ca éviterait de devoir la détruire entre chaque appel et permettrait de retourner un booléen à la place.
    Cette liste en résultat n'est d'ailleurs pas toujours bien gérée. Si GetCPUInfo devait se planter, Result serait indéfini et pourrait provoquer une VA chez l'appelant (Dans les faits ça n'arrivera pas puisque WMIQuerySingleValue et déjà protégé ; c'est un des gestionnaires inutiles).

    Tout est formaté pour de l'affichage et ça c'est très dommage, ça rend d'autres types de traitement très compliqués. Tu devrais juste retourner une liste propriété=valeur ce qui permettrait ensuite cette simple lecture NbCores := sl.Values['NumberOfCores'].ToInteger;. Libre au développeur final de les afficher (dans la langue et le formatage de son choix).
    J'avais commencé à coder une petite application permettant de lire les classes

    Nom : Capture d'écran 2025-11-02 172952.png
Affichages : 120
Taille : 111,4 Ko
    On ne peut pas faire confiance à un code qu'on n'a pas entièrement écrit soi‑même, et encore moins à celui qu'on a écrit entièrement. :aie:

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 2
    Dernier message: 02/06/2006, 21h17
  2. une class pour WriteExcel
    Par dam-s dans le forum Langage
    Réponses: 2
    Dernier message: 28/01/2006, 16h24
  3. Y a t'il une classe pour transactions FTP
    Par Devil666 dans le forum Entrée/Sortie
    Réponses: 6
    Dernier message: 04/07/2005, 13h27
  4. thread dédié à une classe pour lui "donner vie"
    Par Dje14 dans le forum Threads & Processus
    Réponses: 5
    Dernier message: 02/06/2005, 17h46
  5. Réponses: 7
    Dernier message: 08/01/2005, 14h24

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo