From: <ou...@us...> - 2008-01-31 10:47:15
|
Revision: 2335 http://jcl.svn.sourceforge.net/jcl/?rev=2335&view=rev Author: outchy Date: 2008-01-31 02:46:56 -0800 (Thu, 31 Jan 2008) Log Message: ----------- introducing singletons to maintain list of supported formats for compressed streams and archives. updated archive and stream classes to describe their names and supported extensions. added new formats of sevenzip 4.57: Wim and Compound. updated compression example to retrieve archive class from the list of registered formats. Modified Paths: -------------- trunk/jcl/examples/windows/compression/archive/UMain.dfm trunk/jcl/examples/windows/compression/archive/UMain.pas trunk/jcl/source/common/JclCompression.pas trunk/jcl/source/common/JclResources.pas trunk/jcl/source/windows/sevenzip.pas Modified: trunk/jcl/examples/windows/compression/archive/UMain.dfm =================================================================== --- trunk/jcl/examples/windows/compression/archive/UMain.dfm 2008-01-31 09:21:45 UTC (rev 2334) +++ trunk/jcl/examples/windows/compression/archive/UMain.dfm 2008-01-31 10:46:56 UTC (rev 2335) @@ -11,6 +11,7 @@ Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False + OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 @@ -99,7 +100,7 @@ Top = 16 Width = 75 Height = 25 - Action = ActionOpen + Action = ActionOpenRO TabOrder = 0 end object ButtonExtractSelected: TButton @@ -107,7 +108,7 @@ Top = 16 Width = 96 Height = 25 - Action = ActionExtractSelected + Action = ActionExtractSelectedRO TabOrder = 1 end object ButtonExtractAll: TButton @@ -115,7 +116,7 @@ Top = 16 Width = 75 Height = 25 - Action = ActionExtractAll + Action = ActionExtractAllRO TabOrder = 2 end end @@ -127,7 +128,7 @@ Top = 16 Width = 75 Height = 25 - Action = ActionNew + Action = ActionNewWO TabOrder = 0 end object ButtonAddFile: TButton @@ -179,7 +180,7 @@ Top = 16 Width = 75 Height = 25 - Action = ActionDelete + Action = ActionDeleteRW TabOrder = 2 end object ButtonAddFileRW: TButton @@ -203,7 +204,7 @@ Top = 16 Width = 92 Height = 25 - Action = ActionExtractSelected + Action = ActionExtractSelectedRO TabOrder = 5 end object ButtonExtractAllRW: TButton @@ -211,7 +212,7 @@ Top = 16 Width = 75 Height = 25 - Action = ActionExtractAll + Action = ActionExtractAllRO TabOrder = 6 end object ButtonSaveRW: TButton @@ -227,53 +228,53 @@ object ActionList1: TActionList Left = 64 Top = 152 - object ActionOpen: TAction + object ActionOpenRO: TAction Category = 'ReadOnly' Caption = '&Open' - OnExecute = ActionOpenExecute + OnExecute = ActionOpenROExecute OnUpdate = ActionAlwaysEnabled end - object ActionExtractSelected: TAction + object ActionExtractSelectedRO: TAction Category = 'ReadOnly' Caption = '&Extract selected' - OnExecute = ActionExtractSelectedExecute - OnUpdate = ActionExtractSelectedUpdate + OnExecute = ActionExtractSelectedROExecute + OnUpdate = ActionExtractSelectedROUpdate end - object ActionExtractAll: TAction + object ActionExtractAllRO: TAction Category = 'ReadOnly' Caption = 'Extract &all' - OnExecute = ActionExtractAllExecute - OnUpdate = ActionExtractAllUpdate + OnExecute = ActionExtractAllROExecute + OnUpdate = ActionExtractAllROUpdate end - object ActionNew: TAction + object ActionNewWO: TAction Category = 'WriteOnly' Caption = '&New' - OnExecute = ActionNewExecute + OnExecute = ActionNewWOExecute OnUpdate = ActionAlwaysEnabled end object ActionAddFile: TAction - Category = 'WriteOnly' + Category = 'Write' Caption = 'Add &file' OnExecute = ActionAddFileExecute OnUpdate = ActionAddFileUpdate end object ActionAddDirectory: TAction - Category = 'WriteOnly' + Category = 'Write' Caption = 'Add &directory' OnExecute = ActionAddDirectoryExecute OnUpdate = ActionAddDirectoryUpdate end object ActionSave: TAction - Category = 'WriteOnly' + Category = 'Write' Caption = '&Save' OnExecute = ActionSaveExecute OnUpdate = ActionSaveUpdate end - object ActionDelete: TAction + object ActionDeleteRW: TAction Category = 'ReadWrite' Caption = '&Delete' - OnExecute = ActionDeleteExecute - OnUpdate = ActionDeleteUpdate + OnExecute = ActionDeleteRWExecute + OnUpdate = ActionDeleteRWUpdate end object ActionNewRW: TAction Category = 'ReadWrite' @@ -288,27 +289,15 @@ OnUpdate = ActionAlwaysEnabled end end - object OpenDialogArchive: TOpenDialog - Filter = - 'Zip archive (*.zip)|*.zip|BZip2 archive (*.bz2)|*.bz2|Sevenzip a' + - 'rchive (*.7z)|*.7z|Tar archive (*.tar)|*.tar|GZip archive (*.gz)' + - '|*.gz|Rar archive (*.rar)|*.rar|Arj archive (*.arj)|*.arj|Z arch' + - 'ive (*.z)|*.z|Lzh archive (*.lzh)|*.lzh|Nsis archive (*.nsis)|*.' + - 'nsis|Iso image (*.iso)|*.iso|Cab archive (*.cab)|*.cab|Chm file ' + - '(*.chm)|*.chm|Rpm archive (*.rpm)|*.rpm|Deb archive (*.deb)|*.de' + - 'b|Cpio archive (*.cpio)|*.cpio|Split archive (*.001)|*.001' + object OpenDialogArchiveRO: TOpenDialog FilterIndex = 0 Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing] Title = 'Open an archive for extraction' Left = 104 Top = 152 end - object SaveDialogArchive: TSaveDialog + object SaveDialogArchiveWO: TSaveDialog DefaultExt = '*.zip' - Filter = - 'Zip archive (*.zip)|*.zip|BZip2 archive (*.bz2)|*.bz2|Sevenzip a' + - 'rchive (*.7z)|*.7z|Tar archive (*.tar)|*.tar|GZip archive (*.gz)' + - '|*.gz|Splitted archive (*.001)|*.001' FilterIndex = 0 Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofCreatePrompt, ofNoReadOnlyReturn, ofEnableSizing] Title = 'Create a new archive' @@ -319,18 +308,22 @@ Filter = 'All files (*.*)|*.*' FilterIndex = 0 Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing] - Left = 104 - Top = 216 + Left = 184 + Top = 152 end object OpenDialogArchiveRW: TOpenDialog - Filter = - 'Zip archive (*.zip)|*.zip|BZip2 archive (*.bz2)|*.bz2|Sevenzip a' + - 'rchive (*.7z)|*.7z|Tar archive (*.tar)|*.tar|GZip archive (*.gz)' + - '|*.gz|Split archive (*.001)|*.001' FilterIndex = 0 Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing] Title = 'Open an archive for modification' Left = 104 Top = 184 end + object SaveDialogArchiveRW: TSaveDialog + DefaultExt = '*.zip' + FilterIndex = 0 + Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofCreatePrompt, ofNoReadOnlyReturn, ofEnableSizing] + Title = 'Create a new archive' + Left = 144 + Top = 184 + end end Modified: trunk/jcl/examples/windows/compression/archive/UMain.pas =================================================================== --- trunk/jcl/examples/windows/compression/archive/UMain.pas 2008-01-31 09:21:45 UTC (rev 2334) +++ trunk/jcl/examples/windows/compression/archive/UMain.pas 2008-01-31 10:46:56 UTC (rev 2335) @@ -11,16 +11,16 @@ type TForm1 = class(TForm) ActionList1: TActionList; - ActionOpen: TAction; - ActionExtractSelected: TAction; - ActionExtractAll: TAction; - ActionNew: TAction; + ActionOpenRO: TAction; + ActionExtractSelectedRO: TAction; + ActionExtractAllRO: TAction; + ActionNewWO: TAction; ActionAddFile: TAction; ActionAddDirectory: TAction; ActionSave: TAction; ListView1: TListView; - OpenDialogArchive: TOpenDialog; - SaveDialogArchive: TSaveDialog; + OpenDialogArchiveRO: TOpenDialog; + SaveDialogArchiveWO: TSaveDialog; OpenDialogFile: TOpenDialog; ProgressBar1: TProgressBar; PageControl1: TPageControl; @@ -34,7 +34,7 @@ ButtonAddFile: TButton; ButtonAddDirectory: TButton; ButtonSave: TButton; - ActionDelete: TAction; + ActionDeleteRW: TAction; ActionNewRW: TAction; ActionOpenRW: TAction; ButtonNewRW: TButton; @@ -46,25 +46,27 @@ ButtonExtractAllRW: TButton; ButtonSaveRW: TButton; OpenDialogArchiveRW: TOpenDialog; + SaveDialogArchiveRW: TSaveDialog; procedure ActionAlwaysEnabled(Sender: TObject); - procedure ActionExtractSelectedUpdate(Sender: TObject); - procedure ActionExtractAllUpdate(Sender: TObject); + procedure ActionExtractSelectedROUpdate(Sender: TObject); + procedure ActionExtractAllROUpdate(Sender: TObject); procedure ActionAddFileUpdate(Sender: TObject); procedure ActionAddDirectoryUpdate(Sender: TObject); procedure ActionSaveUpdate(Sender: TObject); - procedure ActionNewExecute(Sender: TObject); + procedure ActionNewWOExecute(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ActionAddFileExecute(Sender: TObject); procedure ActionAddDirectoryExecute(Sender: TObject); procedure ActionSaveExecute(Sender: TObject); - procedure ActionOpenExecute(Sender: TObject); + procedure ActionOpenROExecute(Sender: TObject); procedure ListView1Data(Sender: TObject; Item: TListItem); - procedure ActionExtractAllExecute(Sender: TObject); - procedure ActionExtractSelectedExecute(Sender: TObject); - procedure ActionDeleteUpdate(Sender: TObject); - procedure ActionDeleteExecute(Sender: TObject); + procedure ActionExtractAllROExecute(Sender: TObject); + procedure ActionExtractSelectedROExecute(Sender: TObject); + procedure ActionDeleteRWUpdate(Sender: TObject); + procedure ActionDeleteRWExecute(Sender: TObject); procedure ActionNewRWExecute(Sender: TObject); procedure ActionOpenRWExecute(Sender: TObject); + procedure FormCreate(Sender: TObject); private FArchive: TJclCompressionArchive; procedure CloseArchive; @@ -137,7 +139,7 @@ (Sender as TAction).Enabled := True; end; -procedure TForm1.ActionDeleteExecute(Sender: TObject); +procedure TForm1.ActionDeleteRWExecute(Sender: TObject); var Index: Integer; begin @@ -151,12 +153,12 @@ ListView1.Items.Count := FArchive.ItemCount; end; -procedure TForm1.ActionDeleteUpdate(Sender: TObject); +procedure TForm1.ActionDeleteRWUpdate(Sender: TObject); begin (Sender as TAction).Enabled := (FArchive is TJclUpdateArchive) and (ListView1.SelCount = 1); end; -procedure TForm1.ActionExtractAllExecute(Sender: TObject); +procedure TForm1.ActionExtractAllROExecute(Sender: TObject); var Directory: string; begin @@ -170,12 +172,12 @@ end; end; -procedure TForm1.ActionExtractAllUpdate(Sender: TObject); +procedure TForm1.ActionExtractAllROUpdate(Sender: TObject); begin (Sender as TAction).Enabled := (FArchive is TJclDecompressArchive) or (FArchive is TJclUpdateArchive); end; -procedure TForm1.ActionExtractSelectedExecute(Sender: TObject); +procedure TForm1.ActionExtractSelectedROExecute(Sender: TObject); var Directory: string; Index: Integer; @@ -193,185 +195,121 @@ end; end; -procedure TForm1.ActionExtractSelectedUpdate(Sender: TObject); +procedure TForm1.ActionExtractSelectedROUpdate(Sender: TObject); begin (Sender as TAction).Enabled := ((FArchive is TJclDecompressArchive) or (FArchive is TJclUpdateArchive)) and (ListView1.SelCount > 0); end; -procedure TForm1.ActionNewExecute(Sender: TObject); +procedure TForm1.ActionNewWOExecute(Sender: TObject); var - ArchiveFileName, ArchiveExt, VolumeSizeStr, Password: string; + ArchiveFileName, VolumeSizeStr, Password: string; + AFormat: TJclCompressArchiveClass; VolumeSize: Int64; Code: Integer; begin - if SaveDialogArchive.Execute then + if SaveDialogArchiveWO.Execute then begin CloseArchive; - ArchiveFileName := SaveDialogArchive.FileName; - VolumeSizeStr := '0'; - repeat - if InputQuery('Split archive?', 'Volume size in byte:', VolumeSizeStr) then - Val(VolumeSizeStr, VolumeSize, Code) - else - begin - VolumeSize := 0; - Code := 0; - end; - until Code = 0; + ArchiveFileName := SaveDialogArchiveWO.FileName; - InputQuery('Archive password', 'Value', Password); + AFormat := GetArchiveFormats.FindCompressFormat(ArchiveFileName); - ArchiveExt := ExtractFileExt(ArchiveFileName); - if VolumeSize <> 0 then - ArchiveFileName := ArchiveFileName + '.%d'; + if AFormat <> nil then + begin + VolumeSizeStr := '0'; + repeat + if InputQuery('Split archive?', 'Volume size in byte:', VolumeSizeStr) then + Val(VolumeSizeStr, VolumeSize, Code) + else + begin + VolumeSize := 0; + Code := 0; + end; + until Code = 0; - if AnsiSameText(ArchiveExt, '.zip') then - FArchive := TJclZipCompressArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0) - else - if AnsiSameText(ArchiveExt, '.tar') then - FArchive := TJclTarCompressArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0) - else - if AnsiSameText(ArchiveExt, '.7z') then - FArchive := TJcl7zCompressArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0) - else - if AnsiSameText(ArchiveExt, '.bz2') then - FArchive := TJclBZ2CompressArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0) - else - if AnsiSameText(ArchiveExt, '.gz') then - FArchive := TJclGZipCompressArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0); + InputQuery('Archive password', 'Value', Password); - if Assigned(FArchive) then - begin + if VolumeSize <> 0 then + ArchiveFileName := ArchiveFileName + '.%d'; + + FArchive := AFormat.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0); FArchive.Password := Password; FArchive.OnProgress := ArchiveProgress; - end; + end + else + ShowMessage('not a supported format'); end; end; procedure TForm1.ActionNewRWExecute(Sender: TObject); var - ArchiveFileName, ArchiveExt, VolumeSizeStr, Password: string; + ArchiveFileName, VolumeSizeStr, Password: string; + AFormat: TJclUpdateArchiveClass; VolumeSize: Int64; Code: Integer; begin - if SaveDialogArchive.Execute then + if SaveDialogArchiveRW.Execute then begin CloseArchive; - ArchiveFileName := SaveDialogArchive.FileName; - VolumeSizeStr := '0'; - repeat - if InputQuery('Split archive?', 'Volume size in byte:', VolumeSizeStr) then - Val(VolumeSizeStr, VolumeSize, Code) - else - begin - VolumeSize := 0; - Code := 0; - end; - until Code = 0; + ArchiveFileName := SaveDialogArchiveRW.FileName; - InputQuery('Archive password', 'Value', Password); + AFormat := GetArchiveFormats.FindUpdateFormat(ArchiveFileName); - ArchiveExt := ExtractFileExt(ArchiveFileName); - if VolumeSize <> 0 then - ArchiveFileName := ArchiveFileName + '.%d'; + if AFormat <> nil then + begin + VolumeSizeStr := '0'; + repeat + if InputQuery('Split archive?', 'Volume size in byte:', VolumeSizeStr) then + Val(VolumeSizeStr, VolumeSize, Code) + else + begin + VolumeSize := 0; + Code := 0; + end; + until Code = 0; - if AnsiSameText(ArchiveExt, '.zip') then - FArchive := TJclZipUpdateArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0) - else - if AnsiSameText(ArchiveExt, '.tar') then - FArchive := TJclTarUpdateArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0) - else - if AnsiSameText(ArchiveExt, '.7z') then - FArchive := TJcl7zUpdateArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0) - else - if AnsiSameText(ArchiveExt, '.bz2') then - FArchive := TJclBZ2UpdateArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0) - else - if AnsiSameText(ArchiveExt, '.gz') then - FArchive := TJclGZipUpdateArchive.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0); + InputQuery('Archive password', 'Value', Password); - if Assigned(FArchive) then - begin + if VolumeSize <> 0 then + ArchiveFileName := ArchiveFileName + '.%d'; + + FArchive := AFormat.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0); FArchive.Password := Password; FArchive.OnProgress := ArchiveProgress; - end; + end + else + ShowMessage('not a supported format'); end; end; -procedure TForm1.ActionOpenExecute(Sender: TObject); +procedure TForm1.ActionOpenROExecute(Sender: TObject); var - ArchiveFileName, ArchiveFileExt, Password: string; + ArchiveFileName, Password: string; + AFormat: TJclDecompressArchiveClass; SplitArchive: Boolean; begin - if OpenDialogArchive.Execute then + if OpenDialogArchiveRO.Execute then begin CloseArchive; - ArchiveFileName := OpenDialogArchive.FileName; - ArchiveFileExt := ExtractFileExt(ArchiveFileName); - SplitArchive := AnsiSameText(ArchiveFileExt, '.001'); + ArchiveFileName := OpenDialogArchiveRO.FileName; + SplitArchive := AnsiSameText(ExtractFileExt(ArchiveFileName), '.001'); if SplitArchive then - begin ArchiveFileName := ChangeFileExt(ArchiveFileName, ''); - ArchiveFileExt := ExtractFileExt(ArchiveFileName); - ArchiveFileName := ArchiveFileName + '.%d'; - end; - InputQuery('Archive password', 'Value', Password); + AFormat := GetArchiveFormats.FindDecompressFormat(ArchiveFileName); - if AnsiSameText(ArchiveFileExt, '.zip') then - FArchive := TJclZipDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.bz2') then - FArchive := TJclBZ2DecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.rar') then - FArchive := TJclRarDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.arj') then - FArchive := TJclArjDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.z') then - FArchive := TJclZDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.lzh') then - FArchive := TJclLzhDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.7z') then - FArchive := TJcl7zDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.nsis') then - FArchive := TJclNsisDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.iso') then - FArchive := TJclIsoDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.cab') then - FArchive := TJclCabDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.chm') then - FArchive := TJclChmDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.rpm') then - FArchive := TJclRpmDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.deb') then - FArchive := TJclDebDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.cpio') then - FArchive := TJclCpioDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.tar') then - FArchive := TJclTarDecompressArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.gz') then - FArchive := TJclGZipDecompressArchive.Create(ArchiveFileName, 0, SplitArchive); - - if Assigned(FArchive) then + if AFormat <> nil then begin + if SplitArchive then + ArchiveFileName := ArchiveFileName + '.%d'; + + InputQuery('Archive password', 'Value', Password); + + FArchive := AFormat.Create(ArchiveFileName, 0, SplitArchive); FArchive.Password := Password; FArchive.OnProgress := ArchiveProgress; @@ -388,13 +326,16 @@ finally ListView1.Items.EndUpdate; end; - end; + end + else + ShowMessage('not a supported format'); end; end; procedure TForm1.ActionOpenRWExecute(Sender: TObject); var - ArchiveFileName, ArchiveFileExt, Password: string; + ArchiveFileName, Password: string; + AFormat: TJclUpdateArchiveClass; SplitArchive: Boolean; begin if OpenDialogArchiveRW.Execute then @@ -402,34 +343,20 @@ CloseArchive; ArchiveFileName := OpenDialogArchiveRW.FileName; - ArchiveFileExt := ExtractFileExt(ArchiveFileName); - SplitArchive := AnsiSameText(ArchiveFileExt, '.001'); + SplitArchive := AnsiSameText(ExtractFileExt(ArchiveFileName), '.001'); if SplitArchive then - begin ArchiveFileName := ChangeFileExt(ArchiveFileName, ''); - ArchiveFileExt := ExtractFileExt(ArchiveFileName); - ArchiveFileName := ArchiveFileName + '.%d'; - end; - InputQuery('Archive password', 'Value', Password); + AFormat := GetArchiveFormats.FindUpdateFormat(ArchiveFileName); - if AnsiSameText(ArchiveFileExt, '.zip') then - FArchive := TJclZipUpdateArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.bz2') then - FArchive := TJclBZ2UpdateArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.7z') then - FArchive := TJcl7zUpdateArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.tar') then - FArchive := TJclTarUpdateArchive.Create(ArchiveFileName, 0, SplitArchive) - else - if AnsiSameText(ArchiveFileExt, '.gz') then - FArchive := TJclGZipUpdateArchive.Create(ArchiveFileName, 0, SplitArchive); - - if Assigned(FArchive) then + if AFormat <> nil then begin + if SplitArchive then + ArchiveFileName := ArchiveFileName + '.%d'; + + InputQuery('Archive password', 'Value', Password); + + FArchive := AFormat.Create(ArchiveFileName, 0, SplitArchive); FArchive.Password := Password; FArchive.OnProgress := ArchiveProgress; @@ -446,7 +373,9 @@ finally ListView1.Items.EndUpdate; end; - end; + end + else + ShowMessage('not a supported format'); end; end; @@ -483,6 +412,61 @@ ListView1.Items.Clear; end; +procedure TForm1.FormCreate(Sender: TObject); + procedure MergeFilters(var AFilter, AllExtensions: string; AFormat: TJclCompressionArchiveClass); + var + AName, AExtensions: string; + begin + AName := AFormat.ArchiveName; + AExtensions := AFormat.ArchiveExtensions; + if AFilter = '' then + AFilter := Format('%0:s (%1:s)|%1:s', [AName, AExtensions]) + else + AFilter := Format('%0:s|%1:s (%2:s)|%2:s', [AFilter, AName, AExtensions]); + if AllExtensions = '' then + AllExtensions := AExtensions + else + AllExtensions := Format('%s;%s', [AllExtensions, AExtensions]); + end; + function AddStandardFilters(const AFilter, AllExtensions: string): string; + begin + if AFilter = '' then + Result := '' + else + Result := Format('All supported formats|(%0:s)|%1:s', [AllExtensions, AFilter]); + end; +var + AFilter, AllExtensions: string; + AFormats: TJclCompressionArchiveFormats; + Index: Integer; +begin + AFormats := GetArchiveFormats; + + AFilter := ''; + AllExtensions := ''; + for Index := 0 to AFormats.CompressFormatCount - 1 do + MergeFilters(AFilter, AllExtensions, AFormats.CompressFormats[Index]); + SaveDialogArchiveWO.Filter := AFilter; + + AFilter := ''; + AllExtensions := ''; + for Index := 0 to AFormats.UpdateFormatCount - 1 do + MergeFilters(AFilter, AllExtensions, AFormats.UpdateFormats[Index]); + SaveDialogArchiveRW.Filter := AFilter; + + AFilter := ''; + AllExtensions := ''; + for Index := 0 to AFormats.DecompressFormatCount - 1 do + MergeFilters(AFilter, AllExtensions, AFormats.DecompressFormats[Index]); + OpenDialogArchiveRO.Filter := AddStandardFilters(AFilter, AllExtensions); + + AFilter := ''; + AllExtensions := ''; + for Index := 0 to AFormats.UpdateFormatCount - 1 do + MergeFilters(AFilter, AllExtensions, AFormats.UpdateFormats[Index]); + OpenDialogArchiveRW.Filter := AddStandardFilters(AFilter, AllExtensions); +end; + procedure TForm1.FormDestroy(Sender: TObject); begin CloseArchive; Modified: trunk/jcl/source/common/JclCompression.pas =================================================================== --- trunk/jcl/source/common/JclCompression.pas 2008-01-31 09:21:45 UTC (rev 2334) +++ trunk/jcl/source/common/JclCompression.pas 2008-01-31 10:46:56 UTC (rev 2335) @@ -143,20 +143,28 @@ procedure Progress(Sender: TObject); dynamic; property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; public + class function StreamName: string; virtual; + class function StreamExtensions: string; virtual; + constructor Create(Stream: TStream); destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; procedure Reset; virtual; end; + TJclCompressionStreamClass = class of TJclCompressionStream; + TJclCompressStream = class(TJclCompressionStream) public function Flush: Integer; dynamic; abstract; constructor Create(Destination: TStream); end; + TJclCompressStreamClass = class of TJclCompressStream; + TJclDecompressStream = class(TJclCompressionStream) private FOwnsStream: Boolean; @@ -165,7 +173,38 @@ destructor Destroy; override; end; - // ZIP Support + TJclDecompressStreamClass = class of TJclDecompressStream; + + TJclCompressionStreamFormats = class + private + FCompressFormats: TList; + FDecompressFormats: TList; + protected + function GetCompressFormatCount: Integer; + function GetCompressFormat(Index: Integer): TJclCompressStreamClass; + function GetDecompressFormatCount: Integer; + function GetDecompressFormat(Index: Integer): TJclDecompressStreamClass; + public + constructor Create; + destructor Destroy; override; + + procedure RegisterFormat(AClass: TJclCompressionStreamClass); + procedure UnregisterFormat(AClass: TJclCompressionStreamClass); + + function FindCompressFormat(const AFileName: string): TJclCompressStreamClass; + function FindDecompressFormat(const AFileName: string): TJclDecompressStreamClass; + + property CompressFormatCount: Integer read GetCompressFormatCount; + property CompressFormats[Index: Integer]: TJclCompressStreamClass read GetCompressFormat; + property DecompressFormatCount: Integer read GetDecompressFormatCount; + property DecompressFormats[Index: Integer]: TJclDecompressStreamClass read GetDecompressFormat; + end; + +// retreive a singleton list containing registered stream classes +function GetStreamFormats: TJclCompressionStreamFormats; + +// ZIP Support +type TJclCompressionLevel = Integer; TJclZLibCompressStream = class(TJclCompressStream) @@ -184,12 +223,18 @@ procedure SetMethod(Value: Integer); procedure SetWindowBits(Value: Integer); public + // stream description + class function StreamName: string; override; + class function StreamExtensions: string; override; + constructor Create(Destination: TStream; CompressionLevel: TJclCompressionLevel = -1); destructor Destroy; override; + function Flush: Integer; override; procedure Reset; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; function Write(const Buffer; Count: Longint): Longint; override; + property WindowBits: Integer read FWindowBits write SetWindowBits; property MemLevel: Integer read FMemLevel write SetMemLevel; property Method: Integer read FMethod write SetMethod; @@ -205,10 +250,16 @@ ZLibRecord: TZStreamRec; procedure SetWindowBits(Value: Integer); public + // stream description + class function StreamName: string; override; + class function StreamExtensions: string; override; + constructor Create(Source: TStream; WindowBits: Integer = DEF_WBITS; AOwnsStream: Boolean = False); destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + property WindowBits: Integer read FWindowBits write SetWindowBits; end; @@ -323,11 +374,15 @@ procedure SetUnixTime(Value: Cardinal); procedure ZLibStreamProgress(Sender: TObject); public + // stream description + class function StreamName: string; override; + class function StreamExtensions: string; override; + constructor Create(Destination: TStream; CompressionLevel: TJclCompressionLevel = -1); destructor Destroy; override; + function Write(const Buffer; Count: Longint): Longint; override; procedure Reset; override; - // IMPORTANT: In order to get a valid GZip file, Flush MUST be called after // the last call to Write. function Flush: Integer; override; @@ -373,8 +428,13 @@ function ReadCompressedData(Sender: TObject; var Buffer; Count: Longint): Longint; procedure ZLibStreamProgress(Sender: TObject); public + // stream description + class function StreamName: string; override; + class function StreamExtensions: string; override; + constructor Create(Source: TStream; CheckHeaderCRC: Boolean = True; AOwnsStream: Boolean = False); destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; property ComputedHeaderCRC16: Word read FComputedHeaderCRC16; @@ -403,13 +463,17 @@ BZLibRecord: bz_stream; procedure SetCompressionLevel(const Value: Integer); public + // stream description + class function StreamName: string; override; + class function StreamExtensions: string; override; + + constructor Create(Destination: TStream; CompressionLevel: TJclCompressionLevel = -1); + destructor Destroy; override; + function Flush: Integer; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; function Write(const Buffer; Count: Longint): Longint; override; - constructor Create(Destination: TStream; CompressionLevel: TJclCompressionLevel = -1); - destructor Destroy; override; - property CompressionLevel: Integer read FCompressionLevel write SetCompressionLevel; end; @@ -419,11 +483,15 @@ protected BZLibRecord: bz_stream; public - function Read(var Buffer; Count: Longint): Longint; override; - function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; + // stream description + class function StreamName: string; override; + class function StreamExtensions: string; override; constructor Create(Source: TStream; AOwnsStream: Boolean = False); overload; destructor Destroy; override; + + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; end; EJclCompressionError = class(EJclError); @@ -630,6 +698,8 @@ class function MultipleItemContainer: Boolean; virtual; class function VolumeAccess: TJclStreamAccess; virtual; class function ItemAccess: TJclStreamAccess; virtual; + class function ArchiveExtensions: string; virtual; + class function ArchiveName: string; virtual; constructor Create(Volume0: TStream; AVolumeMaxSize: Int64 = 0; AOwnVolume: Boolean = False); overload; @@ -671,6 +741,8 @@ property Password: WideString read FPassword write FPassword; end; + TJclCompressionArchiveClass = class of TJclCompressionArchive; + TJclCompressItem = class(TJclCompressionItem) protected procedure CheckGetProperty(AProperty: TJclCompressionItemProperty); override; @@ -701,6 +773,8 @@ procedure Compress; virtual; abstract; end; + TJclCompressArchiveClass = class of TJclCompressArchive; + TJclDecompressItem = class(TJclCompressionItem) protected procedure CheckGetProperty(AProperty: TJclCompressionItemProperty); override; @@ -742,6 +816,8 @@ property AutoCreateSubDir: Boolean read FAutoCreateSubDir; end; + TJclDecompressArchiveClass = class of TJclDecompressArchive; + TJclUpdateItem = class(TJclCompressionItem) protected procedure CheckGetProperty(AProperty: TJclCompressionItemProperty); override; @@ -780,6 +856,44 @@ property AutoCreateSubDir: Boolean read FAutoCreateSubDir; end; + TJclUpdateArchiveClass = class of TJclUpdateArchive; + +// registered archive formats +type + TJclCompressionArchiveFormats = class + private + FCompressFormats: TList; + FDecompressFormats: TList; + FUpdateFormats: TList; + protected + function GetCompressFormatCount: Integer; + function GetCompressFormat(Index: Integer): TJclCompressArchiveClass; + function GetDecompressFormatCount: Integer; + function GetDecompressFormat(Index: Integer): TJclDecompressArchiveClass; + function GetUpdateFormatCount: Integer; + function GetUpdateFormat(Index: Integer): TJclUpdateArchiveClass; + public + constructor Create; + destructor Destroy; override; + + procedure RegisterFormat(AClass: TJclCompressionArchiveClass); + procedure UnregisterFormat(AClass: TJclCompressionArchiveClass); + + function FindCompressFormat(const AFileName: string): TJclCompressArchiveClass; + function FindDecompressFormat(const AFileName: string): TJclDecompressArchiveClass; + function FindUpdateFormat(const AFileName: string): TJclUpdateArchiveClass; + + property CompressFormatCount: Integer read GetCompressFormatCount; + property CompressFormats[Index: Integer]: TJclCompressArchiveClass read GetCompressFormat; + property DecompressFormatCount: Integer read GetDecompressFormatCount; + property DecompressFormats[Index: Integer]: TJclDecompressArchiveClass read GetDecompressFormat; + property UpdateFormatCount: Integer read GetUpdateFormatCount; + property UpdateFormats[Index: Integer]: TJclUpdateArchiveClass read GetUpdateFormat; + end; + +// retreive a singleton list containing archive formats +function GetArchiveFormats: TJclCompressionArchiveFormats; + // sevenzip classes for compression type TJclSevenzipCompressArchive = class(TJclCompressArchive) @@ -813,6 +927,9 @@ procedure SetCompressionProperties; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + property DefaultMethod: TJclZipMethod read FDefaultMethod write SetDefaultMethod; end; @@ -820,6 +937,9 @@ protected procedure CreateCompressionObject; override; function GetCLSID: TGUID; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJcl7zCompressArchive = class(TJclSevenzipCompressArchive) @@ -828,6 +948,8 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclTarCompressArchive = class(TJclSevenzipCompressArchive) @@ -837,12 +959,17 @@ procedure SetCompressionProperties; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclGZipCompressArchive = class(TJclSevenzipCompressArchive) protected procedure CreateCompressionObject; override; function GetCLSID: TGUID; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; // sevenzip classes for decompression @@ -872,11 +999,16 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclBZ2DecompressArchive = class(TJclSevenzipDecompressArchive) protected function GetCLSID: TGUID; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclRarDecompressArchive = class(TJclSevenzipDecompressArchive) @@ -884,6 +1016,8 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclArjDecompressArchive = class(TJclSevenzipDecompressArchive) @@ -891,6 +1025,8 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclZDecompressArchive = class(TJclSevenzipDecompressArchive) @@ -898,6 +1034,8 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclLzhDecompressArchive = class(TJclSevenzipDecompressArchive) @@ -905,6 +1043,8 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJcl7zDecompressArchive = class(TJclSevenzipDecompressArchive) @@ -912,39 +1052,88 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; + TJclCabDecompressArchive = class(TJclSevenzipDecompressArchive) + protected + function GetCLSID: TGUID; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + end; + TJclNsisDecompressArchive = class(TJclSevenzipDecompressArchive) protected function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; - TJclIsoDecompressArchive = class(TJclSevenzipDecompressArchive) + {TJclLzmaDecompressArchive = class(TJclSevenzipDecompressArchive) protected function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + end;} + + TJclCompoundDecompressArchive = class(TJclSevenzipDecompressArchive) + protected + function GetCLSID: TGUID; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; - TJclCabDecompressArchive = class(TJclSevenzipDecompressArchive) + TJclWimDecompressArchive = class(TJclSevenzipDecompressArchive) protected function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; + TJclIsoDecompressArchive = class(TJclSevenzipDecompressArchive) + protected + function GetCLSID: TGUID; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + end; + + {TJclBkfDecompressArchive = class(TJclSevenzipDecompressArchive) + protected + function GetCLSID: TGUID; override; + public + class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + end;} + TJclChmDecompressArchive = class(TJclSevenzipDecompressArchive) protected function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclSplitDecompressArchive = class(TJclSevenzipDecompressArchive) protected function GetCLSID: TGUID; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclRpmDecompressArchive = class(TJclSevenzipDecompressArchive) @@ -952,6 +1141,8 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclDebDecompressArchive = class(TJclSevenzipDecompressArchive) @@ -959,6 +1150,8 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclCpioDecompressArchive = class(TJclSevenzipDecompressArchive) @@ -966,6 +1159,8 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclTarDecompressArchive = class(TJclSevenzipDecompressArchive) @@ -973,11 +1168,16 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclGZipDecompressArchive = class(TJclSevenzipDecompressArchive) protected function GetCLSID: TGUID; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; //sevenzip classes for updates (read and write) @@ -1019,6 +1219,9 @@ procedure SetCompressionProperties; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; + property DefaultMethod: TJclZipMethod read FDefaultMethod write SetDefaultMethod; end; @@ -1026,6 +1229,9 @@ protected procedure CreateCompressionObject; override; function GetCLSID: TGUID; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJcl7zUpdateArchive = class(TJclSevenzipUpdateArchive) @@ -1034,6 +1240,8 @@ function GetCLSID: TGUID; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclTarUpdateArchive = class(TJclSevenzipUpdateArchive) @@ -1043,12 +1251,17 @@ procedure SetCompressionProperties; override; public class function MultipleItemContainer: Boolean; override; + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; TJclGZipUpdateArchive = class(TJclSevenzipUpdateArchive) protected procedure CreateCompressionObject; override; function GetCLSID: TGUID; override; + public + class function ArchiveExtensions: string; override; + class function ArchiveName: string; override; end; {$ENDIF MSWINDOWS} @@ -1072,11 +1285,17 @@ ComObj, // GUIDToString JclUnicode, // WideSameText // TODO: should we use WideSameText from JclUnicode also for D6 and higher? {$ENDIF COMPILER5} - JclDateTime, JclFileUtils, JclResources; + JclDateTime, JclFileUtils, JclResources, JclStrings, JclSysUtils; const JclDefaultBufferSize = 131072; // 128k +var + // using TObject prevents default linking of TJclCompressionStreamFormats + // and TJclCompressionArchiveFormats and all classes + GlobalStreamFormats: TObject; + GlobalArchiveFormats: TObject; + //=== { TJclCompressionStream } ============================================== constructor TJclCompressionStream.Create(Stream: TStream); @@ -1127,6 +1346,16 @@ Result := FBufferSize; end; +class function TJclCompressionStream.StreamExtensions: string; +begin + Result := ''; +end; + +class function TJclCompressionStream.StreamName: string; +begin + Result := ''; +end; + procedure TJclCompressionStream.Progress(Sender: TObject); begin if Assigned(FOnProgress) then @@ -1157,6 +1386,127 @@ inherited Destroy; end; +//=== { TJclCompressionStreamFormats } ======================================= + +constructor TJclCompressionStreamFormats.Create; +begin + inherited Create; + FCompressFormats := TList.Create; + FDecompressFormats := TList.Create; + RegisterFormat(TJclZLibCompressStream); + RegisterFormat(TJclZLibDecompressStream); + RegisterFormat(TJclGZIPCompressionStream); + RegisterFormat(TJclGZIPDecompressionStream); + RegisterFormat(TJclBZIP2CompressionStream); + RegisterFormat(TJclBZIP2DecompressionStream); +end; + +destructor TJclCompressionStreamFormats.Destroy; +begin + FCompressFormats.Free; + FDecompressFormats.Free; + inherited Destroy; +end; + +function TJclCompressionStreamFormats.FindCompressFormat(const AFileName: string): TJclCompressStreamClass; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclCompressStreamClass; +begin + Result := nil; + Filters := TStringList.Create; + try + for IndexFormat := 0 to CompressFormatCount - 1 do + begin + AFormat := CompressFormats[IndexFormat]; + StrTokenToStrings(AFormat.StreamExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if StrMatches(Filters.Strings[IndexFilter], AFileName) then + begin + Result := AFormat; + Break; + end; + if Result <> nil then + Break; + end; + finally + Filters.Free; + end; +end; + +function TJclCompressionStreamFormats.FindDecompressFormat(const AFileName: string): TJclDecompressStreamClass; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclDecompressStreamClass; +begin + Result := nil; + Filters := TStringList.Create; + try + for IndexFormat := 0 to DecompressFormatCount - 1 do + begin + AFormat := DecompressFormats[IndexFormat]; + StrTokenToStrings(AFormat.StreamExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if StrMatches(Filters.Strings[IndexFilter], AFileName) then + begin + Result := AFormat; + Break; + end; + if Result <> nil then + Break; + end; + finally + Filters.Free; + end; +end; + +function TJclCompressionStreamFormats.GetCompressFormat(Index: Integer): TJclCompressStreamClass; +begin + Result := TJclCompressStreamClass(FCompressFormats.Items[Index]); +end; + +function TJclCompressionStreamFormats.GetCompressFormatCount: Integer; +begin + Result := FCompressFormats.Count; +end; + +function TJclCompressionStreamFormats.GetDecompressFormat(Index: Integer): TJclDecompressStreamClass; +begin + Result := TJclDecompressStreamClass(FDecompressFormats.Items[Index]); +end; + +function TJclCompressionStreamFormats.GetDecompressFormatCount: Integer; +begin + Result := FDecompressFormats.Count; +end; + +procedure TJclCompressionStreamFormats.RegisterFormat(AClass: TJclCompressionStreamClass); +begin + if AClass.InheritsFrom(TJclCompressStream) then + FCompressFormats.Add(AClass) + else + if AClass.InheritsFrom(TJclDecompressStream) then + FDecompressFormats.Add(AClass); +end; + +procedure TJclCompressionStreamFormats.UnregisterFormat(AClass: TJclCompressionStreamClass); +begin + if AClass.InheritsFrom(TJclCompressStream) then + FCompressFormats.Remove(AClass) + else + if AClass.InheritsFrom(TJclDecompressStream) then + FDecompressFormats.Remove(AClass); +end; + +function GetStreamFormats: TJclCompressionStreamFormats; +begin + if not Assigned(GlobalStreamFormats) then + GlobalStreamFormats := TJclCompressionStreamFormats.Create; + Result := TJclCompressionStreamFormats(GlobalStreamFormats); +end; + //=== { TJclZLibCompressionStream } ========================================== { Error checking helper } @@ -1299,6 +1649,16 @@ FWindowBits := Value; end; +class function TJclZLibCompressStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionZExtensions); +end; + +class function TJclZLibCompressStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionZName); +end; + procedure TJclZLibCompressStream.SetMethod(Value: Integer); begin FMethod := Value; @@ -1416,6 +1776,16 @@ FWindowBits := Value; end; +class function TJclZLibDecompressStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionZExtensions); +end; + +class function TJclZLibDecompressStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionZName); +end; + //=== { TJclGZIPCompressionStream } ========================================== constructor TJclGZIPCompressionStream.Create(Destination: TStream; CompressionLevel: TJclCompressionLevel); @@ -1496,6 +1866,16 @@ FUnixTime := Value; end; +class function TJclGZIPCompressionStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipExtensions); +end; + +class function TJclGZIPCompressionStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionGZipName); +end; + function TJclGZIPCompressionStream.Write(const Buffer; Count: Integer): Longint; begin if not FHeaderWritten then @@ -1859,6 +2239,16 @@ Inc(FCompressedDataSize, Result); end; +class function TJclGZIPDecompressionStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionGZipExtensions); +end; + +class function TJclGZIPDecompressionStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionGZipName); +end; + procedure TJclGZIPDecompressionStream.ZLibStreamProgress(Sender: TObject); begin Progress(Self); @@ -1976,6 +2366,16 @@ raise EJclCompressionError.CreateRes(@RsCompressionBZIP2SequenceError); end; +class function TJclBZIP2CompressionStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2Extensions); +end; + +class function TJclBZIP2CompressionStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionBZip2Name); +end; + function TJclBZIP2CompressionStream.Write(const Buffer; Count: Longint): Longint; begin if not FDeflateInitialized then @@ -2077,6 +2477,16 @@ Result := inherited Seek(Offset, Origin); end; +class function TJclBZIP2DecompressionStream.StreamExtensions: string; +begin + Result := LoadResString(@RsCompressionBZip2Extensions); +end; + +class function TJclBZIP2DecompressionStream.StreamName: string; +begin + Result := LoadResString(@RsCompressionBZip2Name); +end; + procedure InternalCompress(SourceStream: TStream; CompressStream: TJclCompressStream; ProgressCallback: TJclCompressStreamProgressCallback; UserData: Pointer); var @@ -2718,7 +3128,7 @@ ALastWriteTime); finally CloseHandle(FileHandle); - end; + end; end; end; @@ -2727,6 +3137,195 @@ Result := False; end; +//=== { TJclCompressionArchiveFormats } ====================================== + +constructor TJclCompressionArchiveFormats.Create; +begin + inherited Create; + FCompressFormats := TList.Create; + FDecompressFormats := TList.Create; + FUpdateFormats := TList.Create; + RegisterFormat(TJclZipCompressArchive); + RegisterFormat(TJclBZ2CompressArchive); + RegisterFormat(TJcl7zCompressArchive); + RegisterFormat(TJclTarCompressArchive); + RegisterFormat(TJclGZipCompressArchive); + RegisterFormat(TJclZipDecompressArchive); + RegisterFormat(TJclBZ2DecompressArchive); + RegisterFormat(TJclRarDecompressArchive); + RegisterFormat(TJclArjDecompressArchive); + RegisterFormat(TJclZDecompressArchive); + RegisterFormat(TJclLzhDecompressArchive); + RegisterFormat(TJcl7zDecompressArchive); + RegisterFormat(TJclCabDecompressArchive); + RegisterFormat(TJclNsisDecompressArchive); + RegisterFormat(TJclCompoundDecompressArchive); + RegisterFormat(TJclWimDecompressArchive); + RegisterFormat(TJclIsoDecompressArchive); + RegisterFormat(TJclChmDecompressArchive); + RegisterFormat(TJclSplitDecompressArchive); + RegisterFormat(TJclRpmDecompressArchive); + RegisterFormat(TJclDebDecompressArchive); + RegisterFormat(TJclCpioDecompressArchive); + RegisterFormat(TJclTarDecompressArchive); + RegisterFormat(TJclGZipDecompressArchive); + RegisterFormat(TJclZipUpdateArchive); + RegisterFormat(TJclBZ2UpdateArchive); + RegisterFormat(TJcl7zUpdateArchive); + RegisterFormat(TJclTarUpdateArchive); + RegisterFormat(TJclGZipUpdateArchive); +end; + +destructor TJclCompressionArchiveFormats.Destroy; +begin + FCompressFormats.Free; + FDecompressFormats.Free; + FUpdateFormats.Free; + inherited Destroy; +end; + +function TJclCompressionArchiveFormats.FindCompressFormat(const AFileName: string): TJclCompressArchiveClass; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclCompressArchiveClass; +begin + Result := nil; + Filters := TStringList.Create; + try + for IndexFormat := 0 to CompressFormatCount - 1 do + begin + AFormat := CompressFormats[IndexFormat]; + StrTokenToStrings(AFormat.ArchiveExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if StrMatches(Filters.Strings[IndexFilter], AFileName) then + begin + Result := AFormat; + Break; + end; + if Result <> nil then + Break; + end; + finally + Filters.Free; + end; +end; + +function TJclCompressionArchiveFormats.FindDecompressFormat(const AFileName: string): TJclDecompressArchiveClass; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclDecompressArchiveClass; +begin + Result := nil; + Filters := TStringList.Create; + try + for IndexFormat := 0 to DecompressFormatCount - 1 do + begin + AFormat := DecompressFormats[IndexFormat]; + StrTokenToStrings(AFormat.ArchiveExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if StrMatches(Filters.Strings[IndexFilter], AFileName) then + begin + Result := AFormat; + Break; + end; + if Result <> nil then + Break; + end; + finally + Filters.Free; + end; +end; + +function TJclCompressionArchiveFormats.FindUpdateFormat(const AFileName: string): TJclUpdateArchiveClass; +var + IndexFormat, IndexFilter: Integer; + Filters: TStrings; + AFormat: TJclUpdateArchiveClass; +begin + Result := nil; + Filters := TStringList.Create; + try + for IndexFormat := 0 to UpdateFormatCount - 1 do + begin + AFormat := UpdateFormats[IndexFormat]; + StrTokenToStrings(AFormat.ArchiveExtensions, DirSeparator, Filters); + for IndexFilter := 0 to Filters.Count - 1 do + if StrMatches(Filters.Strings[IndexFilter], AFileName) then + begin + Result := AFormat; + Break; + end; + if Result <> nil then + Break; + end; + finally + Filters.Free; + end; +end; + +function TJclCompressionArchiveFormats.GetCompressFormat(Index: Integer): TJclCompressArchiveClass; +begin + Result := TJclCompressArchiveClass(FCompressFormats.Items[Index]); +end; + +function TJclCompressionArchiveFormats.GetCompressFormatCount: Integer; +begin + Result := FCompressFormats.Count; +end; + +function TJclCompressionArchiveFormats.GetDecompressFormat(Index: Integer): TJclDecompressArchiveClass; +begin + Result := TJclDecompressArchiveClass(FDecompressFormats.Items[Index]); +end; + +function TJclCompressionArchiveFormats.GetDecompressFormatCount: Integer; +begin + Result := FDecompressFormats.Count; +end; + +function TJclCompressionArchiveFormats.GetUpdateFormat(Index: Integer): TJclUpdateArchiveClass; +begin + Result := TJclUpdateArchiveClass(FUpdateFormats.Items[Index]); +end; + +function TJclCompressionArchiveFormats.GetUpdateFormatCount: Integer; +begin + Result := FUpdateFormats.Count; +end; + +procedure TJclCompressionArchiveFormats.RegisterFormat(AClass: TJclCompressionArchiveClass); +begin + if AClass.InheritsFrom(TJclUpdateArchive) then + FUpdateFormats.Add(AClass) + else + if AClass.InheritsFrom(TJclDecompressArchive) then + FDecompressFormats.Add(AClass) + else + if AClass.InheritsFrom(TJclCompressArchive) then + FCompressFormats.Add(AClass); +end; + +procedure TJclCompressionArchiveFormats.UnregisterFormat(AClass: TJclCompressionArchiveClass); +begin + if AClass.InheritsFrom(TJclUpdateArchive) then + FUpdateFormats.Remove(AClass) + else + if AClass.InheritsFrom(TJclDecompressArchive) then + FDecompressFormats.Remove(AClass) + else + if AClass.InheritsFrom(TJclCompressArchive) then + FCompressFormats.Remove(AClass); +end; + +function GetArchiveFormats: TJclCompressionArchiveFormats; +begin + if not Assigned(GlobalArchiveFormats) then + GlobalArchiveFormats := TJclCompressionArchiveFormats.Create; + Result := TJclCompressionArchiveFormats(GlobalArchiveFormats); +end; + //=== { TJclCompressionVolume } ============================================== constructor TJclCompressionVolume.Create(AStream: TStream; AOwnsStream: Boolean; @@ -2793,6 +3392,16 @@ Result := FVolumes.Add(TJclCompressionVolume.Create(VolumeStream, AOwnsStream, '', AVolumeMaxSize)); end; +class function TJclCompressionArchive.ArchiveExtensions: string; +begin + Result := ''; +end; + +class function TJclCompressionArchive.ArchiveName: string; +begin + Result := ''; +end; + function TJclCompressionArchive.AddVolume(const VolumeName: string; AVolumeMaxSize: Int64): Integer; begin @@ -3035,12 +3644,6 @@ //=== { TJclCompressArchive } ================================================ -procedure TJclCompressArchive.CheckNotCompressing; -begin - if FCompressing then - raise EJclCompressionError.CreateRes(@RsCompressionCompressingError); -end; - function TJclCompressArchive.AddDirectory(const PackedName: WideString; const DirName: string; RecurseIntoDir: Boolean; AddFilesInDir: Boolean): Integer; var @@ -3117,6 +3720,12 @@ Result := FItems.Add(AItem); end; +procedure TJclCompressArchive.CheckNotCompressing; +begin + if FCompressing then + raise EJclCompressionError.CreateRes(@RsCompressionCompressingError); +end; + procedure TJclCompressArchive.InternalAddDirectory(const Directory: string); begin AddDirectory(TranslateItemPath(Directory, FBaseDirName, FBaseRelName), Directory, False, FAddFilesInDir); @@ -3987,6 +4596,16 @@ //=== { TJcl7zCompressArchive } ============================================== +class function TJcl7zCompressArchive.ArchiveExtensions: string; +begin + Result := LoadResString(@RsCompression7zExtensions); +end; + +class function TJcl7zCompressArchive.ArchiveName: string; +begin + Result := LoadResString(@RsCompression7zName); +end; + procedure TJcl7zCompressArchive.CreateCompressionObject; begin inherited CreateCompressionObject; @@ ... [truncated message content] |