mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-21 09:58:13 +00:00
DEL: Unused units
This commit is contained in:
Alexander Koblov
parent
a3381d91d0
commit
ad6930d143
3 changed files with 0 additions and 761 deletions
|
|
@ -1,281 +0,0 @@
|
|||
(* ***** 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: ABUnzper.pas 3.05 *}
|
||||
{*********************************************************}
|
||||
{* ABBREVIA: Non-visual Component with UnZip support *}
|
||||
{*********************************************************}
|
||||
|
||||
unit AbUnzper;
|
||||
|
||||
{$I AbDefine.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes,
|
||||
AbBrowse, AbZBrows,
|
||||
AbArcTyp, AbBase, AbUtils, AbZipTyp;
|
||||
|
||||
type
|
||||
TAbCustomUnZipper = class(TAbCustomZipBrowser)
|
||||
protected {private}
|
||||
FExtractOptions : TAbExtractOptions;
|
||||
FOnConfirmOverwrite : TAbConfirmOverwriteEvent;
|
||||
FOnNeedPassword : TAbNeedPasswordEvent;
|
||||
FPasswordRetries : Byte;
|
||||
|
||||
protected {methods}
|
||||
procedure DoConfirmOverwrite(var Name : string;
|
||||
var Confirm : Boolean);
|
||||
virtual;
|
||||
procedure DoNeedPassword(Sender : TObject;
|
||||
var NewPassword : AnsiString);
|
||||
virtual;
|
||||
procedure InitArchive; override;
|
||||
procedure SetExtractOptions(Value : TAbExtractOptions);
|
||||
procedure SetPasswordRetries(Value : Byte);
|
||||
procedure UnzipProc(Sender : TObject; Item : TAbArchiveItem;
|
||||
const NewName : string );
|
||||
procedure UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem;
|
||||
OutStream : TStream);
|
||||
procedure TestItemProc(Sender : TObject; Item : TAbArchiveItem);
|
||||
|
||||
procedure SetFileName(const aFileName : string);
|
||||
override;
|
||||
|
||||
protected {properties}
|
||||
property ExtractOptions : TAbExtractOptions
|
||||
read FExtractOptions
|
||||
write SetExtractOptions
|
||||
default AbDefExtractOptions;
|
||||
property OnConfirmOverwrite : TAbConfirmOverwriteEvent
|
||||
read FOnConfirmOverwrite
|
||||
write FOnConfirmOverwrite;
|
||||
property OnNeedPassword : TAbNeedPasswordEvent
|
||||
read FOnNeedPassword
|
||||
write FOnNeedPassword;
|
||||
property PasswordRetries : Byte
|
||||
read FPasswordRetries
|
||||
write SetPasswordRetries
|
||||
default AbDefPasswordRetries;
|
||||
|
||||
public {methods}
|
||||
constructor Create( AOwner : TComponent );
|
||||
override;
|
||||
destructor Destroy;
|
||||
override;
|
||||
procedure ExtractAt(Index : Integer; const NewName : string);
|
||||
procedure ExtractFiles(const FileMask : string);
|
||||
procedure ExtractFilesEx(const FileMask, ExclusionMask : string);
|
||||
procedure ExtractToStream(const aFileName : string; ToStream : TStream);
|
||||
procedure ExtractTaggedItems;
|
||||
procedure TestTaggedItems;
|
||||
end;
|
||||
|
||||
TAbUnZipper = class(TAbCustomUnZipper)
|
||||
published
|
||||
property ArchiveProgressMeter;
|
||||
property ItemProgressMeter;
|
||||
property BaseDirectory;
|
||||
property ExtractOptions;
|
||||
property LogFile;
|
||||
property Logging;
|
||||
property OnArchiveProgress;
|
||||
property OnArchiveItemProgress;
|
||||
property OnChange;
|
||||
property OnConfirmOverwrite;
|
||||
property OnConfirmProcessItem;
|
||||
property OnLoad;
|
||||
property OnNeedPassword;
|
||||
property OnRequestImage;
|
||||
property OnProcessItemFailure;
|
||||
property OnRequestLastDisk;
|
||||
property OnRequestNthDisk;
|
||||
property Password;
|
||||
property PasswordRetries;
|
||||
property TempDirectory;
|
||||
property Version;
|
||||
property FileName; {must be after OnLoad}
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
AbExcept,
|
||||
AbUnzPrc;
|
||||
|
||||
{ -------------------------------------------------------------------------- }
|
||||
constructor TAbCustomUnZipper.Create( AOwner : TComponent );
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ExtractOptions := AbDefExtractOptions;
|
||||
PasswordRetries := AbDefPasswordRetries;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
destructor TAbCustomUnZipper.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.DoConfirmOverwrite(var Name : string;
|
||||
var Confirm : Boolean);
|
||||
begin
|
||||
Confirm := True;
|
||||
if Assigned(FOnConfirmOverwrite) then
|
||||
FOnConfirmOverwrite( Name, Confirm );
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.DoNeedPassword(Sender : TObject;
|
||||
var NewPassword : AnsiString);
|
||||
begin
|
||||
if Assigned(FOnNeedPassword) then begin
|
||||
FOnNeedPassword(Self, NewPassword);
|
||||
Password := NewPassword;
|
||||
end;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.ExtractAt(Index : Integer; const NewName : string);
|
||||
{extract a file from the archive that match the index}
|
||||
begin
|
||||
if (ZipArchive <> nil) then
|
||||
ZipArchive.ExtractAt(Index, NewName)
|
||||
else
|
||||
raise EAbNoArchive.Create;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.ExtractFiles(const FileMask : string);
|
||||
{extract all files from the archive that match the mask}
|
||||
begin
|
||||
if (ZipArchive <> nil) then
|
||||
ZipArchive.ExtractFiles( FileMask )
|
||||
else
|
||||
raise EAbNoArchive.Create;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.ExtractFilesEx(const FileMask, ExclusionMask : string);
|
||||
{extract files matching FileMask except those matching ExclusionMask}
|
||||
begin
|
||||
if (ZipArchive <> nil) then
|
||||
ZipArchive.ExtractFilesEx(FileMask, ExclusionMask)
|
||||
else
|
||||
raise EAbNoArchive.Create;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.ExtractToStream(const aFileName : string;
|
||||
ToStream : TStream);
|
||||
begin
|
||||
if (ZipArchive <> nil) then
|
||||
ZipArchive.ExtractToStream(aFileName, ToStream)
|
||||
else
|
||||
raise EAbNoArchive.Create;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.ExtractTaggedItems;
|
||||
{extract all tagged items from the archive}
|
||||
begin
|
||||
if (ZipArchive <> nil) then
|
||||
ZipArchive.ExtractTaggedItems
|
||||
else
|
||||
raise EAbNoArchive.Create;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.InitArchive;
|
||||
begin
|
||||
inherited InitArchive;
|
||||
if (ZipArchive <> nil) then begin
|
||||
{properties}
|
||||
ZipArchive.ExtractOptions := FExtractOptions;
|
||||
TAbZipArchive(ZipArchive).PasswordRetries := FPasswordRetries;
|
||||
{events}
|
||||
ZipArchive.OnConfirmOverwrite := DoConfirmOverwrite;
|
||||
TAbZipArchive(ZipArchive).OnNeedPassword := DoNeedPassword;
|
||||
TAbZipArchive(ZipArchive).TestHelper := TestItemProc;
|
||||
TAbZipArchive(ZipArchive).ExtractHelper := UnzipProc;
|
||||
TAbZipArchive(ZipArchive).ExtractToStreamHelper := UnzipToStreamProc;
|
||||
end;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.SetExtractOptions(Value : TAbExtractOptions);
|
||||
begin
|
||||
FExtractOptions := Value;
|
||||
if (ZipArchive <> nil) then
|
||||
ZipArchive.ExtractOptions := Value;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.SetPasswordRetries(Value : Byte);
|
||||
begin
|
||||
FPasswordRetries := Value;
|
||||
if (ZipArchive <> nil) then
|
||||
TAbZipArchive(ZipArchive).PasswordRetries := Value;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.TestTaggedItems;
|
||||
{Test specified items}
|
||||
begin
|
||||
if (ZipArchive <> nil) then
|
||||
ZipArchive.TestTaggedItems
|
||||
else
|
||||
raise EAbNoArchive.Create;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.UnzipProc(Sender : TObject;
|
||||
Item : TAbArchiveItem;
|
||||
const NewName : string);
|
||||
begin
|
||||
AbUnzip( TAbZipArchive(Sender), TAbZipItem(Item), NewName);
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.UnzipToStreamProc(Sender : TObject;
|
||||
Item : TAbArchiveItem;
|
||||
OutStream : TStream);
|
||||
begin
|
||||
AbUnzipToStream(TAbZipArchive(Sender), TAbZipItem(Item), OutStream);
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
procedure TAbCustomUnZipper.TestItemProc(Sender : TObject;
|
||||
Item : TAbArchiveItem);
|
||||
begin
|
||||
AbTestZipItem(TAbZipArchive(Sender), TAbZipItem(Item));
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
|
||||
procedure TAbCustomUnZipper.SetFileName(const aFileName: string);
|
||||
begin
|
||||
if aFileName <> '' then
|
||||
begin
|
||||
if not mbFileExists(aFileName) then {!!.05}
|
||||
raise EAbFileNotFound.Create;
|
||||
if AbFileGetSize(aFileName) <= 0 then {!!.05}
|
||||
raise EAbBadStream.Create;
|
||||
end;
|
||||
|
||||
inherited SetFileName(aFileName);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -1,165 +0,0 @@
|
|||
(* ***** 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: AbZipExt.pas 3.05 *}
|
||||
{*********************************************************}
|
||||
{* ABBREVIA: Zip file registration *}
|
||||
{*********************************************************}
|
||||
|
||||
{$I AbDefine.inc}
|
||||
|
||||
unit AbZipExt;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes;
|
||||
|
||||
function AbExistingZipAssociation : Boolean;
|
||||
function AbGetZipAssociation(var App, ID, FileType : string) : Boolean;
|
||||
function AbRegisterZipExtension(const App : string;
|
||||
ID, FileType : string;
|
||||
Replace : Boolean) : Boolean;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$IFDEF MSWINDOWS}
|
||||
Windows,
|
||||
Messages,
|
||||
Registry,
|
||||
ShellAPI,
|
||||
{$ENDIF}
|
||||
{$IFDEF LINUX}
|
||||
Libc,
|
||||
{$ENDIF}
|
||||
AbConst;
|
||||
|
||||
const
|
||||
ZipExt = '.zip';
|
||||
DefZipID = 'Zip';
|
||||
DefZipType = 'Zip File';
|
||||
OpenCommand = 'Shell\Open\Command';
|
||||
DefaultIcon = 'DefaultIcon';
|
||||
|
||||
{$ifndef linux}
|
||||
var
|
||||
Reg : TRegistry;
|
||||
|
||||
{ -------------------------------------------------------------------------- }
|
||||
function AbExistingZipAssociation : Boolean;
|
||||
var
|
||||
App, ID, FileType : string;
|
||||
begin
|
||||
Result := False;
|
||||
Reg := TRegistry.Create;
|
||||
Reg.RootKey := HKEY_CLASSES_ROOT;
|
||||
Reg.OpenKey('',False);
|
||||
if Reg.OpenKey(ZipExt, False) then begin
|
||||
ID := Reg.ReadString('');
|
||||
if Reg.OpenKey('\' + ID, False) then begin
|
||||
FileType := Reg.ReadString('');
|
||||
if Reg.OpenKey(OpenCommand, False) then begin
|
||||
App := Reg.ReadString('');
|
||||
if (App <> '') then
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Reg.Free;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
function AbGetZipAssociation(var App, ID, FileType : string) : Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
Reg := TRegistry.Create;
|
||||
Reg.RootKey := HKEY_CLASSES_ROOT;
|
||||
Reg.OpenKey('',False);
|
||||
if Reg.OpenKey(ZipExt, False) then begin
|
||||
ID := Reg.ReadString('');
|
||||
if Reg.OpenKey('\' + ID, False) then begin
|
||||
FileType := Reg.ReadString('');
|
||||
if Reg.OpenKey(OpenCommand, False) then begin
|
||||
App := Reg.ReadString('');
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Reg.Free;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
function AbRegisterZipExtension(const App : string;
|
||||
ID, FileType : string;
|
||||
Replace : Boolean) : Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if AbExistingZipAssociation and not Replace then
|
||||
Exit;
|
||||
try
|
||||
if (ID = '') then
|
||||
ID := DefZipID;
|
||||
if (FileType = '') then
|
||||
FileType := DefZipType;
|
||||
Reg := TRegistry.Create;
|
||||
Reg.RootKey := HKEY_CLASSES_ROOT;
|
||||
Reg.OpenKey('',False);
|
||||
Reg.OpenKey(ZipExt, True);
|
||||
Reg.WriteString('', ID);
|
||||
Reg.OpenKey('\' + ID, True);
|
||||
Reg.WriteString('', FileType);
|
||||
Reg.OpenKey(OpenCommand, True);
|
||||
Reg.WriteString('', App);
|
||||
Reg.OpenKey('\' + DefaultIcon, True);
|
||||
Reg.WriteString('', App + ',0');
|
||||
Result := True;
|
||||
finally
|
||||
Reg.Free;
|
||||
end;
|
||||
end;
|
||||
{ -------------------------------------------------------------------------- }
|
||||
{$else}
|
||||
|
||||
function AbExistingZipAssociation : Boolean;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
function AbGetZipAssociation(var App, ID, FileType : string) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
function AbRegisterZipExtension(App, ID, FileType : string; Replace : Boolean) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=false
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
|
|
@ -1,315 +0,0 @@
|
|||
(* ***** 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: AbZLTyp.pas *}
|
||||
{*********************************************************}
|
||||
{* ABBREVIA: TAbZlItem class *}
|
||||
{*********************************************************}
|
||||
{* Misc. constants, types, and routines for working *}
|
||||
{* with ZLib compressed data *}
|
||||
{* See: RFC 1950 *}
|
||||
{* "ZLIB Compressed Data Format Specification *}
|
||||
{* version 3.3" for more information on ZLib *}
|
||||
{*********************************************************}
|
||||
|
||||
unit AbZLTyp;
|
||||
|
||||
{$I AbDefine.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, AbUtils, AbArcTyp, AbZipPrc, AbDfBase, AbDfDec, AbDfEnc;
|
||||
|
||||
const
|
||||
AB_ZL_PRESET_DICT = $20;
|
||||
|
||||
AB_ZL_DEF_COMPRESSIONMETHOD = $8; { Deflate }
|
||||
AB_ZL_DEF_COMPRESSIONINFO = $7; { 32k window for Deflate }
|
||||
|
||||
AB_ZL_FASTEST_COMPRESSION = $0;
|
||||
AB_ZL_FAST_COMPRESSION = $1;
|
||||
AB_ZL_DEFAULT_COMPRESSION = $2;
|
||||
AB_ZL_MAXIMUM_COMPRESSION = $3;
|
||||
|
||||
AB_ZL_FCHECK_MASK = $1F;
|
||||
AB_ZL_CINFO_MASK = $F0; { mask out leftmost 4 bits }
|
||||
AB_ZL_FLEVEL_MASK = $C0; { mask out leftmost 2 bits }
|
||||
AB_ZL_CM_MASK = $0F; { mask out rightmost 4 bits }
|
||||
|
||||
|
||||
type
|
||||
TAbZLHeader = packed record
|
||||
CMF : Byte;
|
||||
FLG : Byte;
|
||||
end;
|
||||
|
||||
TAbZLItem = class(TAbArchiveItem)
|
||||
private
|
||||
function GetCompressionInfo: Byte;
|
||||
function GetCompressionLevel: Byte;
|
||||
function GetIsPresetDictionaryPresent: Boolean;
|
||||
procedure SetCompressionInfo(Value: Byte);
|
||||
procedure SetCompressionLevel(Value: Byte);
|
||||
function GetCompressionMethod: Byte;
|
||||
procedure SetCompressionMethod(Value: Byte);
|
||||
function GetFCheck: Byte;
|
||||
procedure MakeFCheck;
|
||||
protected { private }
|
||||
FZLHeader : TAbZlHeader;
|
||||
FAdler32 : LongInt;
|
||||
public
|
||||
constructor Create;
|
||||
|
||||
property IsPresetDictionaryPresent : Boolean
|
||||
read GetIsPresetDictionaryPresent;
|
||||
property CompressionLevel : Byte
|
||||
read GetCompressionLevel write SetCompressionLevel;
|
||||
property CompressionInfo : Byte
|
||||
read GetCompressionInfo write SetCompressionInfo;
|
||||
|
||||
property CompressionMethod : Byte
|
||||
read GetCompressionMethod write SetCompressionMethod;
|
||||
property Adler32 : LongInt
|
||||
read FAdler32 write FAdler32;
|
||||
|
||||
property FCheck : Byte
|
||||
read GetFCheck;
|
||||
|
||||
procedure SaveZLHeaderToStream(AStream : TStream);
|
||||
procedure ReadZLHeaderFromStream(AStream : TStream);
|
||||
end;
|
||||
|
||||
TAbZLStreamHelper = class(TAbArchiveStreamHelper)
|
||||
protected { private }
|
||||
FItem : TAbZLItem;
|
||||
public
|
||||
constructor Create(AStream : TStream);
|
||||
destructor Destroy; override;
|
||||
|
||||
property Item : TAbZLItem
|
||||
read FItem;
|
||||
|
||||
procedure ExtractItemData(AStream : TStream); override;
|
||||
function FindFirstItem : Boolean; override;
|
||||
function FindNextItem : Boolean; override;
|
||||
procedure ReadHeader; override;
|
||||
procedure ReadTail; override;
|
||||
function SeekItem(Index : Integer): Boolean; override;
|
||||
procedure WriteArchiveHeader; override;
|
||||
procedure WriteArchiveItem(AStream : TStream); override;
|
||||
procedure WriteArchiveTail; override;
|
||||
function GetItemCount : Integer; override;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TAbZLStreamHelper }
|
||||
|
||||
constructor TAbZLStreamHelper.Create(AStream: TStream);
|
||||
begin
|
||||
inherited Create(AStream);
|
||||
FItem := TAbZLItem.Create;
|
||||
end;
|
||||
|
||||
destructor TAbZLStreamHelper.Destroy;
|
||||
begin
|
||||
FItem.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TAbZLStreamHelper.ExtractItemData(AStream: TStream);
|
||||
{ assumes already positioned appropriately }
|
||||
var
|
||||
Hlpr : TAbDeflateHelper;
|
||||
begin
|
||||
Hlpr := TAbDeflateHelper.Create;
|
||||
Hlpr.Options := Hlpr.Options or dfc_UseAdler32;
|
||||
if not FItem.IsPresetDictionaryPresent then
|
||||
Inflate(FStream, AStream, Hlpr)
|
||||
else
|
||||
raise Exception.Create('preset dictionaries unsupported');
|
||||
Hlpr.Free;
|
||||
end;
|
||||
|
||||
function TAbZLStreamHelper.FindFirstItem: Boolean;
|
||||
var
|
||||
ZLH : TAbZLHeader;
|
||||
begin
|
||||
FStream.Seek(0, soFromBeginning);
|
||||
Result := FStream.Read(ZLH, SizeOf(TAbZLHeader)) = SizeOf(TAbZLHeader);
|
||||
FItem.FZLHeader := ZLH;
|
||||
FStream.Seek(0, soFromBeginning);
|
||||
end;
|
||||
|
||||
function TAbZLStreamHelper.FindNextItem: Boolean;
|
||||
begin
|
||||
{ only one item in a ZLib Stream }
|
||||
Result := FindFirstItem;
|
||||
end;
|
||||
|
||||
function TAbZLStreamHelper.GetItemCount: Integer;
|
||||
begin
|
||||
{ only one item in a ZLib Stream }
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
procedure TAbZLStreamHelper.ReadHeader;
|
||||
{ assumes already positioned appropriately }
|
||||
var
|
||||
ZLH : TAbZLHeader;
|
||||
begin
|
||||
FStream.Read(ZLH, SizeOf(TAbZlHeader));
|
||||
FItem.FZLHeader := ZLH;
|
||||
end;
|
||||
|
||||
procedure TAbZLStreamHelper.ReadTail;
|
||||
{ assumes already positioned appropriately }
|
||||
var
|
||||
Adler: LongInt;
|
||||
begin
|
||||
FStream.Read(Adler, SizeOf(LongInt));
|
||||
FItem.Adler32 := Adler;
|
||||
end;
|
||||
|
||||
function TAbZLStreamHelper.SeekItem(Index: Integer): Boolean;
|
||||
begin
|
||||
{ only one item in a ZLib Stream }
|
||||
if Index <> 1 then
|
||||
Result := False
|
||||
else
|
||||
Result := FindFirstItem;
|
||||
end;
|
||||
|
||||
procedure TAbZLStreamHelper.WriteArchiveHeader;
|
||||
begin
|
||||
Item.SaveZLHeaderToStream(FStream);
|
||||
end;
|
||||
|
||||
procedure TAbZLStreamHelper.WriteArchiveItem(AStream: TStream);
|
||||
var
|
||||
Hlpr : TAbDeflateHelper;
|
||||
begin
|
||||
{ Compress file }
|
||||
Hlpr := TAbDeflateHelper.Create;
|
||||
Hlpr.Options := Hlpr.Options or dfc_UseAdler32;
|
||||
Item.Adler32 := AbDfEnc.Deflate(AStream, FStream, Hlpr);
|
||||
Hlpr.Free;
|
||||
end;
|
||||
|
||||
procedure TAbZLStreamHelper.WriteArchiveTail;
|
||||
var
|
||||
Ad32 : LongInt;
|
||||
begin
|
||||
Ad32 := AbSwapLongEndianness(Item.Adler32);
|
||||
FStream.Write(Ad32, SizeOf(LongInt));
|
||||
end;
|
||||
|
||||
{ TAbZLItem }
|
||||
|
||||
constructor TAbZLItem.Create;
|
||||
begin
|
||||
{ Set default Values for fields }
|
||||
FillChar(FZLHeader, SizeOf(TAbZlHeader), #0);
|
||||
FZLHeader.CMF := (AB_ZL_DEF_COMPRESSIONINFO shl 4); { 32k Window size }
|
||||
FZLHeader.CMF := FZLHeader.CMF or AB_ZL_DEF_COMPRESSIONMETHOD; { Deflate }
|
||||
FZLHeader.FLG := FZLHeader.FLG and not AB_ZL_PRESET_DICT; { no preset dictionary}
|
||||
FZLHeader.FLG := FZLHeader.FLG or (AB_ZL_DEFAULT_COMPRESSION shl 6); { assume default compression }
|
||||
MakeFCheck;
|
||||
end;
|
||||
|
||||
function TAbZLItem.GetCompressionInfo: Byte;
|
||||
begin
|
||||
Result := FZLHeader.CMF shr 4;
|
||||
end;
|
||||
|
||||
function TAbZLItem.GetCompressionLevel: Byte;
|
||||
begin
|
||||
Result := FZLHeader.FLG shr 6;
|
||||
end;
|
||||
|
||||
function TAbZLItem.GetCompressionMethod: Byte;
|
||||
begin
|
||||
Result := FZLHeader.CMF and AB_ZL_CM_MASK;
|
||||
end;
|
||||
|
||||
function TAbZLItem.GetFCheck: Byte;
|
||||
begin
|
||||
Result := FZLHeader.FLG and AB_ZL_FCHECK_MASK;
|
||||
end;
|
||||
|
||||
function TAbZLItem.GetIsPresetDictionaryPresent: Boolean;
|
||||
begin
|
||||
Result := (FZLHeader.FLG and AB_ZL_PRESET_DICT) = AB_ZL_PRESET_DICT;
|
||||
end;
|
||||
|
||||
procedure TAbZLItem.MakeFCheck;
|
||||
{ create the FCheck value for the current Header }
|
||||
var
|
||||
zlh : Word;
|
||||
begin
|
||||
FZLHeader.FLG := FZLHeader.FLG and not AB_ZL_FCHECK_MASK;
|
||||
zlh := (FZLHeader.CMF * 256) + FZLHeader.FLG;
|
||||
Inc(FZLHeader.FLG, 31 - (zlh mod 31));
|
||||
end;
|
||||
|
||||
procedure TAbZLItem.ReadZLHeaderFromStream(AStream: TStream);
|
||||
begin
|
||||
AStream.Read(FZLHeader, SizeOf(TAbZLHeader));
|
||||
end;
|
||||
|
||||
procedure TAbZLItem.SaveZLHeaderToStream(AStream: TStream);
|
||||
begin
|
||||
MakeFCheck;
|
||||
AStream.Write(FZLHeader, SizeOf(TAbZlHeader));
|
||||
end;
|
||||
|
||||
procedure TAbZLItem.SetCompressionInfo(Value: Byte);
|
||||
begin
|
||||
FZLHeader.CMF := FZLHeader.CMF and not AB_ZL_CINFO_MASK;
|
||||
FZLHeader.CMF := FZLHeader.CMF or (Value shl 4); { shift value and add to bit field }
|
||||
end;
|
||||
|
||||
procedure TAbZLItem.SetCompressionLevel(Value: Byte);
|
||||
var
|
||||
Temp : Byte;
|
||||
begin
|
||||
Temp := Value;
|
||||
if not Temp in [AB_ZL_FASTEST_COMPRESSION..AB_ZL_MAXIMUM_COMPRESSION] then
|
||||
Temp := AB_ZL_DEFAULT_COMPRESSION;
|
||||
FZLHeader.FLG := FZLHeader.FLG and not AB_ZL_FLEVEL_MASK;
|
||||
FZLHeader.FLG := FZLHeader.FLG or (Temp shl 6); { shift value and add to bit field }
|
||||
end;
|
||||
|
||||
procedure TAbZLItem.SetCompressionMethod(Value: Byte);
|
||||
begin
|
||||
if Value > AB_ZL_CM_MASK then Value := (Value shl 4) shr 4;
|
||||
FZLHeader.CMF := FZLHeader.CMF and not AB_ZL_CM_MASK;
|
||||
FZLHeader.CMF := FZLHeader.CMF or Value;
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue