abzipout.inc

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Abbrevia
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1997-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* ABBREVIA: AbZipOut.inc 3.05                           *}
{*********************************************************}
{* ABBREVIA: Visual Component with Zip and unzip support *}
{* (Source)                                              *}
{*   See AbZipOut.pas for the VCL header                 *}
{*   See AbQZpOut.pas for the CLX header                 *}
{*********************************************************}

{$I AbDefine.inc}

interface

uses
  SysUtils,
  Classes,
{$IFDEF MSWINDOWS}
  Windows,
  Messages,
{$ENDIF}
{$IFDEF LINUX}
  typesarchive,
{$ENDIF}
{$IFDEF UsingCLX}
  QGraphics,
  QComCtrls,
  QImglist,
  QControls,
  QForms,
  AbQMeter,

{$ELSE}
  Graphics,
  Controls,
  Forms,
  StdCtrls,
  Grids,
  ComCtrls,
  {$IFDEF VERSION4}
  Imglist,
  {$ENDIF VERSION4}
  AbMeter,
{$ENDIF}
  AbArcTyp,
  AbBase,
  AbExcept,
  AbUnzPrc,
  AbUtils,
  AbZipPrc,
  AbZipTyp;


{$IFDEF NeedMouseWheel}
const
  Wm_MouseWheel = $020A;
{$ENDIF}

const
  cBitmapHeight = 16;
  cBitmapWidth  = 16;

type
  TAbZipAttribute =
    (zaCompressedSize, zaCompressionMethod, zaCompressionRatio, zaCRC,
     zaExternalFileAttributes, zaInternalFileAttributes, zaEncryption,
     zaTimeStamp, zaUncompressedSize, zaVersionMade, zaVersionNeeded,
     zaComment);

  TAbZipAttributes = set of TAbZipAttribute;

  TMethodStrings = array [ TAbZipCompressionMethod ] of string;

const
  AbDefZipAttributes =
    [zaCompressedSize, zaCompressionMethod, zaCompressionRatio, zaCRC,
     zaExternalFileAttributes, zaEncryption, zaTimeStamp, zaUncompressedSize];

  AbDefColor = clWindow;
  AbDefHierarchy = True;
  AbDefParentColor = False;

{.Z+}
type
  TTreeNodeFriend = class(TTreeNode)
  end;
{.Z-}

type
  TWindowsDropEvent =
    procedure(Sender : TObject; FileName : string) of object;
{$IFDEF NeedMouseWheel}
  TMouseWheelEvent =
    procedure(Sender : TObject; Shift : TShiftState;
              Delta, XPos, YPos : Word) of object;
{$ENDIF}
{TAbZipDisplayOutline does not support Owner-Draw}
type
  TAbZipDisplayOutline = class(TTreeView)
    private
      FDirBitMap          : TBitMap;
      FFileBitMap         : TBitMap;
      FAttrBitMap         : TBitMap;
      FDirBitMapSelected  : TBitMap;
      FFileBitMapSelected : TBitMap;
      FAttrBitMapSelected : TBitMap;
      FImageList          : TImageList;
      FFileIndex          : integer;
      FFileSelectedIndex  : integer;
      FDirectoryIndex     : integer;
      FDirSelectedIndex   : integer;
      FAttrIndex          : integer;
      FBitMapHeight       : integer;
      FBitMapWidth        : integer;
      FAttrSelectedIndex  : integer;

{$IFDEF NeedMouseWheel}
      FOnMouseWheel    : TMouseWheelEvent;
{$ENDIF}
      FOnWindowsDrop   : TWindowsDropEvent;

{$IFNDEF UsingCLX}
      procedure WMDropFiles(var Msg : TWMDropFiles);
        message WM_DROPFILES;
{$ENDIF}
{$IFDEF NeedMouseWheel}
      procedure WMMouseWheel(var Msg : TMessage);
        message WM_MOUSEWHEEL;
{$ENDIF}

      procedure IndexBitmaps;

      procedure SetDirectoryBitMap(Value : TBitmap);
      procedure SetFileBitMap(Value : TBitmap);
      procedure SetAttributeBitMap(Value : TBitmap);
      procedure SetDirectoryBitMapSelected(Value : TBitmap);
      procedure SetFileBitMapSelected(Value : TBitmap);
      procedure SetAttributeBitMapSelected(Value : TBitmap);
      procedure SetBitMapHeight(Value : Integer);
      procedure SetBitMapWidth(Value : Integer);

    protected
      procedure DoOnWindowsDrop(FileName : string); virtual;

