abzipout.inc

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

    {$IFDEF UsingCLX}
    function TAbZipDisplayOutline.DoMouseWheel(Shift: TShiftState;
      WheelDelta: Integer; const MousePos: TPoint): Boolean;
    {$ELSE}
    function TAbZipDisplayOutline.DoMouseWheel(Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint): Boolean;
    {$ENDIF}
     const
       WHEEL_DELTA = 120;
     var
      oHold : TTreeNode;
      oNode : TTreeNode;
    begin
      { We always return true - if there's an event handler that returns }
      { false, we'll do the work; if it returns true, the work has been  }
      { done, ergo this routine should return true.                      }
      Result := True;
      if not inherited DoMouseWheel(Shift, WheelDelta, MousePos) then begin
        if Items.Count = 0 then
          Exit;
    
          if Selected = nil then
            exit;
          if Selected.HasChildren then
            Selected.Expand( false );
            
          oNode := nil;
          oHold := Selected;  
          if WheelDelta < 0 then begin
            if oHold.HasChildren then
              oNode := oHold.getFirstChild;
            if oNode = nil then
              oNode := oHold.GetNextChild( oHold );
            if oNode = nil then
              oNode := oHold.GetNext;
          end else begin
            oNode := oHold.GetPrevChild( oHold );
            if oNode <> nil then begin
              if oNode.HasChildren then
                oNode := oNode.GetLastChild;
            end else
              oNode := oHold.GetPrev;
          end;
          if oNode <> nil then
            Selected := oNode;
      end;
    end; 
  {$ENDIF}
{$ENDIF}
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.SetOnWindowsDrop(Value : TWindowsDropEvent);
{$IFNDEF UsingCLX}
var
  WasAccepting : Boolean;
{$ENDIF}
begin
{$IFNDEF UsingCLX}
  WasAccepting := Assigned(FOnWindowsDrop);
  FOnWindowsDrop := Value;
  if csLoading in ComponentState then
    Exit;
  if csDestroying in ComponentState then
    Exit;
  if Assigned(Value) then
    DragAcceptFiles(Handle, True)
  else if WasAccepting then
    DragAcceptFiles(Handle, False);
{$ENDIF}
end;
{ -------------------------------------------------------------------------- }
{ ========================================================================== }
{ -------------------------------------------------------------------------- }
constructor TAbCustomZipOutline.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Width := 300;
  Height := 143;
  Color := AbDefColor;
  ParentColor := AbDefParentColor;

  FOutline := TAbZipDisplayOutline.Create(Self);
  FOutline.Parent := Self;
  FOutline.Visible := True;
  FOutline.Align := alClient;
  FOutline.ParentColor := True;
{$IFNDEF UsingCLX}
  FOutline.ParentCtl3D := True;
{$ENDIF}
  FOutline.ParentFont := True;
  FOutline.ParentShowHint := True;

  FOutline.Images := FOutline.FImageList;

  AutoSave := AbDefAutoSave;
  Attributes := AbDefZipAttributes;
  CompressionMethodToUse := AbDefCompressionMethodToUse;
  DeflationOption := AbDefDeflationOption;
  ExtractOptions := AbDefExtractOptions;
  Hierarchy := AbDefHierarchy;
  PasswordRetries := AbDefPasswordRetries;
  StoreOptions := AbDefStoreOptions;
end;
{ -------------------------------------------------------------------------- }
destructor TAbCustomZipOutline.Destroy;
begin
  FArchive.Free;
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.AddAttributeNodes( Item : TAbZipItem;
                                                 oNode : TTreeNode );
var
  ExtAttrString : string;
  dt : TDateTime;
  li : LongInt;
  s : string;
  tmpNode : TTreeNode;
begin
  with Item do begin
    if zaCompressedSize in Attributes then begin
      tmpNode := FOutline.Items.AddChild(oNode,
                         Format(AbStrRes(AbCompressedSizeFormat),
                                 [CompressedSize]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
    if zaUnCompressedSize in Attributes then begin
      tmpNode := FOutline.Items.AddChild(oNode,                       
                         Format(AbStrRes(AbUncompressedSizeFormat),
                                 [UncompressedSize]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
    if zaCompressionMethod in Attributes then begin
      tmpNode := FOutline.Items.AddChild(oNode,                       
                         Format(AbStrRes(AbCompressionMethodFormat),
                                 [MethodStrings[CompressionMethod]]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
    if zaCompressionRatio in Attributes then begin
      tmpNode := FOutline.Items.AddChild(oNode,                       
                         Format(AbStrRes(AbCompressionRatioFormat),
                                 [CompressionRatio]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
    if zaCRC in Attributes then begin
      tmpNode := FOutline.Items.AddChild(oNode,                       
                         Format(AbStrRes(AbCRCFormat),
                                 [CRC32]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
    if zaExternalFileAttributes in Attributes then begin
      ExtAttrString := '';
{$IFDEF MSWINDOWS}
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF}
      if (faReadOnly and ExternalFileAttributes) = faReadOnly then
        ExtAttrString := ExtAttrString + AbStrRes(AbReadOnly);
      if (faHidden and ExternalFileAttributes) = faHidden then
        ExtAttrString := ExtAttrString + AbStrRes(AbHidden);
      if (faSysFile and ExternalFileAttributes) = faSysFile then
        ExtAttrString := ExtAttrString + AbStrRes(AbSystem);
      if (faArchive and ExternalFileAttributes) = faArchive then
        ExtAttrString := ExtAttrString + AbStrRes(AbArchived);
{$IFDEF Version6} {$WARN SYMBOL_PLATFORM ON} {$ENDIF}
{$ENDIF}
      tmpNode := FOutline.Items.AddChild(oNode,
                         Format(AbStrRes(AbEFAFormat),
                                 [ExtAttrString]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
    if zaInternalFileAttributes in Attributes then
      if InternalFileAttributes = 1 then begin
        tmpNode := FOutline.Items.AddChild(oNode,                     
                           Format(AbStrRes(AbIFAFormat),
                                   [AbStrRes(AbText)]));
        tmpNode.ImageIndex    := FOutline.FAttrIndex;
        tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
      end else begin
        tmpNode := FOutline.Items.AddChild(oNode,
                           Format(AbStrRes(AbIFAFormat),
                                   [AbStrRes(AbBinary)]));
        tmpNode.ImageIndex    := FOutline.FAttrIndex;
        tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
      end;
    if zaEncryption in Attributes then
      if IsEncrypted then begin
        tmpNode := FOutline.Items.AddChild(oNode,                     
                           Format(AbStrRes(AbEncryptionFormat),
                                   [AbStrRes(AbEncrypted)]));
        tmpNode.ImageIndex    := FOutline.FAttrIndex;
        tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
      end else begin
        tmpNode := FOutline.Items.AddChild(oNode,                     
                           Format(AbStrRes(AbEncryptionFormat),
                                   [AbStrRes(AbNotEncrypted)]));
        tmpNode.ImageIndex    := FOutline.FAttrIndex;
        tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
      end;
    if zaTimeStamp in Attributes then begin
      if (LastModFileDate + LastModFileTime = 0) then
        s := AbStrRes(AbUnknown)
      else begin
        li := LongInt(LastModFileDate) shl 16 + LastModFileTime;
        dt := FileDateToDateTime(li);
        s := DateTimeToStr(dt);
      end;
      tmpNode := FOutline.Items.AddChild(oNode,                     
                         Format(AbStrRes(AbTimeStampFormat), [s]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
    if zaVersionMade in Attributes then begin
      tmpNode := FOutline.Items.AddChild(oNode,                     
                         Format(AbStrRes(AbMadeByFormat),
                                 [Lo(VersionMadeBy)/ 10.0]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
    if zaVersionNeeded in Attributes then begin
      tmpNode := FOutline.Items.AddChild(oNode,                     
                         Format(AbStrRes(AbNeededFormat),
                                 [Lo(VersionNeededToExtract)/ 10.0]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
    if zaComment in Attributes then begin
      tmpNode := FOutline.Items.AddChild(oNode,
                         Format(AbStrRes(AbCommentFormat),
                                 [FileComment]));
      tmpNode.ImageIndex    := FOutline.FAttrIndex;
      tmpNode.SelectedIndex := FOutline.FAttrSelectedIndex;
    end;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.AddFiles(const FileMask : string;
                                       SearchAttr : Integer);
  {Add files to the archive where the disk filespec matches}
begin
  if Assigned(FArchive) then
    FArchive.AddFiles(FileMask, SearchAttr)
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.AddFilesEx(const FileMask, ExclusionMask : string;
                                         SearchAttr : Integer);
  {Add files that match Filemask except those matching ExclusionMask}
begin
  if Assigned(FArchive) then
    FArchive.AddFilesEx(FileMask, ExclusionMask, SearchAttr)
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.AddFromStream(const NewName : string;
                                            FromStream : TStream);
  {Add zip item directly from TStream descendant}
begin
  if Assigned(FArchive) then begin
    FromStream.Position := 0;
    FArchive.AddFromStream(NewName, FromStream);
  end else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.ClearTags;
  {Clear all tags from the archive}
begin
  if Assigned(FArchive) then
    FArchive.ClearTags
  else
    raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.DeleteAt(Index : Integer);
  {delete item at Index}
begin
  if Assigned( FArchive ) then
    FArchive.DeleteAt( Index )
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.DeleteFiles(const FileMask : string);
  {delete all files from the archive that match the file mask}
begin
  if Assigned(FArchive) then
    FArchive.DeleteFiles(FileMask)
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.DeleteFilesEx(const FileMask, ExclusionMask : string);
  {Delete files that match Filemask except those matching ExclusionMask}
begin
  if Assigned(FArchive) then
    FArchive.DeleteFilesEx(FileMask, ExclusionMask)
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.DeleteTaggedItems;
  {delete all tagged items from the archive}
begin
  if Assigned(FArchive) then
    FArchive.DeleteTaggedItems
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.DoProcessItemFailure(Sender : TObject;
                                              Item : TAbArchiveItem;
                                              ProcessType : TAbProcessType;
                                              ErrorClass : TAbErrorClass;
                                              ErrorCode : Integer);
begin
  if Assigned(FOnProcessItemFailure) then
    FOnProcessItemFailure(Self, Item, ProcessType, ErrorClass, ErrorCode);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.DoArchiveItemProgress(Sender : TObject;
                                               Item : TAbArchiveItem;
                                               Progress : Byte;
                                               var Abort : Boolean);
begin
  Abort := False;
  if Assigned(FItemProgressMeter) then
    FItemProgressMeter.DoProgress(Progress);
  if Assigned(FOnArchiveItemProgress) then
    FOnArchiveItemProgress(Self, Item, Progress, Abort);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.DoArchiveProgress(Sender : TObject;
                                           Progress : Byte;
                                           var Abort : Boolean);
begin
  Abort := False;
  if Assigned(FArchiveProgressMeter) then
    FArchiveProgressMeter.DoProgress(Progress);
  if Assigned(FOnArchiveProgress) then
    FOnArchiveProgress(Self, Progress, Abort);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipOutline.DoChange;
begin
  {Archive now points to the new zip file}
  UpdateOutline;
  {then, call the FOnChange event...}
  if Assigned(FOnChange) then
    FOnChange(Self);
end;
{ -------------------------------------------------------------------------- }