unit QExport4BaseArchiveClass;

{$I QExport4VerCtrl.inc}

interface

uses
  {$IFDEF VCL16}
    System.Classes,
    System.SysUtils,
  {$ELSE}
    Classes,
    SysUtils,
  {$ENDIF}
  QExport4ZipMcpt,
  QExport4Types;

{$IFDEF VCL6}
{$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}
type
  TBaseArchiveClass = class
  private
    FFileName: string;
    FTempDir: string;
    FZipArchive: TMiniZip;
    procedure SetFileName(const Value: string);
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Compress;
    procedure DeleteTempFolder;

    property FileName: string read FFileName write SetFileName;
    property TempDir: string read FTempDir write FTempDir;
  end;

function GetTempDir: string;

implementation

uses
  {$IFDEF VCL16}
    Winapi.Windows,
    System.Win.ComObj,
  {$ELSE}
    {$IFDEF VER130}
      FileCtrl,
    {$ENDIF}
    Windows,
    ComObj,
  {$ENDIF}
  {$IFDEF TEST_QE4ZIPCOMPRESS}
    QExport4zip,
  {$ENDIF}
  QExport4StrIDs,
  QExport4;

{$IFDEF VCL12}
function GetTempDir: string;
var
  Buffer: array[0..MAX_PATH] of WideChar;
begin
  GetTempPath(Length(Buffer), Buffer);
  Result := StrPas(Buffer) + CreateClassID;
end;
{$ELSE}
function GetTempDir: string;
var
  Buffer: array[0..MAX_PATH] of Char;
begin
  GetTempPath(SizeOf(Buffer) - 1, Buffer);
   Result := StrPas(Buffer) + CreateClassID;
end;
{$ENDIF}

{ TBaseArchiveClass }

constructor TBaseArchiveClass.Create;
begin
  inherited;
  TempDir := GetTempDir;
end;

destructor TBaseArchiveClass.Destroy;
begin
  inherited;
end;

procedure TBaseArchiveClass.SetFileName(const Value: string);
begin
  if FFileName <> Value then
    FFileName := Value;
end;

{$IFDEF VCL6}
{$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}

procedure TBaseArchiveClass.DeleteTempFolder;

  function FullRemoveDir(Dir: string; DeleteAllFilesAndFolders,
    StopIfNotAllDeleted, RemoveRoot: boolean): Boolean;
  var
    i: Integer;
    SRec: TSearchRec;
    FN: string;
  begin
    {$IFDEF VCL6} 
      {$WARN SYMBOL_PLATFORM OFF}
    {$ENDIF}
    Result := False;
    if not DirectoryExists(Dir) then
      exit;
    Result := True;
    // add slash, mask = all files and folders
    {$IFDEF VCL6}
    Dir := IncludeTrailingPathDelimiter(Dir);
    {$ELSE}
    Dir := IncludeTrailingBackslash(Dir);
    {$ENDIF}
    i := FindFirst(Dir + '*', faAnyFile, SRec);
    try
      while i = 0 do
      begin
        // full path file or folder
        FN := Dir + SRec.Name;
        // if folder
        if (SRec.Attr and faDirectory) <> 0 then
        begin
          // Recursive call this functions with key of the removing root
          if (SRec.Name <> '') and (SRec.Name <> '.') and (SRec.Name <> '..') then
          begin
            if DeleteAllFilesAndFolders then
              FileSetAttr(FN, faArchive);
            Result := FullRemoveDir(FN, DeleteAllFilesAndFolders,
              StopIfNotAllDeleted, True);
            if not Result and StopIfNotAllDeleted then
              exit;
          end;
        end
        else // delete file
        begin
          if DeleteAllFilesAndFolders then
            FileSetAttr(FN, faArchive);
          Result :=
            {$IFDEF VCL16}System.SysUtils{$ELSE}SysUtils{$ENDIF}.DeleteFile(FN);
          if not Result and StopIfNotAllDeleted then
            exit;
        end;
        // get next file or folder
        i := FindNext(SRec);
      end;
    finally
      {$IFDEF VCL16}System.SysUtils{$ELSE}SysUtils{$ENDIF}.FindClose(SRec);
    end;
    if not Result then
      exit;
    if RemoveRoot then // delete root if need
      if not RemoveDir(Dir) then
        Result := false;
    {$IFDEF VCL6}
      {$WARN SYMBOL_PLATFORM ON}
    {$ENDIF}
  end;