{$IFDEF NeedMouseWheel}
      procedure DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
        virtual;
{$ELSE}
  {$IFDEF UsingCLX}
      function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
        const MousePos: TPoint): Boolean;
        override;
  {$ELSE}
          function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
            MousePos: TPoint): Boolean;
            override;
  {$ENDIF}
{$ENDIF}
      procedure Loaded; override;
      procedure SetOnWindowsDrop(Value : TWindowsDropEvent);
    public
      constructor Create(AOwner : TComponent); override;
      destructor Destroy; override;
    public
      property zdPictureDirectory : TBitmap
        read FDirBitMap
        write SetDirectoryBitMap;
      property zdPictureFile : TBitmap
        read FFileBitMap
        write SetFileBitMap;
      property zdPictureZipAttribute : TBitmap
        read FAttrBitMap
        write SetAttributeBitMap;
      property zdPictureDirectorySelected : TBitmap
        read FDirBitMapSelected
        write SetDirectoryBitMapSelected;
      property zdPictureFileSelected : TBitmap
        read FFileBitMapSelected
        write SetFileBitMapSelected;
      property zdPictureZipAttributeSelected : TBitmap
        read FAttrBitMapSelected
        write SetAttributeBitMapSelected;
      property BitMapHeight : Integer
        read FBitMapHeight
        write SetBitMapHeight;
      property BitMapWidth : Integer
        read FBitMapWidth
        write SetBitMapWidth;
{$IFDEF NeedMouseWheel}
      property OnMouseWheel : TMouseWheelEvent
        read FOnMouseWheel
        write FOnMouseWheel;
{$ENDIF}
      property OnWindowsDrop : TWindowsDropEvent
        read FOnWindowsDrop
        write SetOnWindowsDrop;
  end;

