main.pas

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

unit Main;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ShellAPI, AZIP, AUNZIP, Menus, Buttons, About, ExtCtrls, AddZipu;

type
  TQuikZip = class(TForm)
    txtZip: TEdit;
    lstArchive: TListBox;
    mnuMain: TMainMenu;
    mnuArchive: TMenuItem;
    mnuOptions: TMenuItem;
    mnuHelp: TMenuItem;
    mnuArchiveNew: TMenuItem;
    mnuArchiveOpen: TMenuItem;
    mnuArchiveSep1: TMenuItem;
    mnuArchiveExit: TMenuItem;
    mnuHelpAbout: TMenuItem;
    mnuOptionsCompression: TMenuItem;
    mnuOptionsStoreFull: TMenuItem;
    mnuOptionsSep1: TMenuItem;
    mnuOptionsExtractTo: TMenuItem;
    mnuOptionsCompressionNone: TMenuItem;
    mnuOptionsCompressionMinimum: TMenuItem;
    mnuOptionsCompressionNormal: TMenuItem;
    mnuOptionsCompressionMaximum: TMenuItem;
    btnNew: TSpeedButton;
    btnOpen: TSpeedButton;
    btnDelete: TSpeedButton;
    btnExtract: TSpeedButton;
    btnView: TSpeedButton;
    hdrArchive: THeader;
    pnlStatusBar: TPanel;
    mnuPopup: TPopupMenu;
    mnuPopupSelectAll: TMenuItem;
    mnuPopupDeselectAll: TMenuItem;
    mnuPopupInvert: TMenuItem;
    mnuPopupSep: TMenuItem;
    mnuPopupExtract: TMenuItem;
    mnuPopupView: TMenuItem;
    mnuPopupDelete: TMenuItem;
    mnuOptionsSep2: TMenuItem;
    mnuOptionsOnTop: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure txtZipChange(Sender: TObject);
    procedure mnuHelpAboutClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnOpenClick(Sender: TObject);
    procedure mnuArchiveOpenClick(Sender: TObject);
    procedure mnuOptionsStoreFullClick(Sender: TObject);
    procedure lstArchiveDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure hdrArchiveSized(Sender: TObject; ASection, AWidth: Integer);
    procedure mnuOptionsCompressionNormalClick(Sender: TObject);
    procedure mnuOptionsCompressionNoneClick(Sender: TObject);
    procedure mnuOptionsCompressionMinimumClick(Sender: TObject);
    procedure mnuOptionsCompressionMaximumClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure mnuOptionsExtractToClick(Sender: TObject);
    procedure btnNewClick(Sender: TObject);
    procedure mnuArchiveNewClick(Sender: TObject);
    procedure mnuPopupPopup(Sender: TObject);
    procedure mnuPopupSelectAllClick(Sender: TObject);
    procedure mnuPopupDeselectAllClick(Sender: TObject);
    procedure mnuPopupInvertClick(Sender: TObject);
    procedure mnuOptionsOnTopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mnuPopupDeleteClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure mnuPopupExtractClick(Sender: TObject);
    procedure btnExtractClick(Sender: TObject);
    procedure mnuPopupViewClick(Sender: TObject);
    procedure btnViewClick(Sender: TObject);
  private
    { Private declarations }
    function Trim(s: string): string;
    function OpenArchive : Boolean;
    procedure ListArchiveContents;
    procedure AddFilesToArchive(pFile : PChar);
    procedure UpdateStatusbar;
    function GetItem(const sValue, sSep : String; const iItem : Integer): String;
    Function GetPathName (CurrentPath : String) : String;
    Function GetNewArchive : String;
    procedure NewArchive;
    procedure ProcessDroppedFiles(var MSG: Tmessage); message WM_DROPFILES;
    procedure WMGetMinMaxInfo(var MSG: Tmessage); message WM_GetMinMaxInfo;
    procedure DeleteFilesFromArchive;
    procedure TopMostOn;
    procedure TopMostOff;
    procedure ExtractFilesFromArchive;
    procedure ViewFiles;
  public
    { Public declarations }
  end;

