type
  TLayeredWindow = class abstract
  private
    type
      TLayeredWindowProc = reference to procedure(aControl: TWinControl; aCanvas: TD2DCanvas; aRect: TRect);
    class function DoDraw(aControl: TWinControl; aBmp: TBitmap; aRect: TRect; aProc: TLayeredWindowProc; aOptions: TLayeredOptions; aOpacity :byte) :boolean; inline;
    class function Resize(aBoundsRect: TRect; aImageRect: TRect; aOptions: TLayeredOptions): TRect; inline;
  public
    class function Draw(aControl: TWinControl; aProc: TLayeredWindowProc; aOptions: TLayeredOptions = []; aOpacity :byte = 255) :boolean; overload;
    class function Draw(aControl: TWinControl; aImage :TWICImage; aProc: TLayeredWindowProc = nil; aOptions: TLayeredOptions = []; aOpacity :byte = 255) :boolean; overload;
    {$IF CompilerVersion >= 34.0}
    class function Draw(aControl: TWinControl; aImageCollection :TImageCollection; aImageName: string; aProc: TLayeredWindowProc = nil; aOptions: TLayeredOptions = []; aOpacity :byte = 255) :boolean; overload;
    class function Draw(aControl: TWinControl; aImageCollection :TImageCollection; aImageIndex: integer; aProc: TLayeredWindowProc = nil; aOptions: TLayeredOptions = []; aOpacity :byte = 255) :boolean; overload;
    {$ENDIF}
    class function DrawFromFileName(aControl: TWinControl; const aFileName :string; aProc: TLayeredWindowProc = nil; aOptions: TLayeredOptions = []; aOpacity :byte = 255) :boolean;
    class function DrawFromResource(aControl: TWinControl; aInstance :THandle; const aResName :string; aProc: TLayeredWindowProc = nil; aOptions: TLayeredOptions = []; aOpacity :byte = 255) :boolean;
    class function DrawFromStream(aControl: TWinControl; aStream :TStream; aProc: TLayeredWindowProc = nil; aOptions: TLayeredOptions = []; aOpacity :byte = 255) :boolean;
  end;

 
procedure TForm1.FormCreate(Sender: TObject);
begin
  TLayeredWindow.DrawFromResource(Self, hInstance, 'SplashScreen', [loOpaque]);
end;

procedure TForm1.DrawNextStep(const aText: string);
begin
  TLayeredWindow.DrawFromResource(Self, hInstance, 'SplashScreen',
    procedure(aControl: TWinControl; aCanvas: TD2DCanvas; aRect: TRect)
    begin
      aCanvas.Font.Assign(Font);
      aCanvas.Brush.Style := bsClear;
      aCanvas.TextOut(ScaleValue(200), aRect.Bottom -ScaleValue(100), aText);
    end, [loOpaque]);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  DrawNextStep('Chargement des bibliothèques...');
  // Action
  DrawNextStep('Initialisation...');
  // Action
  DrawNextStep('Démarrage...');
  // Action
