main.pas

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

      begin
         mnuOptionsCompressionNormal.Checked := False;
         mnuOptionsCompressionMinimum.Checked := False;
         mnuOptionsCompressionMaximum.Checked := False;
      end;
end;

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

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

procedure TQuikZip.FormResize(Sender: TObject);
begin
   pnlStatusBar.Top := Height - pnlStatusbar.Height - 48;
   pnlStatusBar.Width := Width - 8;
   lstArchive.Height := pnlStatusBar.Top - lstArchive.Top - 5;
   hdrArchive.Width := Width - 8;
   lstArchive.Width := Width - 8;
end;

procedure TQuikZip.mnuOptionsExtractToClick(Sender: TObject);
var
   sResult : String;
begin
   sResult := GetpathName(g_cExtract);
   If Trim(sresult) <> '' Then
      g_cExtract := sResult;
end;

Function TQuikZip.GetPathName (CurrentPath : String) : String;
var
   DirPath, sTempFilepath : String;
   iEndPos : Integer;
begin

   If Trim(CurrentPath) <> '' Then
       DirPath := Trim(CurrentPath)
   Else
       DirPath := 'C:\';

   TopMostOff;

   with TOpenDialog.Create(Self) do
   try
      Title := 'Set Extract Directory';
      Filename := 'IGNOREME.TXT';
      InitialDir := DirPath;
      DefaultExt := '.TXT';
      Filter := 'All Files (*.*)|*.*';
      FilterIndex := 1;
      HelpContext := 0;
      Options := Options + [ofPathMustExist];

      if Execute then
         begin
            If Length(Filename) <= 12 Then
               sTempFilepath := ''
            Else
               sTempFilepath := Filename;

            If Trim(sTempFilepath) <> '' Then
               begin
                  iEndPos := Pos('IGNOREME.TXT', UpperCase(sTempFilepath));
                  If iEndPos <> 0 Then
                      GetPathName := ExtractFilepath(sTempFilepath)
                  Else
                      GetPathName := CurrentPath;
               end
            Else
               GetPathName := CurrentPath;
         End
      Else
         GetPathName := CurrentPath
   finally
     Free
   end;

   TopMostOn;

End;

Function TQuikZip.GetNewArchive : String;
var
   sTempFilepath : String;
begin


   TopMostOff;

   with TOpenDialog.Create(Self) do
   try
      Title := 'Enter a name for a .ZIP archive';
      Filename := '';
      InitialDir := ExtractFilepath(Application.ExeName);
      DefaultExt := '.ZIP';
      Filter := 'ZIP Files (*.ZIP)|*.ZIP|All Files (*.*)|*.*';
      FilterIndex := 1;
      HelpContext := 0;
      Options := Options + [ofPathMustExist];

      if Execute then
         begin
            If Trim(Filename) <> '' Then
               GetNewArchive := Filename
            Else
               GetNewArchive := '';
         End
      Else
         GetNewArchive := ''
   finally
     Free
   end;
   TopMostOn;

End;

procedure TQuikZip.NewArchive;
var
   sResult : String;
begin
   sResult := GetNewArchive;
   If Trim(sresult) <> '' then
      begin
         StrPCopy (g_cArchiveName, Trim(sResult));
         ListArchiveContents;
      end;
end;

procedure TQuikZip.btnNewClick(Sender: TObject);
begin
   NewArchive;
end;

procedure TQuikZip.mnuArchiveNewClick(Sender: TObject);
begin
   NewArchive;
end;

procedure TQuikZip.mnuPopupPopup(Sender: TObject);
begin
   If (lstArchive.Items.Count > 0) Then
      mnuPopupSelectAll.Enabled := True
   else
      mnuPopupSelectAll.Enabled := False;

   If (lstArchive.SelCount > 0) Then
      begin
         mnuPopupExtract.Enabled := True;
         mnuPopupDelete.Enabled := True;
         mnuPopupView.Enabled := True;
         mnuPopupDeselectAll.Enabled := True;
         mnuPopupInvert.Enabled := True;
      end
   else
      begin
         mnuPopupExtract.Enabled := False;
         mnuPopupDelete.Enabled := False;
         mnuPopupView.Enabled := False;
         mnuPopupDeselectAll.Enabled := False;
         mnuPopupInvert.Enabled := False;
      end;

end;

procedure TQuikZip.mnuPopupSelectAllClick(Sender: TObject);
var
   i : Longint;
begin
   i := SendMessage(lstArchive.handle, LB_SELITEMRANGE, 1, MAKELONG(0 ,lstArchive.Items.Count -1));