var
  QuikZip: TQuikZip;
  g_cArchiveName : PChar;
  g_cExtract : String;
  g_cTemp : String;
  g_iCount : Integer; { the total number of files in the archive}
  g_lSize : Longint;  { the total size (uncompressed) of the files in the archive}
  g_iWidth : Integer;
  g_iPathLen : Integer;

implementation

{$R *.DFM}

{Supresses leading and trailing blanks}
function TQuikZip.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;

procedure TQuikZip.FormShow(Sender: TObject);
var
   i : integer;
begin
    {$IFDEF WIN32}
       g_iPathLen := 255;
    {$ELSE}
       g_iPathLen := 127;
    {$ENDIF}
    I := addZIP_SetParentWindowHandle(QuikZip.Handle);
    I := addUNZIP_SetParentWindowHandle(QuikZip.Handle);
    I := addZIP_SetWindowHandle(txtZIP.handle);
    I := addUNZIP_SetWindowHandle(txtZIP.handle);
    g_cExtract := ExtractFilePath(Application.ExeName);
    g_cArchiveName := StrAlloc(g_iPathLen);
    TopMostOn;
end;

procedure TQuikZip.txtZipChange(Sender: TObject);
var
   cAdditem, cAction : String;
   lSize : LongInt;
   iWidth, Selector : Integer;
