fzip.pas

一个兼容pkzip的文件/内存压缩算法

unit Fzip;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, azip, StdCtrls, Buttons, addzipu;

type
  TfrmZIP = class(TForm)
    lblInfo: TLabel;
    btnCancel: TSpeedButton;
    btnOK: TSpeedButton;
    edtHidden: TEdit;
    procedure FormShow(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnOKClick(Sender: TObject);
    procedure edtHiddenChange(Sender: TObject);
  private
    { Private declarations }
    procedure DOZip;
    function Trim(s : string) : string;
  public
    { Public declarations }
  end;

var
  frmZIP: TfrmZIP;
  iDoZIP : Integer;
  {$IFDEF WIN32}
  sArchiveName : String[255];
  {$ELSE}
  sArchiveName : String[128];
  {$ENDIF}

implementation

uses zwiz;

{$R *.DFM}

procedure TfrmZIP.FormShow(Sender: TObject);
var
   I : Integer;
begin
    I := addZIP_SetWindowHandle(edtHidden.Handle);
    frmZIP.Caption := 'Confirm';
    lblInfo.Caption := 'You are about to start creating the archive. Press OK to proceed, Cancel to quit.';
    iDoZIP := 1;
end;

procedure TfrmZIP.btnCancelClick(Sender: TObject);
begin
   Close;  
end;

procedure TfrmZIP.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action := caFree;
end;

procedure TfrmZIP.btnOKClick(Sender: TObject);
begin
    Caption := 'Compressing...';
    btnOK.Visible := False;
    btnCancel.Left := ((Width - btnCancel.Width) div 2);
    btnCancel.Enabled := False;
    DoZIP;
    frmZIP.Caption := 'Finished';
    lblInfo.Caption := 'Finished';
    btnCancel.Caption := '&OK';
    btnCancel.Enabled := True;

end;

procedure TfrmZIP.edtHiddenChange(Sender: TObject);
var
   sFile, cAdditem, cAction : String;
   lSize : LongInt;
   iWidth, Selector : Integer;
begin
    cAction := GetAction((edtHidden.Text));
    If LowerCase(Trim(cAction)) = 'copying' then
       Selector := 1
    Else If LowerCase(Trim(cAction)) = 'deleting' then
       Selector := 2
    Else If LowerCase(Trim(cAction)) = 'error' then
       Selector := 3
    Else If LowerCase(Trim(cAction)) = 'warning' then
       Selector := 4
    Else If LowerCase(Trim(cAction)) = 'zipping' then
       Selector := 5;

    Case Selector of
        1 : begin
            {copying}
            end;
        2 : begin
            {error}
            end;
        3 : begin
            {warning}
            end;
        4 : begin
            {comment}
            end;
        5 : begin
            {zipping}
            sFile := 'Compressing ' + GetFileName((edtHidden.Text));
            sFile := sFile + ' - ' + (GetPercentComplete((edtHidden.Text)));
            lblInfo.Caption := sFile;
            lblInfo.update;
            end;
    end;
end;

procedure TfrmZIP.DOZip;
var
   {$IFDEF WIN32}
   sTempFile : String[255];
   {$ELSE}
   sTempFile : String[128];
   {$ENDIF}
   pPassWord, pTempFile, pArchiveName, pFiles : PChar;
   I : Integer;
begin

   pFiles := StrAlloc(65526);
   {$IFDEF WIN32}
   pArchiveName := StrAlloc(255);
   pTempFile := StrAlloc(255);
   {$ELSE}
   pArchiveName := StrAlloc(127);
   pTempFile := StrAlloc(127);
   {$ENDIF}

    { Set the name of the archive}
    StrPCopy(pArchiveName, sArchiveName);
    I := addZIP_ArchiveName(pArchiveName);

    pFiles := '';
    { Create pipe-delimited list of files and call the appropriate function}
    For I := 0 To frmWizard.lstSelected.Items.Count - 1 do
        begin
           sTempFile := Trim(frmWizard.lstSelected.Items[I]) + '|';
           StrPCopy(pTempFile, sTempFile);
           StrCat(pFiles, pTempFile);
        end;

    I := addZIP_Include(pFiles);

    If (frmWizard.radPathYes.Checked = True) Then
        I := addZIP_SaveStructure(SAVE_ABSOLUTE_PATH)
    Else
        I := addZIP_SaveStructure(SAVE_FILENAME_ONLY);

    If (frmWizard.radPasswordYes.Checked = True) Then
       begin
          pPassWord := StrAlloc(Length(frmWizard.edtPassword.Text) + 1);
          StrPCopy(pPassWord, frmWizard.edtPassword.Text);
          I := addZIP_Encrypt(pPassword);
          StrDispose(pPassWord);
       end;

    If (frmWizard.radCompressNone.Checked = True) Then
        I := addZIP_SetCompressionLevel(COMPRESSION_NONE)
    Else If (frmWizard.radCompressMinimum.Checked = True) Then
        I := addZIP_SetCompressionLevel(COMPRESSION_MINIMUM)
    Else If (frmWizard.radCompressNormal.Checked = True) Then
        I := addZIP_SetCompressionLevel(COMPRESSION_NORMAL)
    Else
        I := addZIP_SetCompressionLevel(COMPRESSION_MAXIMUM);

    If (frmWizard.radMultiYes.Checked = True) Then
        I := addZIP_Span(True)
    Else
        I := addZIP_Span(False);

    If (frmWizard.radLFNYes.Checked = True) Then
        I := addZIP_UseLFN(True)
    Else
        I := addZIP_UseLFN(False);

    If (frmWizard.radCommentYes.Checked = True) Then
       begin
          I := addZIP_Comment(frmWizard.mmoComment.Lines.GetText);
       end;

    I := addZIP;

    StrDispose(pFiles);
    StrDispose(pArchiveName);
    StrDispose(pTempFile);
end;

function TfrmZIP.Trim(s : string) : string;
var
  sLen : byte absolute s;
begin
  while (sLen>0) and (s[1] in [' ',^I]) do
    Delete(s,1,1);

  while (sLen>0) and (s[sLen] in [' ',^I]) do
    Dec(sLen);

  result:=s;
end;

end.