end;

procedure TQuikZip.mnuPopupDeselectAllClick(Sender: TObject);
var
   i : Longint;
begin
   i := SendMessage(lstArchive.handle, LB_SELITEMRANGE, 0, MAKELONG(0 ,lstArchive.Items.Count -1));
end;

procedure TQuikZip.mnuPopupInvertClick(Sender: TObject);
var
   i : integer;
begin
   For I := 0 To (lstArchive.Items.Count - 1) do
       lstArchive.Selected[I] := Not lstArchive.Selected[I];
end;

procedure TQuikZip.mnuOptionsOnTopClick(Sender: TObject);
begin
    mnuOptionsOnTop.Checked := Not mnuOptionsOnTop.Checked;

    If mnuOptionsOnTop.Checked = True Then
       SetWindowPos(QuikZip.Handle, HWND_TOPMOST, 0, 0, 0, 0, (SWP_NOMOVE Or SWP_NOSIZE))
    Else
       SetWindowPos(QuikZip.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, (SWP_NOMOVE Or SWP_NOSIZE));
end;

procedure TQuikZip.ProcessDroppedFiles(var MSG: Tmessage);
var
   I, iResult, iDotPos  : Integer;
   {$IFDEF WIN32}
   FileCount, wDrop : Integer;
   {$ELSE}
   FileCount, wDrop : Word;
   {$ENDIF}
   pFilename : PChar;
   sTemp : String;
   sExtension : String[4];
Begin
   pFileName := StrAlloc(g_iPathLen);

   {Retrieve the handle to the internal dropfiles structure}
   wDrop := Msg.wParam;

   {Get the number of files}
   {$IFDEF WIN32}
   FileCount := DragQueryFile(wDrop, $FFFFFFFF, nil, 0);
   {$ELSE}
   FileCount := DragQueryFile(wDrop, $FFFF, nil, 0);
   {$ENDIF}
   For I := 0 To (FileCount - 1) do
      begin
         iResult := DragQueryFile(wDrop, I, pFilename, g_iPathLen);
         If Copy(sTemp, Length(Trim(StrPas(pFilename))), 1) = '\' Then
            StrCat(pFilename, '*.*');
         {Make sure there is a '.' in the file name}
         iDotPos := Pos('.', StrPas(pFilename));
         If (iDotPos > 0) Then
            begin
               sExtension := ExtractFileExt(StrPas(pFilename));
               If (FileCount = 1) And (LowerCase(sExtension) = '.zip') Then
                  StrCopy(g_cArchiveName, pFilename)
               Else
                  AddFilesToArchive(pFilename);
            end
      end;
   { Dispose of the wDrop structure}
   DragFinish(wDrop);
   ListArchiveContents;
   StrDispose(pFileName);
   inherited;
end;

procedure TQuikZip.FormCreate(Sender: TObject);
begin
   DragAcceptFiles(Handle, True);
end;

procedure TQuikZip.WMGetMinMaxInfo(var MSG: Tmessage);
Begin
   inherited;
   with PMinMaxInfo(MSG.lparam)^ do
   begin
     with ptMinTrackSize do
     begin
       X := 560;
       Y := 330;
     end;
   end;
end;

procedure TQuikZip.DeleteFilesFromArchive;
var
   I, J, Button : Integer;
   cMessage, cFilename : String;
   pMessage, pFilename : PChar;