begin
    cAction := GetAction((txtZIP.Text));
    If LowerCase(Trim(cAction)) = 'view' then
       Selector := 1
    Else If LowerCase(Trim(cAction)) = 'error' then
       Selector := 2
    Else If LowerCase(Trim(cAction)) = 'warning' then
       Selector := 3
    Else If LowerCase(Trim(cAction)) = 'comment' then
       Selector := 4;

    Case Selector of
        1 : begin
               If Trim(GetFileName((txtZIP.Text))) <> '' then
                  begin
                     cAdditem := GetFileName((txtZIP.Text)) + #9;
                     iWidth := Pos(#9, cAdditem);
                     If iWidth > g_iWidth then
                         begin
                            g_iWidth := iWidth;
                            hdrArchive.SectionWidth[0] := g_iWidth * 7
                         end;
                     lSize := GetFileOriginalSize((txtZIP.Text));
                     g_lSize := g_lSize + lSize;
                     cAdditem := cAdditem + GetFileDate((txtZIP.Text)) + #9;
                     cAdditem := cAdditem + GetFileTime((txtZIP.Text)) + #9;
                     cAdditem := cAdditem + IntToStr(lSize) + #9;
                     cAdditem := cAdditem + IntToStr(GetFileCompressedSize((txtZIP.Text))) + #9;
                     cAdditem := cAdditem + GetFileCompressionRatio((txtZIP.Text)) + #9;
                     cAdditem := cAdditem + GetFilePath((txtZIP.Text)) + #9;
                     lstArchive.Items.Add(cAdditem);
                     g_iCount := g_iCount + 1;
                  end;
            end;
        2 : begin
            {error}
            end;
        3 : begin
            {warning}
            end;
        4 : begin
            {comment}
            end;
    Else
       begin
          cAdditem := UpperCase(Trim(cAction)) + ' ' + GetFileName((txtZIP.Text));
          cAdditem := cAdditem + ' - ' + GetFileCompressionRatio((txtZIP.Text));
          pnlStatusBar.Caption := cAdditem;
          pnlStatusBar.Update;
       end;
    end;

end;

procedure TQuikZip.mnuHelpAboutClick(Sender: TObject);
begin
   with TAboutBox.Create(Application) do
   try
      TopMostOff;
      ShowModal;
   finally
      TopMostOn;
      Free;
   end;
end;

procedure TQuikZip.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   StrDispose(g_cArchiveName);
   DragAcceptFiles(Handle, False);
   Action := caFree;
end;

Function TQuikZip.OpenArchive : Boolean;
begin

   OpenArchive := False;

   TopMostOff;
   with TOpenDialog.Create(Application) do
   try
      Filename := '*.ZIP';
      InitialDir := ExtractFilePath(Application.Exename);
      DefaultExt := '.ZIP';
      Filter := 'ZIP Archives|*.zip';
      FilterIndex := 1;
      Title := 'Open Archive';
      HelpContext := 0;
      Options := Options + [ofFileMustExist];

      if Execute then
         begin
            g_iWidth := 15;
            hdrArchive.SectionWidth[0] := g_iWidth * 6;
            If Trim(Filename) <> '' Then
               begin
                  OpenArchive := True;
                  StrPCopy (g_cArchiveName, Trim(Filename));
               end;
         end
   finally
     Free
   end;
   TopMostOn;

end;

procedure TQuikZip.ListArchiveContents;
var
   i : Integer;
begin
   QuikZip.Caption := 'QuickZIP - ' + StrPas(g_cArchiveName);
   g_iCount := 0;
   g_lSize := 0;
   lstArchive.Clear;
   Screen.Cursor := crHourglass;
   i := addZIP_SetWindowHandle(txtZIP.handle);
   i := addZIP_ArchiveName(g_cArchiveName);
   i := addZIP_View(True);                                          
   i := addZIP;
   UpdateStatusBar;
   Screen.Cursor := crDefault;
end;

procedure TQuikZip.btnOpenClick(Sender: TObject);
var
   Result : Boolean;
begin
   Result := OpenArchive;
   If Result = True then
      ListArchiveContents;
end;

procedure TQuikZip.mnuArchiveOpenClick(Sender: TObject);
var
   Result : Boolean;
begin
   Result := OpenArchive;
   If Result = True then
      ListArchiveContents;
end;

procedure TQuikZip.AddFilesToArchive(pFile : PChar);
var
   i : Integer;
begin
    If (mnuOptionsCompressionNone.Checked = True) Then
        i := addZIP_SetCompressionLevel(COMPRESSION_NONE)
    Else If (mnuOptionsCompressionMinimum.Checked = True) Then
        i := addZIP_SetCompressionLevel(COMPRESSION_MINIMUM)
    Else If (mnuOptionsCompressionNormal.Checked = True) Then
        i := addZIP_SetCompressionLevel(COMPRESSION_NORMAL)
    Else
        i := addZIP_SetCompressionLevel(COMPRESSION_MAXIMUM);

    If (mnuOptionsStoreFull.Checked = False) Then
        i := addZIP_SaveStructure(SAVE_FILENAME_ONLY);

    Screen.Cursor := crHourglass;
    i := addZIP_Include(pFile);
    i := addZIP_ArchiveName(g_cArchiveName);
    i := addZIP;
    Screen.Cursor := crDefault;
end;

procedure TQuikZip.mnuOptionsStoreFullClick(Sender: TObject);
begin
   mnuOptionsStoreFull.Checked := Not mnuOptionsStoreFull.Checked;
end;

procedure TQuikZip.UpdateStatusBar;
var
   cStatus : String;
begin
    If (g_iCount > 0) Then
       begin
          cStatus := ' This archive contains ' + Format('%.0n', [Int(g_iCount)]) + ' files, ';
          cStatus := cStatus + 'with a total uncompressed size of ' + Format('%.0n', [Int(g_lSize)]) + ' bytes';
       end
    Else
       cStatus := '';
    pnlStatusBar.Caption := cStatus;
end;

procedure TQuikZip.lstArchiveDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  sText, sFile, sRatio, sPath : String;
  lSize, lCompSize : Longint;
  iOldRight : Integer;
  sDate, sTime : String;
  P : array[0..255] of Char;
begin
  {Based on code written by Arjen Broeze.}
  with TListBox(Control) do
   begin
     sText := Items[Index];
     sFile := GetItem(sText, #9, 1);
     sDate := GetItem(sText, #9, 2);
     sTime := GetItem(sText, #9, 3);
     lSize := StrToInt(GetItem(sText, #9, 4));
     lCompSize := StrToInt(GetItem(sText, #9, 5));
     sRatio := GetItem(sText, #9, 6);
     sPath := GetItem(sText, #9, 7);
     with Canvas do
      begin
         FillRect(Rect);
         StrPCopy(P, sFile);
         DrawText(Handle, P, lstrlen(P), Rect, DT_LEFT or DT_SINGLELINE);
         inc(Rect.left, hdrArchive.SectionWidth[0]);
         StrPCopy(P, sDate);
         DrawText(Handle, P, lstrlen(P), Rect, DT_LEFT or DT_SINGLELINE);
         inc(Rect.left, hdrArchive.SectionWidth[1]);
         StrPCopy(P, sTime);
         DrawText(Handle, P, lstrlen(P), Rect, DT_LEFT or DT_SINGLELINE);
         inc(Rect.left, hdrArchive.SectionWidth[2]);
         StrPCopy(P, Format('%.0n', [Int(lSize)]));
         iOldRight := Rect.Right;
         Rect.right := Rect.left + hdrArchive.SectionWidth[3]-3;
         DrawText(Handle, P, lstrlen(P), Rect, DT_RIGHT or DT_SINGLELINE);
         inc(Rect.left, hdrArchive.SectionWidth[3]);
         Rect.right := Rect.left + hdrArchive.SectionWidth[4]-3;
         StrPCopy(P, sRatio);
         DrawText(Handle, P, lstrlen(P), Rect, DT_RIGHT or DT_SINGLELINE);
         inc(Rect.left, hdrArchive.SectionWidth[4]);
         Rect.right := Rect.left + hdrArchive.SectionWidth[5]-3;
         StrPCopy(P, Format('%.0n', [Int(lCompSize)]));
         DrawText(Handle, P, lstrlen(P), Rect, DT_RIGHT or DT_SINGLELINE);
         inc(Rect.left, hdrArchive.SectionWidth[5]+3);
         Rect.Right := iOldRight;
         StrPCopy(P, sPath);
         DrawText(Handle, P, lstrlen(P), Rect, DT_LEFT or DT_SINGLELINE);
      end;
   end;

end;

function TQuikZip.GetItem(const sValue, sSep : String; const iItem : Integer): String;
var
  iPos,
  iCount,
  iSepLen : Integer;
  sVal    : String;
begin
  sVal := sValue;
  Result := '';
  iSepLen := Length(sSep);
  iCount := 1;
  iPos := Pos(sSep, sValue);
  while (iPos > 0) and (iCount < iItem) do
   begin
     inc(iCount);
     sVal := Copy(sVal, iPos+iSepLen, Length(sVal));
     iPos := Pos(sSep, sVal);
   end;
  if iCount = iItem then
   begin
     if iPos = 0 then
      { last item }
      Result := sVal
     else
      Result :=	Copy(sVal, 1, iPos-1);
   end;
end;
procedure TQuikZip.hdrArchiveSized(Sender: TObject; ASection,
  AWidth: Integer);
begin
   lstArchive.Repaint;
end;

procedure TQuikZip.mnuOptionsCompressionNormalClick(Sender: TObject);
begin
   mnuOptionsCompressionNormal.Checked := not mnuOptionsCompressionNormal.Checked;
   If mnuOptionsCompressionNormal.Checked = True then
      begin
         mnuOptionsCompressionNone.Checked := False;
         mnuOptionsCompressionMinimum.Checked := False;
         mnuOptionsCompressionMaximum.Checked := False;
      end;
end;

procedure TQuikZip.mnuOptionsCompressionNoneClick(Sender: TObject);
begin
   mnuOptionsCompressionNone.Checked := not mnuOptionsCompressionNone.Checked;
   If mnuOptionsCompressionNone.Checked = True then