System.ClickRecorder.Screenshot.SaveImageSequence.Provider.pas

unit System.ClickRecorder.Screenshot.SaveImageSequence.Provider;

interface

uses
 {$IFDEF MSWINDOWS}
  System.SysUtils,
  System.Win.Registry,
  Winapi.Windows,
  Vcl.Graphics,
  Vcl.Forms;
 {$ENDIF}
 {$IFDEF MACOS}
  FMX.Graphics
 {$ENDIF}

type
  IClickRecorderScreenshotSaveImageSequenceProvider = interface(IInvokable)
    ['{5A6182B8-40C6-4C65-87CA-06CA6C01B06C}']
    function OutDir(const AValue: string): IClickRecorderScreenshotSaveImageSequenceProvider; overload;
    function OutDir(): string; overload;

    procedure SaveImage(ABitmap: Vcl.Graphics.TBitmap);

    function ToZip(): string;
  end;

  TClickRecorderScreenshotSaveImageSequenceProvider = class(TInterfacedObject, IClickRecorderScreenshotSaveImageSequenceProvider)
  strict private
    FOutDir: string;
    FIdxNextFreeNumber: Integer;
    FTempDirToSaveImages: string;
  private
    function GetNextCollisionFreeFilename(const AExtension, APath: string): string;
    procedure OpenRegWorker(const ARootKey: HKEY; AWorker: TProc<TRegistry>);
    function GetAppVersion(): string;
    function GetUserName(): string;
    function CreateSystemInfoFile(): string;
  public const
    CFilenameScreenshots = 'Screenshot_%.06d.%s';
    CFilenameZip = 'ClickRecorder_%s_%s_%s.zip';
  public
    constructor Create();
    destructor Destroy; override;

    function OutDir(const AValue: string): IClickRecorderScreenshotSaveImageSequenceProvider; overload;
    function OutDir(): string; overload;

    procedure SaveImage(ABitmap: Vcl.Graphics.TBitmap);

    function ToZip(): string;
  end;

implementation

uses
  System.Zip,
  System.IOUtils,
  System.SyncObjs,
  Vcl.Imaging.pngimage;

{ TClickRecorderScreenshotSaveImageSequenceProvider }

constructor TClickRecorderScreenshotSaveImageSequenceProvider.Create;
begin
  inherited Create();
  FIdxNextFreeNumber := 0;

  //  Cleanup before...
  FTempDirToSaveImages := TPath.Combine(TPath.GetTempPath, TPath.GetFileNameWithoutExtension(ParamStr(0)));
  if (TDirectory.Exists(FTempDirToSaveImages) and (not TDirectory.IsEmpty(FTempDirToSaveImages))) then
  begin
    TDirectory.Delete(FTempDirToSaveImages, True);
  end;

  TDirectory.CreateDirectory(FTempDirToSaveImages);
end;

destructor TClickRecorderScreenshotSaveImageSequenceProvider.Destroy;
begin
  //...
  inherited;
end;

function TClickRecorderScreenshotSaveImageSequenceProvider.OutDir(const AValue: string): IClickRecorderScreenshotSaveImageSequenceProvider;
begin
  FOutDir := AValue;
  Result := Self;
end;

function TClickRecorderScreenshotSaveImageSequenceProvider.OutDir: string;
begin
  Result := FOutDir;
end;

function TClickRecorderScreenshotSaveImageSequenceProvider.GetNextCollisionFreeFilename(const AExtension, APath: string): string;
begin
  //var IdxNextFreeNumber := 0;
  while TFile.Exists(TPath.Combine(APath, Format(CFilenameScreenshots, [FIdxNextFreeNumber, AExtension]))) do
  begin
    //    Inc(FIdxNextFreeNumber);  I mean, that is not really thread safe...
    //    TInterlocked.Increment() vs. AtomicIncrement vs. InterlockedIncrement
    TInterlocked.Increment(FIdxNextFreeNumber);
  end;

  Result := TPath.Combine(APath, Format(CFilenameScreenshots, [FIdxNextFreeNumber, AExtension]));
end;