begin
  FullRemoveDir(TempDir, True, False, True);
end;

//{$DEFINE TEST_QE4ZIPCOMPRESS}

procedure TBaseArchiveClass.Compress;
{$IFDEF TEST_QE4ZIPCOMPRESS}
var
  err_log: TStrings;
  FS: TFileStream;
  Dir: string;
{$ENDIF}
  procedure RecurseAdd(ExtDir, CurrDir: string);
  var
    i, j: Integer;
    SRec: TSearchRec;
    FN: string;
    EndDir: string;
    {$IFDEF TEST_QE4ZIPCOMPRESS}
    err_no : Integer;
    {$ENDIF}
  begin
  {$IFDEF VCL6}
    {$WARN SYMBOL_PLATFORM OFF}
  {$ENDIF}
    if not DirectoryExists(CurrDir) then
      Exit;
    // add slash, mask = all files and folders
    {$IFDEF VCL6}
    CurrDir := IncludeTrailingPathDelimiter(CurrDir);
    {$ELSE}
    CurrDir := IncludeTrailingBackslash(CurrDir);
    {$ENDIF}
    i := FindFirst(CurrDir + '*', faAnyFile, SRec);
    {$IFDEF TEST_QE4ZIPCOMPRESS}
    err_log.Add('');
    err_log.Add('CurrDir + "*" = '+ CurrDir + '*');
    {$ENDIF}
    try
      while i = 0 do
      begin
        // full path file or folder
        FN := CurrDir + SRec.Name;
        {$IFDEF TEST_QE4ZIPCOMPRESS}
        err_log.Add('  SRec.Name = ' + SRec.Name);
        err_log.Add('  SRec.Attr = ' + IntToStr(SRec.Attr));
        err_log.Add('  FN = ' + FN);
        err_log.Add('  ExtDir = ' + ExtDir);
        {$ENDIF}
        // if folder
        if (SRec.Attr and faDirectory) <> 0 then
        begin
          if (SRec.Name <> '') and (SRec.Name <> '.') and (SRec.Name <> '..') then
            RecurseAdd(ExtDir, FN);
        end
        else
        begin
          EndDir := Copy(FN, length(ExtDir) + 2, length(FN) - length(ExtDir) - 1);
          while (true) do
          begin
              j := Pos('\', EndDir);
              if (j > 0) then
                EndDir[j] := '/'
              else
                break;
            end;
          {$IFNDEF TEST_QE4ZIPCOMPRESS}
          FZipArchive.AddToZipFile( AnsiString(FN), AnsiString(EndDir));
          {$ELSE}
          err_no := FZipArchive.AddToZipFile( AnsiString(FN), AnsiString(EndDir));
          err_log.Add('    err_no = ' + IntToStr(err_no));
          err_log.Add('    EndDir = '+ EndDir);
          {$ENDIF}
        end;
        // get next file or folder
        i := FindNext(SRec);
      end;
    finally
      {$IFDEF VCL16}System.SysUtils{$ELSE}SysUtils{$ENDIF}.FindClose(SRec);
    end;
  {$IFDEF VCL6}
    {$WARN SYMBOL_PLATFORM ON}
  {$ENDIF}
  end;

{$IFNDEF TEST_QE4ZIPCOMPRESS}
var
  FS: TFileStream;
  Dir: string;
{$ENDIF}
begin
  Dir := ExtractFileDir(FileName);
  if Dir = EmptyStr then Dir := ExtractFilePath(ParamStr(0));
  if not DirectoryExists(Dir) then begin
    ForceDirectories(Dir);
    if not DirectoryExists(Dir) then
      raise Exception.CreateFmt(QExportLoadStr(QEM_DirNotFound), [Dir]);
  end;

  FS := TFileStream.Create(FileName, fmCreate);
  try
  finally
    FS.Free;
  end;

  try
    {$IFDEF TEST_QE4ZIPCOMPRESS}
    err_log := TStringList.Create();
    {$ENDIF}
    FZipArchive := TMiniZip.Create(nil);
    FZipArchive.Zipfile := AnsiString(FileName);
    RecurseAdd(TempDir, TempDir);
  finally
    FZipArchive.Free;
    DeleteTempFolder;
    {$IFDEF TEST_QE4ZIPCOMPRESS}
    err_log.SaveToFile(FileName+'.zip_log2');
    err_log.Free;
    {$ENDIF}
  end;
end;

end.