end;

 
procedure TForm1.DrawOverlays(aControl: TWinControl);
begin
  TLayeredWindow.Draw(aControl, ImageCollection1, 'Delphi', nil, [], 30);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  DrawOverlays(StaticText1);
  DrawOverlays(StaticText2);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TLayeredWindow.DrawFromFileName(
    Panel1, 'D:\Delphi\Test\LayeredWindows\Car.webp',
    procedure(aControl: TWinControl; aCanvas: TD2DCanvas; aRect: TRect)
    var
      TextFormat: IDWriteTextFormat;
      TextLayout: IDWriteTextLayout;
      Brush: ID2D1SolidColorBrush;
    begin
      if Sold then
      begin
        const Matrix = TD2DMatrix3X2F.Rotation(-30, aRect.CenterPoint.X, aRect.CenterPoint.Y);
        aCanvas.RenderTarget.SetTransform(Matrix);
 
        DWriteFactory.CreateTextFormat('Tahoma', nil, DWRITE_FONT_WEIGHT_BOLD, DWRITE_FONT_STYLE_NORMAL, DWRITE_FONT_STRETCH_NORMAL, 60, 'fr', TextFormat);
        DWriteFactory.CreateTextLayout('Vendu', 5, TextFormat, aRect.Width, aRect.Height, TextLayout);
 
        TextLayout.SetTextAlignment(DWRITE_TEXT_ALIGNMENT_CENTER);
        TextLayout.SetParagraphAlignment(DWRITE_PARAGRAPH_ALIGNMENT_CENTER);
 
        aCanvas.RenderTarget.CreateSolidColorBrush(D2D1ColorF(clRed, 0.5), nil, Brush);
        aCanvas.RenderTarget.DrawTextLayout(D2D1PointF(0,0), TextLayout, Brush);
      end;
    end, [loProportional, loCenter]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TLayeredWindow.Draw(Panel1,
    procedure(aControl: TWinControl; aCanvas: TD2DCanvas; aRect: TRect)
    var
      Badge: ID2D1RoundedRectangleGeometry;
      Params: TD2D1LayerParameters;
      Layer: ID2D1Layer;
    begin
      const Image = ImageCollection1.GetSourceImage(2, aRect.Width, aRect.Height);
      const RoundedRect = D2D1RoundedRect(D2D1RectF(0, 0, aRect.Right, aRect.Bottom), aRect.Width/2, aRect.Height/2);
 
      D2DFactory.CreateRoundedRectangleGeometry(RoundedRect, Badge);
 
      Params.ContentBounds     := D2D1RectF(-INFINITE, -INFINITE, INFINITE, INFINITE);
      Params.geometricMask     := Badge;
      Params.MaskAntiAliasMode := D2D1_ANTIALIAS_MODE_PER_PRIMITIVE;
      Params.maskTransform     := TD2D1Matrix3X2F.Identity;
      Params.Opacity           := 1;
      Params.OpacityBrush      := nil;
      Params.LayerOptions      := D2D1_LAYER_OPTIONS_NONE;
 
      aCanvas.RenderTarget.CreateLayer(nil, Layer);
      aCanvas.RenderTarget.PushLayer(Params, Layer);
 
      aCanvas.StretchDraw(aRect, Image);
      aCanvas.Brush.Style := bsClear;
      aCanvas.Ellipse(aRect);
 
      aCanvas.RenderTarget.PopLayer;
    end);
end;

type
  TCheckBox = class(Vcl.StdCtrls.TCheckBox)
  protected
    procedure CreateWnd; override;
    procedure Paint;
    procedure WndProc(var Message: TMessage); override;
  end;
 
{ TCheckBox }
 
procedure TCheckBox.CreateWnd;
begin
  inherited;
  Paint;
end;
 
procedure TCheckBox.Paint;
begin
  TLayeredWindow.Draw(Self,
    procedure(aControl: TWinControl; aCanvas: TD2DCanvas; aRect: TRect)
    var
      Brush: ID2D1SolidColorBrush;
    begin
      var Text := IfThen(Checked, '👍', '👎') +Caption;
 
      // Fond "presque" transparent pour que le texte soit cliquable (entre les lettres)
      aCanvas.RenderTarget.CreateSolidColorBrush(D2D1ColorF(clNone, 0.01), nil, Brush);
      aCanvas.RenderTarget.FillRectangle(D2D1RectF(0, 0, aRect.Right, aRect.Bottom), Brush);
 
      aCanvas.Font.Assign(Font);
      aCanvas.Font.Color := IfThen(Checked, clHighlight, clBlack);
      aCanvas.Brush.Style := bsClear;
      aCanvas.TextRect(aRect, Text, [tfVerticalCenter, tfSingleLine]);
 
      if Focused then
      begin
        aCanvas.Pen.Color := clBlack;
        aCanvas.Pen.Style := psDot;
        SystemParametersInfo(SPI_GETFOCUSBORDERWIDTH, 0, @aCanvas.Pen.Width, 0);
        aCanvas.Rectangle(aRect);
      end;
    end, [loProportional, loOpaque]);
end;
 
procedure TCheckBox.WndProc(var Message: TMessage);
begin
  inherited;
 
  if (Message.Msg = CM_CHANGED) or
     (Message.Msg = WM_SetFocus) or
     (Message.Msg = WM_KillFocus) then Paint;
end;

uses System.TypInfo, Generics.Defaults;
 
type
  TWakeType = (wtSingle, wtAll);
  TWakeCompare = (wcEqual, wcNotEqual, wcBelow, wcAbove, wcIn, wcOut, wcCustom);
 
  TWakeValue<T> = record
  private type
    TWakeCompareProc = reference to function(const aValue: T) :boolean;
  private
    FCompareValue: T;
    FAutoReset: boolean;
    FValue: T;
    FWakeType: TWakeType;
    Lock: TObject;
    procedure SetValue(const aValue: T);
    function GetValue: T;
    procedure CheckIsOrdinal; inline;
    procedure Normalize(var aLowerValue, aUpperValue: T);
    function DoWait(const aValue1, aValue2: T; aCompare: TWakeCompare; aCompareProc: TWakeCompareProc; aTimeOut: cardinal): boolean;
  public
    property Value :T read GetValue write SetValue;
    class operator Initialize(out Dest: TWakeValue<T>);
    class operator finalize(var Dest: TWakeValue<T>);
    class operator Assign(var Dest: TWakeValue<T>; const [ref] Source: TWakeValue<T>);
    function Wait(aTimeout :cardinal = INFINITE) :boolean; overload;
    function Wait(aCompareProc: TWakeCompareProc; aTimeout :cardinal = INFINITE) :boolean; overload;
    function WaitEquals(const aWaitValue: T; aTimeout :cardinal = INFINITE) :boolean;
    function WaitBelow(const aBelowValue: T; aTimeout :cardinal = INFINITE) :boolean;
    function WaitAbove(const aAboveValue: T; aTimeout :cardinal = INFINITE) :boolean;
    function WaitIn(aLowerValue, aUpperValue: T; aTimeout :cardinal = INFINITE) :boolean;
    function WaitOut(aLowerValue, aUpperValue: T; aTimeout :cardinal = INFINITE) :boolean;
    constructor Create(const aValue, aCompareValue :T; aAutoReset: boolean = TRUE; aWakeType :TWakeType = wtAll); overload;
    constructor Create(const aValue :T; aAutoReset: boolean = TRUE; aWakeType :TWakeType = wtAll); overload;
  end;
 
{ TWakeValue<T> }
 
class operator TWakeValue<T>.Initialize(out Dest: TWakeValue<T>);
begin
  Assert(SizeOf(T) <= 8, 'SizeOf(T) exceeds 8');
 
  Dest.FValue := Default(T);
  Dest.FCompareValue := Default(T);
  Dest.FAutoReset := TRUE;
  Dest.FWakeType := wtAll;
  Dest.Lock := TObject.Create;
end;
 
class operator TWakeValue<T>.finalize(var Dest: TWakeValue<T>);
begin
  Dest.Lock.Free;
end;
 
class operator TWakeValue<T>.Assign(var Dest: TWakeValue<T>; const [ref] Source: TWakeValue<T>);
begin
  TMonitor.Enter(Source.Lock);
  TMonitor.Enter(Dest.Lock);
  try
    Dest.FCompareValue := Source.FCompareValue;
    Dest.FValue := Source.FValue;
    Dest.FWakeType := Source.FWakeType;
    Dest.FAutoReset := Source.FAutoReset;
  finally
    TMonitor.Exit(Source.Lock);
    TMonitor.Exit(Dest.Lock);
  end;
end;
 
constructor TWakeValue<T>.Create(const aValue, aCompareValue: T; aAutoReset: boolean; aWakeType: TWakeType);
begin
  FCompareValue := aCompareValue;
  FAutoReset := aAutoReset;
  FWakeType := aWakeType;
 
  SetValue(aValue);
end;
 
constructor TWakeValue<T>.Create(const aValue: T; aAutoReset: boolean; aWakeType: TWakeType);
begin
  Create(aValue, aValue, aAutoReset, aWakeType);
end;
 
procedure TWakeValue<T>.Normalize(var aLowerValue, aUpperValue: T);
begin
  if TComparer<T>.Default.Compare(aLowerValue, aUpperValue) > 0 then
  begin
    const Tmp = aUpperValue;
    aUpperValue := aLowerValue;
    aLowerValue := Tmp;
  end;
end;
 
procedure TWakeValue<T>.CheckIsOrdinal;
begin
  Assert(PTypeInfo(TypeInfo(T))^.Kind in [tkInteger, tkInt64, tkFloat, tkChar, tkWChar, tkEnumeration], '<T> is not a valid type (numeric, char or enumeration)');
end;
 
function TWakeValue<T>.GetValue: T;
begin
  TMonitor.Enter(Lock);
  try
    Result := FValue;
  finally
    TMonitor.Exit(Lock);
  end;
end;
 
procedure TWakeValue<T>.SetValue(const aValue: T);
begin
  TMonitor.Enter(Lock);
  try
    if not TEqualityComparer<T>.Default.Equals(FValue, aValue) then
    begin
      FValue := aValue;
 
      if not TEqualityComparer<T>.Default.Equals(FValue, FCompareValue) then
      begin
        case FWakeType of
          wtSingle : WakeByAddressSingle(@FValue);
          wtAll    : WakeByAddressAll(@FValue);
        end;
 
        if FAutoReset then
          FCompareValue := FValue;
      end;
    end;
 
  finally
    TMonitor.Exit(Lock);
  end;
end;
 
function TWakeValue<T>.DoWait(const aValue1, aValue2: T; aCompare: TWakeCompare; aCompareProc: TWakeCompareProc; aTimeOut: cardinal): boolean;
begin
  while TRUE do
  begin
    const Value = GetValue;
    const Res = TComparer<T>.Default.Compare(Value, aValue1);
 
    case aCompare of
      wcEqual    : if Res = 0 then Exit(TRUE);
      wcNotEqual : if Res <> 0 then Exit(TRUE);
      wcBelow    : if Res < 0 then Exit(TRUE);
      wcAbove    : if Res > 0 then Exit(TRUE);
      wcIn       : if (Res >= 0) and (TComparer<T>.Default.Compare(Value, aValue2) <= 0) then Exit(TRUE);
      wcOut      : if (Res < 0) or (TComparer<T>.Default.Compare(Value, aValue2) > 0) then Exit(TRUE);
      wcCustom   : if aCompareProc(Value) then Exit(TRUE);
    end;
 
    if not WaitOnAddress(@FValue, @FValue, SizeOf(T), aTimeout) then Exit(FALSE);
  end;
end;
 
function TWakeValue<T>.WaitEquals(const aWaitValue: T; aTimeout: cardinal): boolean;
begin
  Result := DoWait(aWaitValue, Default(T), wcEqual, nil, aTimeOut);
end;
 
function TWakeValue<T>.WaitAbove(const aAboveValue: T; aTimeout: cardinal): boolean;
begin
  CheckIsOrdinal;
  Result := DoWait(aAboveValue, Default(T), wcAbove, nil, aTimeOut);
end;
 
function TWakeValue<T>.WaitBelow(const aBelowValue: T; aTimeout: cardinal): boolean;
begin
  CheckIsOrdinal;
  Result := DoWait(aBelowValue, Default(T), wcBelow, nil, aTimeOut);
end;
 
function TWakeValue<T>.WaitIn(aLowerValue, aUpperValue: T; aTimeout: cardinal): boolean;
begin
  CheckIsOrdinal;
  Normalize(aLowerValue, aUpperValue);
  Result := DoWait(aLowerValue, aUpperValue, wcIn, nil, aTimeOut);
end;
 
function TWakeValue<T>.WaitOut(aLowerValue, aUpperValue: T; aTimeout: cardinal): boolean;
begin
  CheckIsOrdinal;
  Normalize(aLowerValue, aUpperValue);
  Result := DoWait(aLowerValue, aUpperValue, wcOut, nil, aTimeOut);
end;
 
function TWakeValue<T>.Wait(aTimeout: cardinal): boolean;
var
  CompareValue: T;
begin
  TMonitor.Enter(Lock);
  try
    CompareValue := FCompareValue;
  finally
    TMonitor.Exit(Lock);
  end;
 
  Result := DoWait(CompareValue, Default(T), wcNotEqual, nil, aTimeOut);
end;
 
function TWakeValue<T>.Wait(aCompareProc: TWakeCompareProc; aTimeout :cardinal) :boolean;
begin
  Assert(Assigned(aCompareProc), 'aCompareProc cannot be nil.');
  Result := DoWait(Default(T), Default(T), wcCustom, aCompareProc, aTimeOut);
end;

var
  StatusMsg :TWakeValue<string>;
  SafeOperation :TWakeValue<integer>;
  ErrorMsg :TWakeValue<string>;
 
TMyThread1.Execute;
begin
  StatusMsg.WaitEquals('Success');
  ...
end;
 
TMyThread2.Execute;
begin
  SafeOperation.WaitIn(50, 60);
  ...
end;
 
TMyThread3.Execute;
begin
  ErrorMsg.Wait(function(const aValue: string): boolean
                begin
                  Result := aValue.StartsWith('Error');
                end);
  ...
end;
 
StatusMsg.Value := 'Success';
SafeOperation.Value := 55;
ErrorMsg.Value := 'Error 200';

begin
  if not RunAsService(TService1, Service1) then Exit;
 
  if not Application.DelayInitialize or Application.Installing then
    Application.Initialize;
  Application.CreateForm(TService1, Service1);
  Application.Run;
end.

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.

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.

unit UnitCmdPipeExecutor;
 
interface
 
uses
  System.SysUtils, System.Classes, Winapi.Windows, Vcl.StdCtrls;
 
type
  // Classe utilitaire pour exécuter des commandes via cmd.exe et capturer la sortie
  TCmdPipeExecutor = class
  private
    // Crée les handles de pipe nécessaires pour rediriger stdin/stdout du processus enfant
    function CreatePipeHandles(out ReadStdOut, WriteStdOut, ReadStdIn,
      WriteStdIn: THandle): Boolean;
 
  public
    constructor Create;
    destructor Destroy; override;
 
    // Exécute les commandes passées dans Commands, capture la sortie dans Output et le code de sortie dans ExitCode.
    // HiddenWindow: si True, demande à cacher la fenêtre du processus (STARTF_USESHOWWINDOW + SW_HIDE)
    // UseUtf8: si True, écrit les commandes en UTF-8 et décode la sortie en UTF-8; sinon utilise le jeu de caractères OEM
    // TimeoutMs: délai en ms pour détecter une absence d'activité de sortie; INFINITE signifie aucun timeout
    function ExecuteCmdAndCapture(const Commands: TStrings; out Output: string;
      out ExitCode: DWORD; HiddenWindow: Boolean = True;
      UseUtf8: Boolean = False; TimeoutMs: Cardinal = INFINITE): Boolean;
 
    // Méthode pratique : lit les commandes depuis SourceMemo, exécute, et écrit le résultat dans DestMemo
    procedure ExecuteFromMemo(SourceMemo, DestMemo: TMemo;
      HiddenWindow: Boolean = True; UseUtf8: Boolean = False;
      TimeoutMs: Cardinal = INFINITE);
  end;
 
implementation
 
// Convertit un buffer d'octets interprétés en OEM vers une chaîne WideString Delphi
function OEMBytesToString(const Buffer: Pointer; Count: Integer): string;
var
  WideLen: Integer;
begin
  Result := '';
  if (Buffer = nil) or (Count <= 0) then
    Exit;
 
  // Calcule la longueur nécessaire en WideChar
  WideLen := MultiByteToWideChar(CP_OEMCP, 0, PAnsiChar(Buffer), Count, nil, 0);
  if WideLen > 0 then
  begin
    SetLength(Result, WideLen);
    // Convertit du OEM vers WideChar (Unicode interne Delphi)
    MultiByteToWideChar(CP_OEMCP, 0, PAnsiChar(Buffer), Count,
      PWideChar(Result), WideLen);
  end;
end;
 
// Convertit une chaîne WideString en tableau d'octets selon le code page OEM
// Retourne le nombre d'octets et remplit Bytes
function WideStringToOEMBytes(const S: string; out Bytes: TBytes): Integer;
begin
  Result := 0;
  Bytes := nil;
  if S = '' then
    Exit;
 
  // Obtient la longueur nécessaire en octets
  Result := WideCharToMultiByte(CP_OEMCP, 0, PWideChar(S), Length(S), nil, 0,
    nil, nil);
  if Result > 0 then
  begin
    SetLength(Bytes, Result);
    // Remplit le tableau d'octets avec la conversion OEM
    WideCharToMultiByte(CP_OEMCP, 0, PWideChar(S), Length(S), PAnsiChar(Bytes),
      Result, nil, nil);
  end;
end;
 
{ TCmdPipeExecutor }
 
constructor TCmdPipeExecutor.Create;
begin
  inherited Create;
end;
 
destructor TCmdPipeExecutor.Destroy;
begin
  inherited;
end;
 
// Crée deux pipes anonymes : un pour capturer stdout/err du processus enfant (ReadStdOut/WriteStdOut)
// et un pour fournir stdin au processus enfant (ReadStdIn/WriteStdIn).
// Les handles destinés au processus enfant restent héritables; les handles parentaux sont marqués non-héritables.
function TCmdPipeExecutor.CreatePipeHandles(out ReadStdOut, WriteStdOut,
  ReadStdIn, WriteStdIn: THandle): Boolean;
var
  SecAttr: SECURITY_ATTRIBUTES;
begin
  Result := False;
  ReadStdOut := 0;
  WriteStdOut := 0;
  ReadStdIn := 0;
  WriteStdIn := 0;
 
  ZeroMemory(@SecAttr, SizeOf(SecAttr));
  SecAttr.nLength := SizeOf(SecAttr);
  SecAttr.bInheritHandle := True;
  // Permet l'héritage des handles au processus enfant
  SecAttr.lpSecurityDescriptor := nil;
 
  // Pipe pour stdout/err du processus enfant
  if not CreatePipe(ReadStdOut, WriteStdOut, @SecAttr, 0) then
    Exit;
 
  // Pipe pour stdin du processus enfant
  if not CreatePipe(ReadStdIn, WriteStdIn, @SecAttr, 0) then
  begin
    // en cas d'échec, fermer le premier pipe et sortir
    CloseHandle(ReadStdOut);
    CloseHandle(WriteStdOut);
    Exit;
  end;
 
  // Empêcher le parent d'hériter des handles côté lecture/écriture qui sont uniquement destinés à l'enfant
  SetHandleInformation(ReadStdOut, HANDLE_FLAG_INHERIT, 0);
  SetHandleInformation(WriteStdIn, HANDLE_FLAG_INHERIT, 0);
 
  Result := True;
end;
 
// Exécute les commandes et capture la sortie
function TCmdPipeExecutor.ExecuteCmdAndCapture(const Commands: TStrings;
  out Output: string; out ExitCode: DWORD; HiddenWindow: Boolean;
  UseUtf8: Boolean; TimeoutMs: Cardinal): Boolean;
var
  ReadStdOut, WriteStdOut, ReadStdIn, WriteStdIn: THandle;
  StartInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  CmdLine: array [0 .. 255] of Char;
  Buffer: array [0 .. 4095] of Byte;
  BytesRead, BytesWritten: DWORD;
  CmdText: string;
  OutStream: TMemoryStream;
  WaitRes, LastTick: DWORD;
  Utf8Bytes: TBytes;
  OemBytes: TBytes;
  OemLen: Integer;
  TmpBytes: TBytes;
begin
  Result := False;
  Output := '';
  ExitCode := DWORD($FFFFFFFF);
  ReadStdOut := 0;
  WriteStdOut := 0;
  ReadStdIn := 0;
  WriteStdIn := 0;
 
  // Crée les handles de pipe nécessaires
  if not CreatePipeHandles(ReadStdOut, WriteStdOut, ReadStdIn, WriteStdIn) then
    Exit;
 
  try
    // Initialise STARTUPINFO en précisant les handles pour stdin/stdout/stderr
    ZeroMemory(@StartInfo, SizeOf(StartInfo));
    StartInfo.cb := SizeOf(StartInfo);
    StartInfo.hStdInput := ReadStdIn;
    StartInfo.hStdOutput := WriteStdOut;
    StartInfo.hStdError := WriteStdOut;
    StartInfo.dwFlags := STARTF_USESTDHANDLES;
    if HiddenWindow then
    begin
      // Si demandé, indique au système de cacher la fenêtre du processus
      StartInfo.dwFlags := StartInfo.dwFlags or STARTF_USESHOWWINDOW;
      StartInfo.wShowWindow := SW_HIDE;
    end;
 
    ZeroMemory(@ProcInfo, SizeOf(ProcInfo));
 
    // Prépare la ligne de commande pour lancer cmd.exe en mode silencieux (/Q)
    StrPCopy(CmdLine, 'cmd.exe /Q');
 
    // Crée le processus enfant en héritant des handles nécessaires
    if not CreateProcess(nil, CmdLine, nil, nil, True, CREATE_NO_WINDOW, nil,
      nil, StartInfo, ProcInfo) then
      Exit;
 
    // Le parent ferme ses copies des handles que seul l'enfant doit utiliser
    if ReadStdIn <> 0 then
    begin
      CloseHandle(ReadStdIn);
      ReadStdIn := 0;
    end;
    if WriteStdOut <> 0 then
    begin
      CloseHandle(WriteStdOut);
      WriteStdOut := 0;
    end;
 
    try
      // Prépare le texte des commandes : si vide, écrit un message; s'assure qu'il y a un 'exit'
      CmdText := Commands.Text;
      if CmdText = '' then
        CmdText := 'echo Aucun commande' + sLineBreak;
      if Pos('exit' + sLineBreak, LowerCase(CmdText)) = 0 then
        CmdText := CmdText + 'exit' + sLineBreak;
 
      // Écrit les commandes dans stdin de l'enfant en UTF-8 ou en OEM selon UseUtf8
      BytesWritten := 0;
      if UseUtf8 then
      begin
        Utf8Bytes := TEncoding.UTF8.GetBytes(CmdText);
        if Length(Utf8Bytes) > 0 then
          WriteFile(WriteStdIn, Utf8Bytes[0], Length(Utf8Bytes),
            BytesWritten, nil);
      end
      else
      begin
        OemLen := WideStringToOEMBytes(CmdText, OemBytes);
        if OemLen > 0 then
          WriteFile(WriteStdIn, OemBytes[0], OemLen, BytesWritten, nil);
      end;
 
      // Ferme le côté écriture du pipe stdin pour signaler EOF au processus enfant
      if WriteStdIn <> 0 then
      begin
        CloseHandle(WriteStdIn);
        WriteStdIn := 0;
      end;
 
      // Lit la sortie produite par le processus enfant dans un TMemoryStream
      OutStream := TMemoryStream.Create;
      try
        LastTick := GetTickCount;
        repeat
          BytesRead := 0;
          // Tente de lire des données disponibles
          if ReadFile(ReadStdOut, Buffer, SizeOf(Buffer), BytesRead, nil) then
          begin
            if BytesRead > 0 then
            begin
              // Stocke les données lues et réinitialise le timer d'activité
              OutStream.Write(Buffer, BytesRead);
              LastTick := GetTickCount;
            end;
          end
          else
            BytesRead := 0;
 
          // Attend un court laps de temps pour savoir si le processus est terminé
          WaitRes := WaitForSingleObject(ProcInfo.hProcess, 50);
 
          // Si timeout configuré et pas d'activité depuis TimeoutMs, termine le processus
          if (TimeoutMs <> INFINITE) and (GetTickCount - LastTick > TimeoutMs)
          then
          begin
            TerminateProcess(ProcInfo.hProcess, DWORD($FFFFFFFD));
            raise Exception.Create('Timeout: no activity from process');
          end;
        until (BytesRead = 0) and (WaitRes <> WAIT_TIMEOUT);
 
        // Assure que le processus est terminé et récupère son code de sortie
        WaitForSingleObject(ProcInfo.hProcess, INFINITE);
        GetExitCodeProcess(ProcInfo.hProcess, ExitCode);
 
        // Conversion du contenu du stream en chaîne selon l'encodage demandé
        if OutStream.Size > 0 then
        begin
          SetLength(TmpBytes, OutStream.Size);
          Move(OutStream.Memory^, TmpBytes[0], OutStream.Size);
 
          if UseUtf8 then
          begin
            Output := TEncoding.UTF8.GetString(TmpBytes);
          end
          else
          begin
            Output := OEMBytesToString(@TmpBytes[0], Length(TmpBytes));
          end;
        end
        else
          Output := '';
 
        Result := True;
      finally
        OutStream.Free;
      end;
    finally
      // Ferme les handles du processus
      CloseHandle(ProcInfo.hProcess);
      CloseHandle(ProcInfo.hThread);
    end;
  finally
    // S'assure de fermer tous les handles ouverts (sécurise contre les fuites)
    if ReadStdOut <> 0 then
      CloseHandle(ReadStdOut);
    if WriteStdOut <> 0 then
      CloseHandle(WriteStdOut);
    if ReadStdIn <> 0 then
      CloseHandle(ReadStdIn);
    if WriteStdIn <> 0 then
      CloseHandle(WriteStdIn);
  end;
end;
 
// Méthode utilitaire pour exécuter des commandes depuis un TMemo source et afficher la sortie dans un TMemo destination
procedure TCmdPipeExecutor.ExecuteFromMemo(SourceMemo, DestMemo: TMemo;
  HiddenWindow: Boolean; UseUtf8: Boolean; TimeoutMs: Cardinal);
var
  OutStr: string;
  ExitCode: DWORD;
begin
  if (SourceMemo = nil) or (DestMemo = nil) then
    Exit;
 
  DestMemo.Lines.BeginUpdate;
  try
    DestMemo.Lines.Clear;
    DestMemo.Lines.Add('--- Execution started ---');
 
    // Appel principal qui exécute les commandes et capture la sortie
    if ExecuteCmdAndCapture(SourceMemo.Lines, OutStr, ExitCode, HiddenWindow,
      UseUtf8, TimeoutMs) then
    begin
      // Uniformise les sauts de ligne pour l'affichage dans TMemo
      OutStr := StringReplace(OutStr, #10, sLineBreak, [rfReplaceAll]);
      DestMemo.Lines.Add(OutStr);
      DestMemo.Lines.Add(Format('--- Execution finished (Exit code: %d) ---',
        [ExitCode]));
    end
    else
      DestMemo.Lines.Add('Erreur: impossible de lancer cmd.exe.');
  finally
    DestMemo.Lines.EndUpdate;
  end;
end;
 
end.

uses
  UnitCmdPipeExecutor, System.Classes, Vcl.StdCtrls;
 
procedure TForm1.ButtonRunClick(Sender: TObject);
var
  Executor: TCmdPipeExecutor;
  Commands: TStringList;
  Output: string;
  ExitCode: DWORD;
begin
  Executor := TCmdPipeExecutor.Create;
  Commands := TStringList.Create;
  try
    // Exemple : liste de commandes batch
    Commands.Add('echo Début du script');
    Commands.Add('dir C:\Windows');        // commande montrant la sortie
    Commands.Add('echo Fin du script');
 
    // Exécute via cmd.exe, fenêtre cachée, encodage OEM (UseUtf8 = False), timeout 10s
    if Executor.ExecuteCmdAndCapture(Commands, Output, ExitCode, True, False, 10000) then
    begin
      ShowMessage(Format('Sortie (%d octets) - ExitCode=%d'#13#10'%s', [Length(Output), ExitCode, Output]));
    end
    else
      ShowMessage('Erreur: impossible de lancer cmd.exe.');
  finally
    Commands.Free;
    Executor.Free;
  end;
end;

procedure TForm1.ButtonRunFromMemoClick(Sender: TObject);
var
  Executor: TCmdPipeExecutor;
begin
  Executor := TCmdPipeExecutor.Create;
  try
    // SourceMemo contient les commandes (une par ligne)
    // DestMemo affichera la sortie et le code de retour
    Executor.ExecuteFromMemo(SourceMemo, DestMemo, True, False, 15000);
  finally
    Executor.Free;
  end;
end;

var
  Executor: TCmdPipeExecutor;
  Cmds: TStringList;
  OutStr: string;
  Code: DWORD;
begin
  Executor := TCmdPipeExecutor.Create;
  Cmds := TStringList.Create;
  try
    Cmds.Add('chcp 65001');                // optionnel : passe la console en UTF-8
    Cmds.Add('echo Café et accents: éàê');
    Cmds.Add('exit');
    if Executor.ExecuteCmdAndCapture(Cmds, OutStr, Code, True, True, 5000) then
      Memo1.Lines.Text := OutStr
    else
      Memo1.Lines.Text := 'Erreur d''exécution';
  finally
    Cmds.Free;
    Executor.Free;
  end;
end;

unit LinkExplorerCore;
 
interface
 
uses
  System.Net.HttpClient, System.Net.HttpClientComponent, System.SysUtils,
  System.Classes,
  RegularExpressions, Generics.Collections, Vcl.Forms, Vcl.StdCtrls,
  Vcl.ComCtrls;
 
type
  // TLinkExplorer: classe principale pour explorer un site web,
  // détecter les liens, images et documents, et les afficher dans des
  // composants VCL (TListBox, TTreeView, TLabel).
  TLinkExplorer = class
  private
    // Dictionnaire de liens visités pour éviter les boucles et les doublons.
    VisitedLinks: TDictionary<string, Boolean>;
    // Compteur total de liens parcourus.
    TotalLinks: Integer;
    // Compteur total de fichiers (images + documents) ajoutés à l'arbre.
    FileCount: Integer;
    // Indicateur pour arrêter proprement l'exploration depuis l'UI.
    StopProcess: Boolean;
 
    // Récupère le contenu HTML d'une URL et le retourne comme string.
    function GetWebContent(const URL: string): string;
 
    // Extrait les URLs des balises <a href="..."> du HTML.
    // BaseURL est utilisé pour construire des URLs relatives.
    procedure ExtractLinks(const HTML: string; BaseURL: string;
      var LinkList: TStringList);
 
    // Extrait les sources médias (<img src=...> et liens de type pdf/html/css).
    // Remplit deux listes distinctes: ImageList et DocList.
    procedure ExtractMediaSources(const HTML: string; BaseURL: string;
      var ImageList, DocList: TStringList);
 
    // Ajoute les fichiers trouvés (images/documents) au TTreeView fourni.
    // Met aussi à jour le label indiquant le nombre total de fichiers.
    procedure AddFilesToTreeView(ImageList, DocList: TStringList;
      TreeView: TTreeView; FileLabel: TLabel);
 
    // Fonction récursive qui explore les liens jusqu'à une profondeur donnée.
    // Met à jour la ListBox (liste de pages parcourues), le TreeView (fichiers),
    // et les labels de compteurs.
    procedure ExploreLinksRecursive(const URL: string; ListBox: TListBox;
      TreeView: TTreeView; LabelCounter, FileLabel: TLabel; Depth: Integer);
  public
    // Démarre l'exploration depuis une URL, initialise les variables internes.
    // MaxDepth = profondeur maximale d'exploration (1 = seul la page initiale).
    procedure ExploreLinks(const URL: string; ListBox: TListBox;
      TreeView: TTreeView; LabelCounter, FileLabel: TLabel; MaxDepth: Integer);
 
    // Demande l'arrêt de l'exploration en cours (l'exploration vérifie StopProcess).
    procedure StopExploration;
  end;
 
implementation
 
uses
  System.IOUtils;
 
procedure TLinkExplorer.StopExploration;
begin
  // Indique au processus récursif qu'il doit s'arrêter dès que possible.
  StopProcess := True;
end;
 
function TLinkExplorer.GetWebContent(const URL: string): string;
var
  Client: TNetHTTPClient;
  Response: TStringStream;
begin
  // Initialise la valeur de retour vide par défaut.
  Result := '';
 
  // Création d'un client HTTP et d'un flux pour récupérer la réponse.
  Client := TNetHTTPClient.Create(nil);
  Response := TStringStream.Create;
  try
    try
      // Requête GET simple; le contenu renvoyé est placé dans Response.
      Client.Get(URL, Response);
      Result := Response.DataString;
    except
      // En cas d'erreur réseau ou autre, affiche un message dans la console.
      on E: Exception do
        Writeln('Erreur : ' + E.Message);
    end;
  finally
    // Libération des objets pour éviter les fuites mémoire.
    Client.Free;
    Response.Free;
  end;
end;
 
procedure TLinkExplorer.ExtractLinks(const HTML: string; BaseURL: string;
  var LinkList: TStringList);
var
  Regex: TRegEx;
  Match: TMatch;
  Link: string;
begin
  // Regex simple pour capturer href="..." dans les balises <a>.
  Regex := TRegEx.Create('<a\s+(?:[^>]*?\s+)?href="([^"]*)"', [roIgnoreCase]);
  Match := Regex.Match(HTML);
  while Match.Success do
  begin
    Link := Match.Groups[1].Value;
 
    // Normalise les URLs relatives en les transformant en URLs absolues basées sur BaseURL.
    if not Link.StartsWith('http') then
    begin
      if Link.StartsWith('/') then
        Link := BaseURL + Link
      else
        Link := BaseURL + '/' + Link;
    end;
 
    // Ajoute le lien s'il n'a pas encore été visité (évite doublons dans la file).
    if not VisitedLinks.ContainsKey(Link) then
      LinkList.Add(Link);
 
    Match := Match.NextMatch;
  end;
end;
 
// Enlève certains paramètres d'URL (ex : ?w=) pour normaliser les sources médias.
function RemoveURLParams(const URL: string): string;
begin
  Result := URL;
  if Pos('?w=', Result) > 0 then
    Result := Copy(Result, 1, Pos('?w=', Result) - 1);
end;
 
procedure TLinkExplorer.ExtractMediaSources(const HTML: string; BaseURL: string;
  var ImageList, DocList: TStringList);
var
  RegexImg, RegexDoc: TRegEx;
  Match: TMatch;
  Source: string;
begin
  // Regex pour trouver les balises <img src="..."> pointant vers des extensions d'image courantes.
  RegexImg := TRegEx.Create
    ('<img\s+[^>]*src="([^"]+\.(jpg|jpeg|png|gif|bmp|webp|svg))"',
    [roIgnoreCase]);
  Match := RegexImg.Match(HTML);
  while Match.Success do
  begin
    Source := RemoveURLParams(Match.Groups[1].Value);
 
    // Gère les sources relatives.
    if not Source.StartsWith('http') then
      Source := BaseURL + Source;
 
    // Vérifie la présence d'une extension avant d'ajouter.
    if TPath.GetExtension(Source) <> '' then
      ImageList.Add(Source);
 
    Match := Match.NextMatch;
  end;
 
  // Regex pour trouver les liens vers PDF, HTML, CSS (documents intéressants).
  RegexDoc := TRegEx.Create('<a\s+[^>]*href="([^"]+\.(pdf|html|css))"',
    [roIgnoreCase]);
  Match := RegexDoc.Match(HTML);
  while Match.Success do
  begin
    Source := RemoveURLParams(Match.Groups[1].Value);
 
    if not Source.StartsWith('http') then
      Source := BaseURL + Source;
 
    if TPath.GetExtension(Source) <> '' then
      DocList.Add(Source);
 
    Match := Match.NextMatch;
  end;
end;
 
// Recherche un nœud enfant direct d'un parent dont le texte correspond exactement.
// Retourne nil si non trouvé.
function FindTreeNode(ParentNode: TTreeNode; const Text: string): TTreeNode;
var
  Node: TTreeNode;
begin
  Result := nil;
  Node := ParentNode.getFirstChild;
  while Node <> nil do
  begin
    if Node.Text = Text then
    begin
      Result := Node;
      Exit;
    end;
    Node := Node.getNextSibling;
  end;
end;
 
procedure TLinkExplorer.AddFilesToTreeView(ImageList, DocList: TStringList;
  TreeView: TTreeView; FileLabel: TLabel);
var
  i: Integer;
  RootNode, ImagesNode, DocsNode: TTreeNode;
  AddedCount: Integer;
  // Compteurs locaux pour afficher le nombre par section dans le TreeView.
  ImageCount, DocCount: Integer;
  Node: TTreeNode;
begin
  AddedCount := 0;
 
  // Récupère le nœud racine ou le crée si absent.
  RootNode := TreeView.Items.GetFirstNode;
  if RootNode = nil then
    RootNode := TreeView.Items.Add(nil, 'Fichiers trouvés');
 
  // Cherche ou crée le sous-nœud "Images" (on compare seulement le préfixe pour conserver le compteur).
  ImagesNode := nil;
  Node := RootNode.getFirstChild;
  while Node <> nil do
  begin
    if SameText(Copy(Node.Text, 1, Length('Images')), 'Images') then
    begin
      ImagesNode := Node;
      Break;
    end;
    Node := Node.getNextSibling;
  end;
  if ImagesNode = nil then
    ImagesNode := TreeView.Items.AddChild(RootNode, 'Images');
 
  // Cherche ou crée le sous-nœud "Documents".
  DocsNode := nil;
  Node := RootNode.getFirstChild;
  while Node <> nil do
  begin
    if SameText(Copy(Node.Text, 1, Length('Documents')), 'Documents') then
    begin
      DocsNode := Node;
      Break;
    end;
    Node := Node.getNextSibling;
  end;
  if DocsNode = nil then
    DocsNode := TreeView.Items.AddChild(RootNode, 'Documents');
 
  // Ajoute les images sous le nœud "Images" en évitant les doublons.
  for i := 0 to ImageList.Count - 1 do
  begin
    if FindTreeNode(ImagesNode, ImageList[i]) = nil then
    begin
      TreeView.Items.AddChild(ImagesNode, ImageList[i]);
      Inc(AddedCount);
    end;
  end;
 
  // Ajoute les documents sous le nœud "Documents" en évitant les doublons.
  for i := 0 to DocList.Count - 1 do
  begin
    if FindTreeNode(DocsNode, DocList[i]) = nil then
    begin
      TreeView.Items.AddChild(DocsNode, DocList[i]);
      Inc(AddedCount);
    end;
  end;
 
  // Mise à jour du compteur global de fichiers et du label associé.
  if AddedCount > 0 then
  begin
    Inc(FileCount, AddedCount);
    if Assigned(FileLabel) then
      FileLabel.Caption := 'Fichiers trouvés : ' + IntToStr(FileCount);
  end;
 
  // Calcul du nombre d'enfants directs pour ImagesNode (pour afficher un compteur local).
  ImageCount := 0;
  Node := ImagesNode.getFirstChild;
  while Node <> nil do
  begin
    Inc(ImageCount);
    Node := Node.getNextSibling;
  end;
 
  // Calcul du nombre d'enfants directs pour DocsNode.
  DocCount := 0;
  Node := DocsNode.getFirstChild;
  while Node <> nil do
  begin
    Inc(DocCount);
    Node := Node.getNextSibling;
  end;
 
  // Met à jour le texte des nœuds pour inclure le compteur local.
  ImagesNode.Text := 'Images : ' + IntToStr(ImageCount);
  DocsNode.Text := 'Documents : ' + IntToStr(DocCount);
end;
 
procedure TLinkExplorer.ExploreLinksRecursive(const URL: string;
  ListBox: TListBox; TreeView: TTreeView; LabelCounter, FileLabel: TLabel;
  Depth: Integer);
var
  HTMLContent: string;
  Links, Images, Docs: TStringList;
  i: Integer;
begin
  // Vérifie le drapeau d'arrêt demandé par l'UI.
  if StopProcess then
    Exit;
 
  // Si la profondeur est atteinte, arrête la récursion.
  if Depth <= 0 then
    Exit;
 
  // Si l'URL a déjà été visitée, éviter de la revisiter.
  if VisitedLinks.ContainsKey(URL) then
    Exit;
 
  // Marque l'URL comme visitée et incrémente le compteur global.
  VisitedLinks.Add(URL, True);
  Inc(TotalLinks);
 
  // Permet au thread de l'interface utilisateur de traiter les messages
  // (utile si la méthode est appelée depuis le thread principal).
  Application.ProcessMessages;
  if Assigned(LabelCounter) then
    LabelCounter.Caption := 'Liens parcourus : ' + IntToStr(TotalLinks);
 
  // Récupère le contenu HTML de la page.
  HTMLContent := GetWebContent(URL);
  if HTMLContent = '' then
    Exit;
 
  // Création des listes locales pour stocker les résultats d'analyse.
  Links := TStringList.Create;
  Images := TStringList.Create;
  Docs := TStringList.Create;
  try
    // Extrait les liens et médias depuis le contenu HTML.
    ExtractLinks(HTMLContent, URL, Links);
    ExtractMediaSources(HTMLContent, URL, Images, Docs);
 
    // Ajoute l'URL parcourue à la ListBox pour visibilité.
    ListBox.Items.Add(URL);
 
    // Ajoute les images et documents trouvés dans le TreeView.
    AddFilesToTreeView(Images, Docs, TreeView, FileLabel);
 
    // Appel récursif sur chaque lien trouvé tant que la profondeur le permet.
    for i := 0 to Links.Count - 1 do
    begin
      if StopProcess then
        Exit;
      ExploreLinksRecursive(Links[i], ListBox, TreeView, LabelCounter,
        FileLabel, Depth - 1);
    end;
  finally
    // Libération des listes temporaires.
    Links.Free;
    Images.Free;
    Docs.Free;
  end;
end;
 
procedure TLinkExplorer.ExploreLinks(const URL: string; ListBox: TListBox;
  TreeView: TTreeView; LabelCounter, FileLabel: TLabel; MaxDepth: Integer);
begin
  // Initialise l'état interne de l'explorateur pour une nouvelle session.
  VisitedLinks := TDictionary<string, Boolean>.Create;
  TotalLinks := 0;
  FileCount := 0;
  StopProcess := False;
  try
    // Initialise le libellé des fichiers si fourni.
    if Assigned(FileLabel) then
      FileLabel.Caption := 'Fichiers trouvés : 0';
 
    // Lance la recherche récursive depuis l'URL racine.
    ExploreLinksRecursive(URL, ListBox, TreeView, LabelCounter, FileLabel,
      MaxDepth);
  finally
    // Libère le dictionnaire des liens visités.
    VisitedLinks.Free;
  end;
end;
 
end.

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  System.JSON, System.IOUtils, System.Math,
  System.Net.URLClient, System.Net.HttpClient,
  System.Generics.Collections,
  Vcl.Graphics, Vcl.Controls,
  Vcl.Forms, Vcl.Dialogs,
  Vcl.ExtCtrls, Vcl.StdCtrls,
  Vcl.Imaging.pngimage;
 
type
  TForm1 = class(TForm)
    ListPokemon: TListBox;
    Card: TImage;
    procedure FormCreate(Sender: TObject);
    procedure ListPokemonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
 
  private
    // Tableau JSON contenant tous les Pokémon
    FPokemonArray: TJSONArray;
    // Cache en mémoire des images téléchargées
    FImageCache: TDictionary<string, TPngImage>;
    FBackground: TPngImage;
 
    procedure LoadJSONFromURL(const AURL: string);
    procedure CreateCard(Index: Integer);
    function DownloadIm(const URL: string): TPngImage;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ -------------------------------------------------------------------------------
  Initialisation de la form : création du cache et chargement du JSON
  ------------------------------------------------------------------------------- }
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Création du dictionnaire pour stocker TPngImage par URL
  FImageCache := TDictionary<string, TPngImage>.Create;
  // Chargement depuis la ressource nommée "FondCarte"
 
  FBackground := TPngImage.Create;
 
  try
    FBackground.LoadFromResourceName(HInstance, 'Background');
  except
    on E: Exception do
      ShowMessage('Erreur de chargement du fond en ressource : ' + E.Message);
  end;
 
  // Chargement du fichier JSON avec les données des Pokémon
  try
    LoadJSONFromURL('https://tyradex.vercel.app/api/v1/pokemon');
  except
    on E: Exception do
      ShowMessage('Erreur de chargement des données : ' + E.Message);
  end;
end;
 
{ -------------------------------------------------------------------------------
  Libération des ressources : images du cache et tableau JSON
  ------------------------------------------------------------------------------- }
procedure TForm1.FormDestroy(Sender: TObject);
var
  Img: TPngImage;
begin
  // Parcours et libération de chaque image en cache
  for Img in FImageCache.Values do
    Img.Free;
  // Libération du dictionnaire
  FImageCache.Free;
  // Libération du JSON
  FPokemonArray.Free;
 
  FBackground.Free;
  inherited;
end;
 
{ -------------------------------------------------------------------------------
  Sélection d’un Pokémon : création et affichage de sa carte
  ------------------------------------------------------------------------------- }
procedure TForm1.ListPokemonClick(Sender: TObject);
begin
  if ListPokemon.ItemIndex >= 0 then
    CreateCard(ListPokemon.ItemIndex + 1);
end;
 
{ -------------------------------------------------------------------------------
  Lecture du JSON, parsing et remplissage de ListPokemon
  ------------------------------------------------------------------------------- }
procedure TForm1.LoadJSONFromURL(const AURL: string);
var
  HttpClient: THTTPClient;
  Response: IHTTPResponse;
  JSONString: string;
  JSONValue: TJSONValue;
  I: Integer;
  NameObj: TJSONObject;
begin
  HttpClient := THTTPClient.Create;
  try
    // Télécharger le JSON
    Response := HttpClient.Get(AURL);
    if Response.StatusCode <> 200 then
      raise Exception.CreateFmt('Impossible de récupérer le JSON (HTTP %d)', [Response.StatusCode]);
 
    // Récupérer la réponse comme texte UTF-8
    JSONString := Response.ContentAsString(TEncoding.UTF8);
 
    // Parser le JSON
    JSONValue := TJSONObject.ParseJSONValue(JSONString);
    if not Assigned(JSONValue) then
      raise Exception.Create('Impossible de parser le JSON');
 
    // Vérifier que c’est bien un tableau racine
    if JSONValue is TJSONArray then
      FPokemonArray := TJSONArray(JSONValue)
    else
    begin
      JSONValue.Free;
      raise Exception.Create('Le JSON doit être un tableau racine');
    end;
 
    // Remplir la liste des noms
    ListPokemon.Items.BeginUpdate;
    try
      ListPokemon.Clear;
      for I := 0 to FPokemonArray.Count - 1 do
      begin
        NameObj := (FPokemonArray.Items[I] as TJSONObject).GetValue<TJSONObject>('name');
 
        if NameObj.GetValue<string>('fr') = 'MissingNo.' then
          Continue;
 
        ListPokemon.Items.Add(NameObj.GetValue<string>('fr'));
      end;
    finally
      ListPokemon.Items.EndUpdate;
    end;
 
  finally
    HttpClient.Free;
  end;
end;
 
{ -------------------------------------------------------------------------------
  Construction graphique de la carte du Pokémon sélectionné
  ------------------------------------------------------------------------------- }
procedure TForm1.CreateCard(Index: Integer);
var
  Pokemon, Sprites, Stats: TJSONObject;
  Nom, Categorie, SpriteURL, TypesStr, StatsText: string;
  TypesArray: TJSONArray;
  I, yPos, xPos, xOrigin: Integer;
  SurfaceW, SurfaceH: Integer;
  TargetW, TargetH: Integer;
  DestRect: TRect;
  CornerW, CornerH, Margin: Integer;
  RegionLeft, RegionTop, RegionRight, RegionBottom: Integer;
  StatsY: Integer;
  PSprite: TPngImage;
begin
  // Récupération des données JSON
  Pokemon := FPokemonArray.Items[Index] as TJSONObject;
  Nom := Pokemon.GetValue<TJSONObject>('name').GetValue<string>('fr');
  Categorie := Pokemon.GetValue<string>('category');
  Sprites := Pokemon.GetValue<TJSONObject>('sprites');
  SpriteURL := Sprites.GetValue<string>('regular');
  if SpriteURL <> '' then
    PSprite := DownloadIm(SpriteURL)
  else
    PSprite := nil;
 
  // Concaténation des types
  TypesStr := '';
  TypesArray := Pokemon.GetValue<TJSONArray>('types');
  for I := 0 to TypesArray.Count - 1 do
    TypesStr := TypesStr + TypesArray.Items[I].GetValue<string>('name') + ' ';
  TypesStr := TypesStr.Trim;
 
  // Préparation du bitmap
  Card.Picture.Bitmap.SetSize(Card.Width, Card.Height);
  SurfaceW := Card.Picture.Bitmap.Width;
  SurfaceH := Card.Picture.Bitmap.Height;
 
  with Card.Picture.Bitmap.Canvas do
  begin
    // Dessin de l'image de fond DANS la carte (zone arrondie)
    Margin := 10;
    CornerW := 20;
    CornerH := 20;
    RegionLeft := Margin;
    RegionTop := Margin;
    RegionRight := SurfaceW - Margin;
    RegionBottom := SurfaceH - Margin;
 
    // Étire le fond dans le rectangle intérieur arrondi
    SetStretchBltMode(Handle, HALFTONE);
    StretchDraw(Rect(RegionLeft, RegionTop, RegionRight, RegionBottom), FBackground);
 
    // Trace uniquement le contour arrondi
    Pen.Color := clBlack;
    Pen.Width := 3;
    Brush.Style := bsClear;
    RoundRect(RegionLeft, RegionTop, RegionRight, RegionBottom, CornerW, CornerH);
 
    // Passage en mode texte transparent
    SetBkMode(Handle, TRANSPARENT);
    Brush.Style := bsClear; // garantit que l'arrière-plan du texte n'écrase rien
 
    // Position de départ pour le texte
    xOrigin := RegionLeft + 10;
    yPos := RegionTop + 10;
 
    // Nom
    Font.Size := 16;
    Font.Style := [fsBold];
    Font.Color := clBlack;
    TextOut(xOrigin, yPos, Nom);
    Inc(yPos, TextHeight(Nom) + 5);
 
    // Catégorie
    Font.Size := 10;
    Font.Style := [fsBold];
    TextOut(xOrigin, yPos, Categorie);
    Inc(yPos, TextHeight(Categorie) + 5);
 
    // Types
    TextOut(xOrigin, yPos, 'Type(s) : ' + TypesStr);
    Inc(yPos, TextHeight('Type(s) : ' + TypesStr) + 10);
 
    // Sprite centré
    if Assigned(PSprite) then
    begin
      TargetW := (RegionRight - RegionLeft) div 2;
      TargetH := (RegionBottom - RegionTop) div 2;
      xPos := RegionLeft + ((RegionRight - RegionLeft) - TargetW) div 2;
      DestRect := Rect(xPos, yPos, xPos + TargetW, yPos + TargetH);
 
      SetBrushOrgEx(Handle, 0, 0, nil);
      StretchDraw(DestRect, PSprite);
    end;
 
    // Statistiques en bas
    Stats := Pokemon.GetValue<TJSONObject>('stats');
    StatsText := Format('PV: %d   ATK: %d   DEF: %d   VIT: %d',
      [Stats.GetValue<Integer>('hp'), Stats.GetValue<Integer>('atk'),
      Stats.GetValue<Integer>('def'), Stats.GetValue<Integer>('vit')]);
    Font.Size := 10;
    Font.Style := [fsBold];
    StatsY := RegionBottom - Margin - TextHeight(StatsText);
    TextOut(xOrigin, StatsY, StatsText);
  end;
end;
 
{ -------------------------------------------------------------------------------
  Téléchargement ou récupération en cache d’un sprite PNG par URL
  ------------------------------------------------------------------------------- }
function TForm1.DownloadIm(const URL: string): TPngImage;
var
  Http: THTTPClient;
  Response: IHTTPResponse;
  Stream: TMemoryStream;
begin
  // Retourner l’image du cache si elle existe
  if FImageCache.TryGetValue(URL, Result) then
    Exit;
 
  // Sinon télécharger l’image
  Http := THTTPClient.Create;
  Stream := TMemoryStream.Create;
  try
    Response := Http.Get(URL, Stream);
    if Response.StatusCode <> 200 then
      raise Exception.CreateFmt('Erreur HTTP %d : %s', [Response.StatusCode, Response.StatusText]);
 
    // Chargement en mémoire de l’image PNG
    Stream.Position := 0;
    Result := TPngImage.Create;
    Result.LoadFromStream(Stream);
 
    // Stockage dans le cache pour usages futurs
    FImageCache.Add(URL, Result);
  finally
    Http.Free;
    Stream.Free;
  end;
end;
 
end.