begin
   pMessage := StrAlloc(120);
   pFileName := StrAlloc(g_iPathLen);
   cMessage := 'Do you want to delete the ';
   cMessage := cMessage + IntToStr(lstArchive.SelCount);
   cMessage := cMessage + ' selected files from ';
   cMessage := cMessage + StrPas(g_cArchiveName) + '?';
   StrPCopy(pMessage, cMessage);
   TopMostOff;
   Button := Application.MessageBox(pMessage, 'Confirm', MB_YESNO + MB_ICONQUESTION +
    mb_DefButton1);
   if Button = IDYES then
      begin
         Screen.Cursor := crHourglass;
         For J := 0 To (lstArchive.Items.Count - 1) do
            If (lstArchive.Selected[J] <> False) Then
               begin
                  I := addZIP_ArchiveName(g_cArchiveName);
                  cFilename := GetPiece((lstArchive.Items[J]), #9, 7);
                  If (cFilename <> '') Then cFilename := cFilename + '/';
                  cFilename := cFilename + GetPiece((lstArchive.Items[J]), #9, 1);
                  StrPCopy(pFileName, cFileName);
                  I := addZIP_Include(pFilename);
                  I := addZIP_Delete(True);
                  I := addZIP;
               End;
         Screen.Cursor := crDefault;
      End;
   TopMostOn;
   ListArchiveContents;
   StrDispose(pMessage);
   StrDispose(pFileName);
end;

procedure TQuikZip.mnuPopupDeleteClick(Sender: TObject);
begin
   DeleteFilesFromArchive;
end;

procedure TQuikZip.btnDeleteClick(Sender: TObject);
begin
   DeleteFilesFromArchive;
end;

procedure TQuikZip.TopMostOn;
begin
   If mnuOptionsOnTop.Checked = True Then
      SetWindowPos(QuikZip.Handle, HWND_TOPMOST, 0, 0, 0, 0, (SWP_NOMOVE Or SWP_NOSIZE));
end;

procedure TQuikZip.TopMostOff;
begin
   If mnuOptionsOnTop.Checked = True Then
      SetWindowPos(QuikZip.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, (SWP_NOMOVE Or SWP_NOSIZE));
end;

procedure TQuikZip.ExtractFilesFromArchive;
var
   I, J, Button : Integer;
   cMessage, cFilename : String;
   pMessage, pFilename, pExtractTo : PChar;
begin
   pMessage := StrAlloc(120);
   pFileName := StrAlloc(g_iPathLen);
   pExtractTo := StrAlloc(g_iPathLen);
   cMessage := 'Do you want to extract the ';
   cMessage := cMessage + IntToStr(lstArchive.SelCount);
   cMessage := cMessage + ' selected files from ';
   cMessage := cMessage + StrPas(g_cArchiveName) + '?';
   StrPCopy(pMessage, cMessage);
   TopMostOff;
   Button := Application.MessageBox(pMessage, 'Confirm', MB_YESNO + MB_ICONQUESTION +
    mb_DefButton1);
   if Button = IDYES then
      begin
         Screen.Cursor := crHourglass;
         For J := 0 To (lstArchive.Items.Count - 1) do
            If (lstArchive.Selected[J] <> False) Then
               begin
                  I := addUNZIP_ArchiveName(g_cArchiveName);
                  cFilename := GetPiece((lstArchive.Items[J]), #9, 7);
                  If (cFilename <> '') Then cFilename := cFilename + '/';
                  cFilename := cFilename + GetPiece((lstArchive.Items[J]), #9, 1);
                  StrPCopy(pFileName, cFileName);
                  I := addUNZIP_Include(pFilename);
                  StrPCopy(pExtractTo, g_cExtract);
                  I := addUNZIP_ExtractTo(pExtractTo);
                  I := addUNZIP;
               End;
         Screen.Cursor := crDefault;
      End;
   TopMostOn;
   StrDispose(pMessage);
   StrDispose(pFileName);
   StrDispose(pExtractTo);
   UpdateStatusBar;
end;

procedure TQuikZip.mnuPopupExtractClick(Sender: TObject);
begin
   ExtractFilesFromArchive;
end;

procedure TQuikZip.btnExtractClick(Sender: TObject);
begin
   ExtractFilesFromArchive;
end;

procedure TQuikZip.ViewFiles;
var
   I, J, Button : Integer;
   cFilename : String;
   pFilename, pBuffer : PChar;
begin
   pFileName := StrAlloc(g_iPathLen);
   pBuffer := StrAlloc(1000);
   TopMostOff;
   Screen.Cursor := crHourglass;
   For J := 0 To (lstArchive.Items.Count - 1) do
      If (lstArchive.Selected[J] <> False) Then
         begin
            I := addUNZIP_ArchiveName(g_cArchiveName);
            cFilename := GetPiece((lstArchive.Items[J]), #9, 7);
            If (cFilename <> '') Then cFilename := cFilename + '/';
            cFilename := cFilename + GetPiece((lstArchive.Items[J]), #9, 1);
            StrPCopy(pFileName, cFileName);
            I := addUNZIP_Include(pFilename);
            I := addUNZIP_ToMemory(pBuffer, 1000);
            I := addUNZIP;
            Button := Application.MessageBox(pBuffer, 'Viewing', MB_OK + MB_ICONINFORMATION +
                   mb_DefButton1);
         End;
   Screen.Cursor := crDefault;
   TopMostOn;
   StrDispose(pFileName);
   StrDispose(pBuffer);
   UpdateStatusBar;
end;

procedure TQuikZip.mnuPopupViewClick(Sender: TObject);
begin
   ViewFiles;
end;

procedure TQuikZip.btnViewClick(Sender: TObject);
begin
   ViewFiles;
end;

end.