procedure TClickRecorderScreenshotSaveImageSequenceProvider.SaveImage(ABitmap: Vcl.Graphics.TBitmap);
begin
  //  png: TPngImage;
  //  var NextFilename := GetNextCollisionFreeFilename('bmp', FTempDirToSaveImages);
  //  ABitmap.SaveToFile(NextFilename);
  //  AppParamValueOutDir := TPath.GetTempPath; //  C:\Users\nt\AppData\Local\Temp\
  //  TPath.GetFileName(ParamStr(0))
  //  AppParamValueOutDir := TPath.GetFileName(ParamStr(0));

  var png := TPngImage.Create;
  try
    png.Assign(ABitmap);
    var NextFilename := GetNextCollisionFreeFilename('png', FTempDirToSaveImages);
    png.SaveToFile(NextFilename);
  finally
    png.Free;

    // In this case, we must do it here...
    ABitmap.Free;
    ABitmap := nil;
  end;
end;

procedure TClickRecorderScreenshotSaveImageSequenceProvider.OpenRegWorker(const ARootKey: HKEY; AWorker: TProc<TRegistry>);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create(KEY_ALL_ACCESS or KEY_WOW64_32KEY);
  try
    Reg.RootKey := ARootKey;
    if Assigned(AWorker) then
    begin
      AWorker(Reg);
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;

function TClickRecorderScreenshotSaveImageSequenceProvider.GetAppVersion: string;
var
  Size, Size2: DWord;
  Pt, Pt2: Pointer;
begin
  Size := GetFileVersionInfoSize(PChar (ParamStr(0)), Size2);
  if (Size > 0) then
  begin
    GetMem (Pt, Size);
    try
      GetFileVersionInfo(PChar (ParamStr (0)), 0, Size, Pt);
      VerQueryValue (Pt, '\', Pt2, Size2);
      Result := Format('%d.%d.%d.%d', [
        HiWord(TVSFixedFileInfo(Pt2^).dwFileVersionMS),
        LoWord(TVSFixedFileInfo(Pt2^).dwFileVersionMS),
        HiWord(TVSFixedFileInfo(Pt2^).dwFileVersionLS),
        LoWord(TVSFixedFileInfo(Pt2^).dwFileVersionLS)]);
    finally
      FreeMem (Pt);
    end;
  end
  else
  begin
    Result:= 'NOT RECOGNIZED';
  end;
end;

function TClickRecorderScreenshotSaveImageSequenceProvider.GetUserName: string;
var
  Buffer: array[0..255] of Char;
  Size: DWORD;
begin
  Size := SizeOf(Buffer);
  if Winapi.Windows.GetUserName(Buffer, Size) then
  begin
    Result := Buffer;
  end
  else
  begin
    Result := '';
  end;
end;

function TClickRecorderScreenshotSaveImageSequenceProvider.CreateSystemInfoFile: string;
var
  Return: string;
begin
  OpenRegWorker(
    HKEY_LOCAL_MACHINE,
    procedure(AReg: TRegistry)
    begin
      if AReg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows NT\CurrentVersion') then
      begin
        if (AReg.ValueExists('DisplayVersion') and  AReg.ValueExists('CurrentBuildNumber')) then
        begin
          Return := Format('Windows Version %s (%s)', [AReg.ReadString('DisplayVersion'), AReg.ReadString('CurrentBuildNumber')]);
        end;
      end;
    end);

  Result := Return + sLineBreak
    + 'Username ' + GetUserName + sLineBreak
    + 'Application ' + ParamStr(0) + sLineBreak
    + 'Version ' + GetAppVersion;
end;

function TClickRecorderScreenshotSaveImageSequenceProvider.ToZip: string;
var
  ZipFile: TZipFile;
  Arr: TArray<string>;
begin
  //  TZipFile.ExtractZipFile(FFromFile, FExtractPath);
  ZipFile := TZipFile.Create;
  try
    //    Result := GetNextCollisionFreeFilename('zip', FOutDir);
    Result := TPath.Combine(FOutDir, Format(CFilenameZip, [TPath.GetFileNameWithoutExtension(ParamStr(0)), GetUserName, FormatDateTime('yyyy-mm-dd-hhnnss', Now())]));
    ZipFile.Open(Result, zmWrite);

    TFile.WriteAllText(TPath.Combine(FTempDirToSaveImages, 'AppInfo.txt'), CreateSystemInfoFile());
    ZipFile.Add(TPath.Combine(FTempDirToSaveImages, 'AppInfo.txt'));

    Arr := TDirectory.GetFiles(FTempDirToSaveImages, '*.png');
    for var Element in arr do
    begin
      ZipFile.Add(Element);
    end;
  finally
    ZipFile.Free;
  end;

  for var Element in arr do
  begin
    TFile.Delete(Element);
  end;
end;

end.