type
{$IFDEF UsingClx}
  TAbCustomZipOutline = class(TWidgetControl)
{$ELSE}
  TAbCustomZipOutline = class(TWinControl)
{$ENDIF}
  protected {private}
    FArchive                : TAbZipArchive;                          
    FItemProgressMeter      : TAbMeter;
    FArchiveProgressMeter   : TAbMeter;
    FAttributes             : TAbZipAttributes;
    FAutoSave               : Boolean;
    FBaseDirectory          : string;
    FCompressionMethodToUse : TAbZipSupportedMethod;
    FDeflationOption        : TAbZipDeflationOption;
{$IFDEF WIN32}
    FDOSMode                : Boolean;
{$ENDIF}
    FFileName               : string;
    FExtractOptions         : TAbExtractOptions;
    FHierarchy              : Boolean;
    FLogFile                : string;
    FLogging                : Boolean;
    FSpanningThreshold      : Longint;
    FOutline                : TAbZipDisplayOutline;
    FPassword               : string;
    FPasswordRetries        : Byte;
    FStoreOptions           : TAbStoreOptions;
    FTempDirectory          : string;

    FOnProcessItemFailure   : TAbArchiveItemFailureEvent;
    FOnArchiveItemProgress  : TAbArchiveItemProgressEvent;
    FOnArchiveProgress      : TAbArchiveProgressEvent;
    FOnChange               : TNotifyEvent;
    FOnClick                : TNotifyEvent;
    FOnCollapse             : TTVExpandedEvent;
    FOnConfirmOverwrite     : TAbConfirmOverwriteEvent;
    FOnConfirmProcessItem   : TAbArchiveItemConfirmEvent;
    FOnConfirmSave          : TAbArchiveConfirmEvent;
    FOnDblClick             : TNotifyEvent;
    FOnDragDrop             : TDragDropEvent;
    FOnDragOver             : TDragOverEvent;
    FOnEndDrag              : TEndDragEvent;
    FOnEnter                : TNotifyEvent;
    FOnExit                 : TNotifyEvent;
    FOnExpand               : TTVExpandedEvent;
    FOnKeyDown              : TKeyEvent;
    FOnKeyPress             : TKeyPressEvent;
    FOnKeyUp                : TKeyEvent;
    FOnLoad                 : TAbArchiveEvent;
    FOnMouseDown            : TMouseEvent;
    FOnMouseMove            : TMouseMoveEvent;
    FOnMouseUp              : TMouseEvent;
{$IFDEF NeedMouseWheel}
    FOnMouseWheel           : TMouseWheelEvent;
{$ENDIF}
    FOnNeedPassword         : TAbNeedPasswordEvent;
    FOnRequestImage         : TAbRequestImageEvent;
    FOnRequestLastDisk      : TAbRequestDiskEvent;
    FOnRequestNthDisk       : TAbRequestNthDiskEvent;
    FOnRequestBlankDisk     : TAbRequestDiskEvent;
    FOnSave                 : TAbArchiveEvent;
{$IFDEF Win32}
    FOnStartDrag            : TStartDragEvent;
{$ENDIF Win32}
    FOnWindowsDrop          : TWindowsDropEvent;

  protected {methods}
    procedure AddAttributeNodes(Item : TAbZipItem; oNode : TTreeNode); 
    procedure DoProcessItemFailure(Sender : TObject; Item : TAbArchiveItem;
                                   ProcessType : TAbProcessType;
                                   ErrorClass : TAbErrorClass;
                                   ErrorCode : Integer); virtual;
    procedure DoArchiveItemProgress(Sender : TObject; Item : TAbArchiveItem;
                                    Progress : Byte; var Abort : Boolean); virtual;
    procedure DoArchiveProgress(Sender : TObject; Progress : Byte;
                                var Abort : Boolean); virtual;
    procedure DoChange; virtual;
    procedure DoClick(Sender : TObject); virtual;
    procedure DoCollapse(Sender : TObject; Node: TTreeNode); virtual;
    procedure DoConfirmProcessItem(Sender : TObject; Item : TAbArchiveItem;
                                   ProcessType : TAbProcessType;
                                   var Confirm : Boolean); virtual;
    procedure DoConfirmOverwrite(var Name : string; var Confirm : Boolean); virtual;
    procedure DoConfirmSave(Sender : TObject; var Confirm : Boolean); virtual;
    procedure DoDblClick(Sender : TObject); virtual;
    procedure DoDragDrop(Sender, Source: TObject; X, Y: Integer); virtual;
    procedure DoDragOver(Sender, Source: TObject; X, Y: Integer;
                         State: TDragState; var Accept: Boolean); virtual;
    procedure DoOnEndDrag(Sender, Target: TObject; X, Y: Integer); virtual;
    procedure DoOnEnter(Sender : TObject); virtual;
    procedure DoOnExit(Sender : TObject); virtual;
    procedure DoExpand(Sender: TObject; Node : TTreeNode); virtual;
    procedure DoKeyDown(Sender : TObject; var Key: Word; Shift: TShiftState);
                        virtual;
    procedure DoKeyPress(Sender : TObject; var Key: Char); virtual;
    procedure DoKeyUp(Sender : TObject; var Key: Word; Shift: TShiftState);
                      virtual;
    procedure DoLoad(Sender : TObject); virtual;
    procedure DoMouseDown(Sender : TObject; Button: TMouseButton;
                          Shift: TShiftState; X, Y : Integer); virtual;
    procedure DoMouseMove(Sender : TObject; Shift: TShiftState; X, Y: Integer);
                          virtual;
    procedure DoMouseUp(Sender : TObject; Button: TMouseButton;
                        Shift: TShiftState; X, Y: Integer); virtual;
{$IFDEF NeedMouseWheel}
    procedure DoMouseWheel(Sender : TObject; Shift : TShiftState;
                           Delta, XPos, YPos : Word); virtual;
{$ENDIF}
    procedure DoNeedPassword(Sender : TObject; var NewPassword : string);
                             virtual;
    procedure DoSave(Sender : TObject); virtual;
{$IFDEF WIN32}
    procedure DoOnStartDrag(Sender: TObject; var DragObject: TDragObject);
                            virtual;
{$ENDIF}
    procedure DoWindowsDrop(Sender : TObject; FileName : string); virtual;
    function GetBorderStyle : TBorderStyle;
    function GetCount : Integer;
    function GetCursor : TCursor;
{$IFNDEF UsingCLX}
    function GetDragCursor : TCursor;
{$ENDIF}
    function GetDragMode : TDragMode;
    function GetItem(Index : Integer) : TAbZipItem;
    function GetPictureDirectory : TBitmap;                           
    function GetPictureFile : TBitmap;
    function GetPictureZipAttribute: TBitmap;
    function GetPictureDirectorySelected : TBitmap;                           
    function GetPictureFileSelected : TBitmap;
    function GetPictureZipAttributeSelected : TBitmap;
    function GetPictureHeight : Integer;
    function GetPictureWidth : Integer;
    function GetSelectedItem : LongInt;
    function GetSelectedZipItem : TAbZipItem;
    function GetStatus : TAbArchiveStatus;
    function GetVersion : string;
    function GetZipfileComment : string;
    procedure InitArchive;
    procedure Loaded; override;
    procedure Notification(Component: TComponent; Operation: TOperation);
                           override;