unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RXSpin, StdCtrls, Buttons, ExtCtrls, ComCtrls, Mask, ToolEdit,
  WjhCps;

type
  Tfrmmain = class(TForm)
    WjhCps1: TWjhCps;
    Ed1: TFilenameEdit;
    Ed2: TFilenameEdit;
    frmProgress: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    RadioGroup1: TRadioGroup;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    GroupBox2: TGroupBox;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Label3: TLabel;
    Label4: TLabel;
    Ed4: TEdit;
    Ed3: TRxSpinEdit;
    Label5: TLabel;
    procedure RadioGroup1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WjhCps1FileProgress(Sender: TObject; FileName: string;
      Progress: Double; Operation: TWuCProcessOperation;
      ProgressPhase: TWuCProgressPhase; var Cancel: Boolean);
    procedure WjhCps1OverallProgress(Sender: TObject; Progress: Double;
      Operation: TWuCProcessOperation; ProgressPhase: TWuCProgressPhase;
      var Cancel: Boolean);
    procedure WjhCps1ExtractFile(Sender: TObject; var FileName: string;
      var FileAttr: Cardinal; const Comment: string);
    procedure Ed1Change(Sender: TObject);
  private
    cmping: boolean;
    Cryptostr: string;
    dwreadTime: Longword;
    fsStream: TMemoryStream;
    fname: string;
    CryptoAlgor: TWuCCryptoAlgorithm;
    procedure getfname(idx: integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmmain: Tfrmmain;

implementation

{$R *.dfm}

procedure Tfrmmain.getfname(idx: integer);
var
  ftdir: string;
begin
  fname := '000000' + inttostr(ed3.AsInteger) + inttostr(idx + 1);
  fname := copy(fname, length(fname) - 6, length(fname));
  ftdir := ExtractFileDir(ed1.Text);
  if (Length(ftdir) > 0) and (ftdir[Length(ftdir)] <> '\') then
    ftdir := ftdir + '\';
  ed2.Text := ftdir + fname;
end;

procedure Tfrmmain.RadioGroup1Click(Sender: TObject);
begin
  case RadioGroup1.ItemIndex of
    0:
      begin
        CryptoAlgor := caBlowfish;
        Cryptostr := 'caBlowfish';
      end;
    1:
      begin
        CryptoAlgor := caRijndael_128;
        Cryptostr := 'caRijndael_128';
      end;
    2:
      begin
        CryptoAlgor := caRijndael_256;
        Cryptostr := 'caRijndael_256';
      end;
    3:
      begin
        CryptoAlgor := caDES_Single;
        Cryptostr := 'caDES_Single';
      end;
    4:
      begin
        CryptoAlgor := caDES_Triple;
        Cryptostr := 'caDES_Triple';
      end;
    5:
      begin
        CryptoAlgor := caTwofish_128;
        Cryptostr := 'caTwofish_128';
      end;
    6:
      begin
        CryptoAlgor := caTwofish_256;
        Cryptostr := 'caTwofish_256';
      end;
    7:
      begin
        CryptoAlgor := caSquare;
        Cryptostr := 'caSquare';
      end;
  end;

  getfname(RadioGroup1.ItemIndex);
end;

procedure Tfrmmain.FormCreate(Sender: TObject);
begin
  cmping := false;
  CryptoAlgor := caBlowfish;
  Cryptostr := 'caBlowfish';
  fsStream := TMemoryStream.Create;

end;

procedure Tfrmmain.BitBtn1Click(Sender: TObject);
begin
  if cmping then
    exit;
  try
    cmping := true;
    dwreadTime := GetTickCount;
    WjhCps1.FileName := ed2.Text;
    WjhCps1.F0EC9DB8 := Uppercase(ExtractFileName(ed2.Text)) + Ed4.Text;
    WjhCps1.CryptoAlgorithm := CryptoAlgor;
    WjhCps1.CompressionMode := Ed3.AsInteger;
    WjhCps1.OpenArchive(fmCreate);
    WjhCps1.BaseDir := ExtractFileDir(ed1.Text);
    WjhCps1.AddFiles(Ed1.Text);
    WjhCps1.CloseArchive;
    dwreadTime := GetTickCount - dwreadTime;
  finally
    Memo1.Lines.Add('壓縮    加密: ' + Cryptostr + '   壓縮模式: ' + Ed3.Text + ' 密碼長度: ' + inttostr(length(Uppercase(ExtractFileName(ed2.Text)) + Ed4.Text)) + '   耗時: ' + inttostr(dwreadTime));
    cmping := false;
  end;
end;

procedure Tfrmmain.BitBtn2Click(Sender: TObject);
begin
  if cmping then
    exit;
  fsStream.Position := 0;
  fsStream.SetSize(0);
  try
    cmping := true;
    dwreadTime := GetTickCount;
    WjhCps1.CryptoAlgorithm := CryptoAlgor;
    WjhCps1.Options.ShareMode := smShareDenyNone;
    WjhCps1.CompressionMode := Ed3.AsInteger;
    WjhCps1.F0EC9DB8 := UpperCase(ExtractFileName(Ed2.Text)) + Ed4.Text;
    WjhCps1.FileName := Ed2.Text;
    WjhCps1.OpenArchive(fmOpenRead);
    WjhCps1.ExtractToStream(ExtractFileName(Ed1.Text), fsStream);
    fsStream.Seek(0, 0);
    dwreadTime := GetTickCount - dwreadTime;
  finally
    Memo1.Lines.Add('解壓    加密: ' + Cryptostr + '   壓縮模式: ' + Ed3.Text + ' 密碼長度: ' + inttostr(length(Uppercase(ExtractFileName(ed2.Text)) + Ed4.Text)) + '   耗時: ' + inttostr(dwreadTime));
    WjhCps1.CloseArchive;
    cmping := false;
  end;
end;

procedure Tfrmmain.FormDestroy(Sender: TObject);
begin
  fsStream.Free;
  fsStream := nil;
end;

procedure Tfrmmain.WjhCps1FileProgress(Sender: TObject; FileName: string;
  Progress: Double; Operation: TWuCProcessOperation;
  ProgressPhase: TWuCProgressPhase; var Cancel: Boolean);
begin
  if (ProgressPhase = ppStart) then
  begin
    frmProgress.Visible := true;
    Label5.Visible := true;
  end
  else
    if (ProgressPhase = ppEnd) then
    begin
      frmProgress.Visible := false;
      Label5.Visible := false;
    end;
  Label5.Caption := inttostr(Round(Progress));
  frmProgress.Position := Round(Progress);
  Application.ProcessMessages;
end;

procedure Tfrmmain.WjhCps1OverallProgress(Sender: TObject;
  Progress: Double; Operation: TWuCProcessOperation;
  ProgressPhase: TWuCProgressPhase; var Cancel: Boolean);
begin
  if (ProgressPhase = ppStart) then
  begin
    frmProgress.Visible := true;
    Label5.Visible := true;
  end
  else
    if (ProgressPhase = ppEnd) then
    begin
      frmProgress.Visible := false;
      Label5.Visible := false;
    end;
  Label5.Caption := inttostr(Round(Progress));
  frmProgress.Position := Round(Progress);
  Application.ProcessMessages;
end;

procedure Tfrmmain.WjhCps1ExtractFile(Sender: TObject;
  var FileName: string; var FileAttr: Cardinal; const Comment: string);
begin
  frmProgress.Visible := true;
  Label5.Visible := true;
end;

procedure Tfrmmain.Ed1Change(Sender: TObject);
begin
  getfname(RadioGroup1.ItemIndex);
end;

end.