1570 lines
61 KiB
ObjectPascal
1570 lines
61 KiB
ObjectPascal
////////////////////////////////////////////////////////////////////////////////
|
||
//
|
||
// ****************************************************************************
|
||
// * Project : FWZip
|
||
// * Unit Name : FWZipReader
|
||
// * Purpose : Набор классов для распаковки ZIP архива
|
||
// * Author : Александр (Rouse_) Багель
|
||
// * Copyright : © Fangorn Wizards Lab 1998 - 2015.
|
||
// * Version : 1.0.11
|
||
// * Home Page : http://rouse.drkb.ru
|
||
// * Home Blog : http://alexander-bagel.blogspot.ru
|
||
// ****************************************************************************
|
||
// * Stable Release : http://rouse.drkb.ru/components.php#fwzip
|
||
// * Latest Source : https://github.com/AlexanderBagel/FWZip
|
||
// ****************************************************************************
|
||
//
|
||
// Используемые источники:
|
||
// ftp://ftp.info-zip.org/pub/infozip/doc/appnote-iz-latest.zip
|
||
// http://zlib.net/zlib-1.2.5.tar.gz
|
||
// http://www.base2ti.com/
|
||
//
|
||
|
||
unit FWZipReader;
|
||
{$mode delphi}
|
||
{$codepage UTF8}
|
||
|
||
interface
|
||
|
||
{$I fwzip.inc}
|
||
|
||
uses
|
||
LCLIntf, LCLType, LMessages, windows,
|
||
SysUtils,
|
||
Classes,
|
||
Contnrs,
|
||
FWZipConsts,
|
||
FWZipCrc32,
|
||
FWZipCrypt,
|
||
FWZipStream,
|
||
Masks, FileUtil,
|
||
FWZipZLib, LazFileUtils;
|
||
|
||
type
|
||
TFWZipReader = class;
|
||
|
||
TExtractResult = (erError, erDone, erNeedPassword, erWrongCRC32, erSkiped);
|
||
TPresentStream = (ssZIP64, ssNTFS);
|
||
TPresentStreams = set of TPresentStream;
|
||
|
||
TFWZipReaderItem = class
|
||
private
|
||
FOwner: TFWZipReader;
|
||
FLocalFileHeader: TLocalFileHeader;
|
||
FFileHeader: TCentralDirectoryFileHeaderEx;
|
||
FIsFolder: Boolean;
|
||
FOnProgress: TZipExtractItemEvent;
|
||
FTotalExtracted, FExtractStreamStartSize: Int64;
|
||
FExtractStream: TStream;
|
||
FItemIndex, FTag: Integer;
|
||
FDuplicate: TZipDuplicateEvent;
|
||
FPresentStreams: TPresentStreams;
|
||
function GetString(const Index: Integer): string;
|
||
protected
|
||
procedure DoProgress(Sender: TObject; ProgressState: TProgressState);
|
||
procedure DecompressorOnProcess(Sender: TObject);
|
||
procedure LoadExData;
|
||
procedure LoadStringValue(var Value: string; nSize: Cardinal;
|
||
CheckEncoding: Boolean);
|
||
procedure LoadLocalFileHeader;
|
||
constructor InitFromStream(Owner: TFWZipReader;
|
||
Index: Integer; Value: TStream);
|
||
protected
|
||
property LocalFileHeader: TLocalFileHeader read FLocalFileHeader;
|
||
property CentralDirFileHeader: TCentralDirectoryFileHeader
|
||
read FFileHeader.Header;
|
||
property CentralDirFileHeaderEx: TCentralDirectoryFileHeaderEx read FFileHeader;
|
||
property RelativeOffsetOfLocalHeader: Int64 read
|
||
FFileHeader.RelativeOffsetOfLocalHeader;
|
||
property DiskNumberStart: Integer read FFileHeader.DiskNumberStart;
|
||
public
|
||
function Extract(const Path, Password: string): TExtractResult; overload;
|
||
function Extract(const Path, NewFileName, Password: string): TExtractResult; overload;
|
||
function ExtractToStream(Value: TStream; const Password: string;
|
||
CheckCRC32: Boolean = True): TExtractResult;
|
||
property Attributes: TWin32FileAttributeData read FFileHeader.Attributes;
|
||
property Comment: string index 0 read GetString;
|
||
property ItemIndex: Integer read FItemIndex;
|
||
property IsFolder: Boolean read FIsFolder;
|
||
property FileName: string index 1 read GetString;
|
||
property VersionMadeBy: Word read FFileHeader.Header.VersionMadeBy;
|
||
property VersionNeededToExtract: Word read
|
||
FFileHeader.Header.VersionNeededToExtract;
|
||
property CompressionMethod: Word read FFileHeader.Header.CompressionMethod;
|
||
property LastModFileTime: Word read FFileHeader.Header.LastModFileTimeTime;
|
||
property LastModFileDate: Word read FFileHeader.Header.LastModFileTimeDate;
|
||
property Crc32: Cardinal read FFileHeader.Header.Crc32;
|
||
property CompressedSize: Int64 read FFileHeader.CompressedSize;
|
||
property PresentStreams: TPresentStreams read FPresentStreams;
|
||
property Tag: Integer read FTag write FTag;
|
||
property UncompressedSize: Int64 read FFileHeader.UncompressedSize;
|
||
property OnProgress: TZipExtractItemEvent
|
||
read FOnProgress write FOnProgress;
|
||
property OnDuplicate: TZipDuplicateEvent read FDuplicate write FDuplicate;
|
||
end;
|
||
|
||
TFWZipReader = class
|
||
private
|
||
FZIPStream, FFileStream: TStream;
|
||
FLocalFiles: TObjectList;
|
||
FZip64EOFCentralDirectoryRecord: TZip64EOFCentralDirectoryRecord;
|
||
FZip64EOFCentralDirectoryLocator: TZip64EOFCentralDirectoryLocator;
|
||
FEndOfCentralDir: TEndOfCentralDir;
|
||
FEndOfCentralDirComment: AnsiString;
|
||
FOnProgress: TZipProgressEvent;
|
||
FOnNeedPwd: TZipNeedPasswordEvent;
|
||
FTotalSizeCount, FTotalProcessedCount: Int64;
|
||
FPasswordList: TStringList;
|
||
FOnLoadExData: TZipLoadExDataEvent;
|
||
FException: TZipExtractExceptionEvent;
|
||
FDuplicate: TZipDuplicateEvent;
|
||
FStartZipDataOffset, FEndZipDataOffset: Int64;
|
||
FDefaultDuplicateAction: TDuplicateAction;
|
||
function GetItem(Index: Integer): TFWZipReaderItem;
|
||
procedure SetDefaultDuplicateAction(const Value: TDuplicateAction);
|
||
protected
|
||
property ZIPStream: TStream read FZIPStream;
|
||
// Rouse_ 02.10.2012
|
||
// Добавлены поля для указания кастомной позиции архива в стриме с данными
|
||
property StartZipDataOffset: Int64 read FStartZipDataOffset;
|
||
property EndZipDataOffset: Int64 read FEndZipDataOffset;
|
||
protected
|
||
function Zip64Present: Boolean;
|
||
function SizeOfCentralDirectory: Int64;
|
||
function TotalEntryesCount: Integer;
|
||
procedure LoadStringValue(var Value: AnsiString; nSize: Cardinal);
|
||
procedure LoadEndOfCentralDirectory;
|
||
procedure LoadZIP64Locator;
|
||
procedure LoadZip64EOFCentralDirectoryRecord;
|
||
procedure LoadCentralDirectoryFileHeader;
|
||
procedure ProcessExtractOrCheckAllData(const ExtractMask: string;
|
||
Path: string; CheckMode: Boolean);
|
||
protected
|
||
procedure DoProgress(Sender: TObject;
|
||
const FileName: string; Extracted, TotalSize: Int64;
|
||
ProgressState: TProgressState);
|
||
protected
|
||
property Zip64EOFCentralDirectoryRecord: TZip64EOFCentralDirectoryRecord
|
||
read FZip64EOFCentralDirectoryRecord;
|
||
property Zip64EOFCentralDirectoryLocator: TZip64EOFCentralDirectoryLocator
|
||
read FZip64EOFCentralDirectoryLocator;
|
||
property EndOfCentralDir: TEndOfCentralDir read FEndOfCentralDir;
|
||
public
|
||
constructor Create;
|
||
destructor Destroy; override;
|
||
procedure Clear;
|
||
function GetElementIndex(const FileName: string): Integer;
|
||
procedure LoadFromFile(const Value: string; SFXOffset: Integer = -1;
|
||
ZipEndOffset: Integer = -1);
|
||
procedure LoadFromStream(Value: TStream; SFXOffset: Integer = -1;
|
||
ZipEndOffset: Integer = -1);
|
||
procedure ExtractAll(const Path: string); overload;
|
||
procedure ExtractAll(const ExtractMask: string; Path: string); overload;
|
||
procedure Check(const ExtractMask: string = '');
|
||
function Count: Integer;
|
||
property DefaultDuplicateAction: TDuplicateAction
|
||
read FDefaultDuplicateAction write SetDefaultDuplicateAction;
|
||
property Item[Index: Integer]: TFWZipReaderItem read GetItem; default;
|
||
property Comment: AnsiString read FEndOfCentralDirComment;
|
||
property PasswordList: TStringList read FPasswordList;
|
||
property OnProgress: TZipProgressEvent read FOnProgress write FOnProgress;
|
||
property OnPassword: TZipNeedPasswordEvent
|
||
read FOnNeedPwd write FOnNeedPwd;
|
||
property OnLoadExData: TZipLoadExDataEvent
|
||
read FOnLoadExData write FOnLoadExData;
|
||
property OnException: TZipExtractExceptionEvent
|
||
read FException write FException;
|
||
property OnDuplicate: TZipDuplicateEvent read FDuplicate write FDuplicate;
|
||
end;
|
||
|
||
EWrongPasswordException = class(Exception);
|
||
EZipReaderItem = class(Exception);
|
||
EZipReader = class(Exception);
|
||
EZipReaderRead = class(Exception);
|
||
|
||
implementation
|
||
|
||
{ TFWZipReaderItem }
|
||
|
||
//
|
||
// Обработчик OnProcess у распаковщика
|
||
// =============================================================================
|
||
procedure TFWZipReaderItem.DecompressorOnProcess(Sender: TObject);
|
||
begin
|
||
DoProgress(Sender, psInProgress);
|
||
end;
|
||
|
||
//
|
||
// Процедура вызывает внешнее событие OnProcess
|
||
// =============================================================================
|
||
procedure TFWZipReaderItem.DoProgress(Sender: TObject;
|
||
ProgressState: TProgressState);
|
||
begin
|
||
if Assigned(FOnProgress) then
|
||
if Sender = nil then
|
||
FOnProgress(Self, FileName, FTotalExtracted,
|
||
UncompressedSize, ProgressState)
|
||
else
|
||
begin
|
||
FTotalExtracted := FExtractStream.Size - FExtractStreamStartSize;
|
||
FOnProgress(Self, FileName, FTotalExtracted,
|
||
UncompressedSize, ProgressState);
|
||
end;
|
||
end;
|
||
|
||
//
|
||
// Функция распаковывает текущий элемент архва в указанную папку
|
||
// =============================================================================
|
||
function TFWZipReaderItem.Extract(const Path, Password: string): TExtractResult;
|
||
begin
|
||
Result := Extract(Path, '', Password);
|
||
end;
|
||
|
||
//
|
||
// Функция распаковывает текущий элемент архва в указанный файл
|
||
// =============================================================================
|
||
function TFWZipReaderItem.Extract(
|
||
const Path, NewFileName, Password: string): TExtractResult;
|
||
var
|
||
UnpackedFile: TFileStream;
|
||
FullPath: string;
|
||
hFile: THandle;
|
||
FileDate: Integer;
|
||
DuplicateAction: TDuplicateAction;
|
||
begin
|
||
Result := erDone;
|
||
|
||
// Правка пустого и относительного пути
|
||
FullPath := PathCanonicalize(Path);
|
||
if Path = '' then
|
||
FullPath := GetCurrentDirUTF8; { *Преобразовано из GetCurrentDir* }
|
||
|
||
FullPath := StringReplace(
|
||
IncludeTrailingPathDelimiter(FullPath) + FFileHeader.FileName,
|
||
ZIP_SLASH, '\', [rfReplaceAll]);
|
||
|
||
// Rouse_ 23.03.2015
|
||
// Даем возможность поменять имя распаковываемого файла на лету
|
||
if NewFileName <> '' then
|
||
FullPath := ExtractFilePath(FullPath) + NewFileName;
|
||
|
||
if Length(FullPath) > MAX_PATH then
|
||
raise EZipReaderItem.CreateFmt(
|
||
'Элемент архива №%d "%s" не может быть распакован.' + sLineBreak +
|
||
'Общая длина пути и имени файла не должна превышать 260 символов',
|
||
[ItemIndex, FFileHeader.FileName]);
|
||
if IsFolder then
|
||
begin
|
||
ForceDirectoriesUTF8(FullPath); { *Преобразовано из ForceDirectories* }
|
||
Exit;
|
||
end;
|
||
ForceDirectoriesUTF8(ExtractFilePath(FullPath)); { *Преобразовано из ForceDirectories* }
|
||
try
|
||
|
||
// проверка на существование файла
|
||
if FileExistsUTF8(FullPath) { *Преобразовано из FileExists* } then
|
||
begin
|
||
|
||
// если файл уже существует, узнаем - как жить дальше с этим ;)
|
||
DuplicateAction := FOwner.DefaultDuplicateAction;
|
||
if Assigned(FDuplicate) then
|
||
FDuplicate(Self, FullPath, DuplicateAction);
|
||
|
||
case DuplicateAction of
|
||
|
||
// пропустить файл
|
||
daSkip:
|
||
begin
|
||
Result := erSkiped;
|
||
Exit;
|
||
end;
|
||
|
||
// перезаписать
|
||
daOverwrite:
|
||
SetFileAttributes(PChar(FullPath), FILE_ATTRIBUTE_NORMAL);
|
||
|
||
// распаковать с другим именем
|
||
daUseNewFilePath:
|
||
// если программист указал новый пусть к файлу,
|
||
// то о существовании директории он должен позаботиться сам
|
||
if not DirectoryExistsUTF8(ExtractFilePath(FullPath)) { *Преобразовано из DirectoryExists* } then
|
||
begin
|
||
Result := erSkiped;
|
||
Exit;
|
||
end;
|
||
|
||
// прервать распаковку
|
||
daAbort:
|
||
Abort;
|
||
|
||
end;
|
||
end;
|
||
|
||
UnpackedFile := TFileStream.Create(FullPath, fmCreate);
|
||
try
|
||
Result := ExtractToStream(UnpackedFile, Password);
|
||
finally
|
||
UnpackedFile.Free;
|
||
end;
|
||
|
||
if Result <> erDone then
|
||
begin
|
||
DeleteFileUTF8(FullPath); { *Преобразовано из DeleteFile* }
|
||
Exit;
|
||
end;
|
||
|
||
if IsAttributesPresent(FFileHeader.Attributes) then
|
||
begin
|
||
hFile := FileOpen(FullPath, fmOpenWrite);
|
||
try
|
||
SetFileTime(hFile,
|
||
@FFileHeader.Attributes.ftCreationTime,
|
||
@FFileHeader.Attributes.ftLastAccessTime,
|
||
@FFileHeader.Attributes.ftLastWriteTime);
|
||
finally
|
||
FileClose(hFile);
|
||
end;
|
||
SetFileAttributes(PChar(FullPath),
|
||
FFileHeader.Attributes.dwFileAttributes);
|
||
end
|
||
else
|
||
begin
|
||
FileDate :=
|
||
FFileHeader.Header.LastModFileTimeTime +
|
||
FFileHeader.Header.LastModFileTimeDate shl 16;
|
||
FileSetDateUTF8(FullPath,FileDate); { *Преобразовано из FileSetDate* }
|
||
end;
|
||
|
||
except
|
||
DeleteFileUTF8(FullPath); { *Преобразовано из DeleteFile* }
|
||
raise;
|
||
end;
|
||
end;
|
||
|
||
//
|
||
// Функция распаковывает текущий элемент архва в стрим
|
||
// =============================================================================
|
||
function TFWZipReaderItem.ExtractToStream(Value: TStream;
|
||
const Password: string; CheckCRC32: Boolean): TExtractResult;
|
||
|
||
function CopyWithProgress(Src, Dst: TStream; Count: Int64;
|
||
Decryptor: TFWZipDecryptor): Cardinal;
|
||
var
|
||
Buff: Pointer;
|
||
Size: Integer;
|
||
begin
|
||
Result := $FFFFFFFF;
|
||
try
|
||
GetMem(Buff, MAXWORD);
|
||
try
|
||
Size := MAXWORD;
|
||
DoProgress(nil, psInitialization);
|
||
while Size = MAXWORD do
|
||
begin
|
||
if Count - FTotalExtracted < MAXWORD then
|
||
Size := Count - FTotalExtracted;
|
||
if Src.Read(Buff^, Size) <> Size then
|
||
raise EZipReaderRead.CreateFmt(
|
||
'Ошибка чтения данных элемента №%d "%s".', [ItemIndex, FileName]);
|
||
if Decryptor <> nil then
|
||
Decryptor.DecryptBuffer(Buff, Size);
|
||
Result := CRC32Calc(Result, Buff, Size);
|
||
Dst.WriteBuffer(Buff^, Size);
|
||
Inc(FTotalExtracted, Size);
|
||
DoProgress(nil, psInProgress);
|
||
end;
|
||
DoProgress(nil, psFinalization);
|
||
finally
|
||
FreeMem(Buff);
|
||
end;
|
||
Result := Result xor $FFFFFFFF;
|
||
except
|
||
DoProgress(nil, psException);
|
||
raise;
|
||
end;
|
||
end;
|
||
|
||
const
|
||
CompressionMetods: array [0..12] of string = (
|
||
'Store',
|
||
'Shrunk',
|
||
'Reduced1',
|
||
'Reduced2',
|
||
'Reduced3',
|
||
'Reduced4',
|
||
'Imploded',
|
||
'Tokenizing compression algorithm',
|
||
'Deflate',
|
||
'Deflate64',
|
||
'PKWARE Data Compression Library Imploding',
|
||
'PKWARE',
|
||
'BZIP2'
|
||
);
|
||
var
|
||
Decompressor: TZDecompressionStream;
|
||
ZipItemStream: TFWZipItemStream;
|
||
Decryptor: TFWZipDecryptor;
|
||
RealCompressedSize: Int64;
|
||
CurrItemCRC32: Cardinal;
|
||
CRC32Stream: TFWZipCRC32Stream;
|
||
begin
|
||
Result := erError;
|
||
CurrItemCRC32 := 0;
|
||
FTotalExtracted := 0;
|
||
Decryptor := nil;
|
||
try
|
||
if IsFolder then Exit;
|
||
|
||
// Данные для распаковки находятся сразу за LocalFileHeader.
|
||
// Для получения оффсета на начало данных необходимо распарсить
|
||
// данную структуру включая блоки с дополнительной информацией.
|
||
if FFileHeader.DataOffset = 0 then
|
||
LoadLocalFileHeader;
|
||
|
||
FOwner.FZIPStream.Position := FFileHeader.DataOffset;
|
||
RealCompressedSize := FFileHeader.CompressedSize;
|
||
|
||
// Если файл зашифрован, необходимо инициализировать ключ для распаковки
|
||
if FFileHeader.Header.GeneralPurposeBitFlag and PBF_CRYPTED <> 0 then
|
||
begin
|
||
|
||
if FFileHeader.Header.GeneralPurposeBitFlag and
|
||
PBF_STRONG_CRYPT <> 0 then
|
||
raise EZipReaderItem.CreateFmt(
|
||
'Ошибка извлечения данных элемента №%d "%s".' + sLineBreak +
|
||
'Не поддерживаемый режим шифрования',
|
||
[ItemIndex, FileName]);
|
||
|
||
if Password = '' then
|
||
begin
|
||
// пароль не может быть пустым
|
||
Result := erNeedPassword;
|
||
Exit;
|
||
end;
|
||
Decryptor := TFWZipDecryptor.Create(AnsiString(Password));
|
||
if not Decryptor.LoadEncryptionHeader(FOwner.FZIPStream,
|
||
FFileHeader.Header.GeneralPurposeBitFlag and PBF_DESCRIPTOR <> 0,
|
||
FFileHeader.Header.Crc32,
|
||
FFileHeader.Header.LastModFileTimeTime +
|
||
FFileHeader.Header.LastModFileTimeDate shl 16) then
|
||
begin
|
||
// ошика инициализации ключа
|
||
Result := erNeedPassword;
|
||
Exit;
|
||
end
|
||
else
|
||
// если ключ инициализирован успешно - вычитаем из сжатого размера
|
||
// размер заголовка инициализации ключа
|
||
Dec(RealCompressedSize, EncryptedHeaderSize);
|
||
end;
|
||
|
||
case FFileHeader.Header.CompressionMethod of
|
||
Z_NO_COMPRESSION:
|
||
begin
|
||
CurrItemCRC32 :=
|
||
CopyWithProgress(FOwner.FZIPStream, Value,
|
||
UncompressedSize, Decryptor);
|
||
// Rouse_ 11.03.2011
|
||
// А выставить результат то и забыли.
|
||
// Cпасибо Ромкину за обнаружение косяка
|
||
Result := erDone;
|
||
end;
|
||
Z_DEFLATED:
|
||
begin
|
||
|
||
// TFWZipItemStream выступает как посредник между FOwner.FZIPStream
|
||
// и TDecompressionStream. Его задача добавить в передаваемый
|
||
// буффер данных отсутствующий ZLib заголовок и расшифровать
|
||
// данные при необходимости
|
||
ZipItemStream := TFWZipItemStream.Create(FOwner.FZIPStream,
|
||
nil, Decryptor,
|
||
FFileHeader.Header.GeneralPurposeBitFlag and 6,
|
||
RealCompressedSize
|
||
{$IFNDEF USE_AUTOGENERATED_ZLIB_HEADER}
|
||
+ 4 // буффер, он все равно не используется,
|
||
// но нужен для завершения ZInflate при использовании windowBits
|
||
// особенно для архивов запакованных 7Zip
|
||
{$ENDIF}
|
||
);
|
||
try
|
||
Decompressor := TZDecompressionStream.Create(
|
||
ZipItemStream, defaultWindowBits);
|
||
try
|
||
Decompressor.OnProgress := DecompressorOnProcess;
|
||
FExtractStreamStartSize := Value.Size;
|
||
FExtractStream := Value;
|
||
// TFWZipCRC32Stream выступает как посредник между
|
||
// TDecompressionStream и результирующим стримом,
|
||
// в который происходит распаковка данных.
|
||
// Его задача отследить все распакованные блоки данных
|
||
// и рассчитать их контрольную сумму
|
||
DoProgress(Decompressor, psInitialization);
|
||
CRC32Stream := TFWZipCRC32Stream.Create(Value);
|
||
try
|
||
try
|
||
CRC32Stream.CopyFrom(Decompressor, UncompressedSize);
|
||
except
|
||
on E: EReadError do
|
||
raise EZipReaderRead.CreateFmt(
|
||
'Ошибка чтения данных элемента №%d "%s".', [ItemIndex, FileName]);
|
||
|
||
// Rouse_ 04.04.2010
|
||
// Ранее это исключенияе было EDecompressionError
|
||
// Поэтому привяжемся к базовому исключению EZLibError
|
||
// on E: EZDecompressionError do
|
||
on E: EZLibError do
|
||
begin
|
||
if FFileHeader.Header.GeneralPurposeBitFlag and
|
||
PBF_CRYPTED <> 0 then
|
||
begin
|
||
// Ошибка может подняться из-за того что инициализация
|
||
// криптозаголовка прошла успешно, но пароль был указан не верный
|
||
// Такое может произойти, т.к. количество коллизий
|
||
// при проверке заголовка очень велико
|
||
Result := erNeedPassword;
|
||
Exit;
|
||
end
|
||
else
|
||
DoProgress(Decompressor, psException);
|
||
raise EZipReaderRead.CreateFmt(
|
||
'Ошибка распаковки данных элемента №%d "%s".' + sLineBreak +
|
||
E.ClassName + ': ' + E.Message, [ItemIndex, FileName]);
|
||
end;
|
||
|
||
// Rouse_ 01.11.2013
|
||
// Для остальных исключений тоже нужно говорить с каким элементом беда приключилась.
|
||
on E: Exception do
|
||
raise EZipReaderRead.CreateFmt(
|
||
'Ошибка распаковки данных элемента №%d "%s".' + sLineBreak +
|
||
E.ClassName + ': ' + E.Message, [ItemIndex, FileName]);
|
||
|
||
end;
|
||
CurrItemCRC32 := CRC32Stream.CRC32;
|
||
finally
|
||
CRC32Stream.Free;
|
||
end;
|
||
DoProgress(Decompressor, psFinalization);
|
||
Result := erDone;
|
||
finally
|
||
Decompressor.Free;
|
||
end;
|
||
finally
|
||
ZipItemStream.Free;
|
||
end;
|
||
end;
|
||
1..7, 9..12:
|
||
raise EZipReaderItem.CreateFmt(
|
||
'Ошибка извлечения данных элемента №%d "%s".' + sLineBreak +
|
||
'Не поддерживаемый алгоритм декомпрессии "%s"',
|
||
[ItemIndex, FileName, CompressionMetods[CompressionMethod]]);
|
||
else
|
||
raise EZipReaderItem.CreateFmt(
|
||
'Ошибка извлечения данных элемента №%d "%s".' + sLineBreak +
|
||
'Не поддерживаемый алгоритм декомпрессии (%d)',
|
||
[ItemIndex, FileName, FFileHeader.Header.CompressionMethod]);
|
||
end;
|
||
if CurrItemCRC32 <> Crc32 then
|
||
if CheckCRC32 then
|
||
raise EZipReaderItem.CreateFmt(
|
||
'Ошибка извлечения данных элемента №%d "%s".' + sLineBreak +
|
||
'Неверная контрольная сумма.',
|
||
[ItemIndex, FileName])
|
||
else
|
||
Result := erWrongCRC32;
|
||
finally
|
||
Decryptor.Free;
|
||
end;
|
||
end;
|
||
|
||
//
|
||
// =============================================================================
|
||
function TFWZipReaderItem.GetString(const Index: Integer): string;
|
||
begin
|
||
case Index of
|
||
0: Result := FFileHeader.FileComment;
|
||
1: Result := FFileHeader.FileName;
|
||
end;
|
||
end;
|
||
|
||
//
|
||
// Конструктор элемента архива.
|
||
// Инициализация класса происходит на основе данных из архива
|
||
// =============================================================================
|
||
constructor TFWZipReaderItem.InitFromStream(Owner: TFWZipReader;
|
||
Index: Integer; Value: TStream);
|
||
var
|
||
Len: Integer;
|
||
begin
|
||
inherited Create;
|
||
|
||
FOwner := Owner;
|
||
FItemIndex := Index;
|
||
ZeroMemory(@FFileHeader, SizeOf(TCentralDirectoryFileHeaderEx));
|
||
|
||
if Owner.ZIPStream.Read(FFileHeader.Header,
|
||
SizeOf(TCentralDirectoryFileHeader)) <> SizeOf(TCentralDirectoryFileHeader) then
|
||
raise EZipReaderRead.CreateFmt(
|
||
'Отсутствуют данные TCentralDirectoryFileHeader элемента №%d', [ItemIndex]);
|
||
|
||
if FFileHeader.Header.CentralFileHeaderSignature <>
|
||
CENTRAL_FILE_HEADER_SIGNATURE then
|
||
raise EZipReaderItem.CreateFmt(
|
||
'Ошибка чтения структуры TCentralDirectoryFileHeader элемента №%d', [ItemIndex]);
|
||
|
||
LoadStringValue(FFileHeader.FileName, FFileHeader.Header.FilenameLength, True);
|
||
|
||
FIsFolder := FFileHeader.Header.ExternalFileAttributes and faDirectory <> 0;
|
||
|
||
// Rouse_ 31.08.2015
|
||
// Если используем UTF8 то FilenameLength это размер в байтах а не в символах
|
||
// поэтому вместо этого:
|
||
//if FFileHeader.Header.FilenameLength > 0 then
|
||
// FIsFolder := FIsFolder or
|
||
// (FFileHeader.FileName[FFileHeader.Header.FilenameLength] = ZIP_SLASH);
|
||
// пишем вот так:
|
||
Len := Length(FFileHeader.FileName);
|
||
if Len > 0 then
|
||
FIsFolder := FIsFolder or
|
||
(FFileHeader.FileName[Len] = ZIP_SLASH);
|
||
|
||
// Следующие 4 параметра могут быть выставлены в -1 из-за переполнения
|
||
// и их реальные значения будут содержаться в блоке расширенных данных.
|
||
// Запоминаем их текущие значения.
|
||
// В случае если какой-либо из параметров выставлен в -1,
|
||
// его значение поменяется при вызове процедуры LoadExData.
|
||
FFileHeader.UncompressedSize := FFileHeader.Header.UncompressedSize;
|
||
FFileHeader.CompressedSize := FFileHeader.Header.CompressedSize;
|
||
FFileHeader.RelativeOffsetOfLocalHeader :=
|
||
FFileHeader.Header.RelativeOffsetOfLocalHeader;
|
||
FFileHeader.DiskNumberStart := FFileHeader.Header.DiskNumberStart;
|
||
|
||
LoadExData;
|
||
|
||
LoadStringValue(FFileHeader.FileComment,
|
||
FFileHeader.Header.FileCommentLength, False);
|
||
|
||
// часть информации дублируется в расширенном заголовке
|
||
// необходимо ее заполнить
|
||
FFileHeader.Attributes.dwFileAttributes :=
|
||
FFileHeader.Header.ExternalFileAttributes;
|
||
FFileHeader.Attributes.nFileSizeHigh :=
|
||
Cardinal(FFileHeader.UncompressedSize shr 32);
|
||
FFileHeader.Attributes.nFileSizeLow :=
|
||
FFileHeader.UncompressedSize and MAXDWORD;
|
||
end;
|
||
|
||
//
|
||
// Процедура зачитывает дополнительные данные о элементе
|
||
// =============================================================================
|
||
procedure TFWZipReaderItem.LoadExData;
|
||
var
|
||
Buff, EOFBuff: Pointer;
|
||
BuffCount: Integer;
|
||
HeaderID, BlockSize: Word;
|
||
|
||
function GetOffset(Value: Integer): Pointer;
|
||
begin
|
||
Result := Pointer(Integer(EOFBuff) - Value);
|
||
end;
|
||
|
||
var
|
||
ExDataStream: TMemoryStream;
|
||
begin
|
||
if FFileHeader.Header.ExtraFieldLength = 0 then Exit;
|
||
GetMem(Buff, FFileHeader.Header.ExtraFieldLength);
|
||
try
|
||
BuffCount := FFileHeader.Header.ExtraFieldLength;
|
||
|
||
if FOwner.ZIPStream.Read(Buff^, BuffCount) <> BuffCount then
|
||
raise EZipReaderRead.CreateFmt(
|
||
'Отсутствуют данные поля ExtraField элемента №%d "%s"', [ItemIndex, FileName]);
|
||
|
||
EOFBuff := Pointer(Integer(Buff) + BuffCount);
|
||
while BuffCount > 0 do
|
||
begin
|
||
HeaderID := PWord(GetOffset(BuffCount))^;
|
||
Dec(BuffCount, 2);
|
||
BlockSize := PWord(GetOffset(BuffCount))^;
|
||
Dec(BuffCount, 2);
|
||
case HeaderID of
|
||
SUPPORTED_EXDATA_ZIP64:
|
||
begin
|
||
|
||
{
|
||
-ZIP64 Extended Information Extra Field (0x0001):
|
||
===============================================
|
||
|
||
The following is the layout of the ZIP64 extended
|
||
information "extra" block. If one of the size or
|
||
offset fields in the Local or Central directory
|
||
record is too small to hold the required data,
|
||
a ZIP64 extended information record is created.
|
||
The order of the fields in the ZIP64 extended
|
||
information record is fixed, but the fields will
|
||
only appear if the corresponding Local or Central
|
||
directory record field is set to 0xFFFF or 0xFFFFFFFF.
|
||
|
||
Note: all fields stored in Intel low-byte/high-byte order.
|
||
|
||
Value Size Description
|
||
----- ---- -----------
|
||
(ZIP64) 0x0001 2 bytes Tag for this "extra" block type
|
||
Size 2 bytes Size of this "extra" block
|
||
Original
|
||
Size 8 bytes Original uncompressed file size
|
||
Compressed
|
||
Size 8 bytes Size of compressed data
|
||
Relative Header
|
||
Offset 8 bytes Offset of local header record
|
||
Disk Start
|
||
Number 4 bytes Number of the disk on which
|
||
this file starts
|
||
|
||
This entry in the Local header must include BOTH original
|
||
and compressed file sizes.
|
||
}
|
||
|
||
if FFileHeader.UncompressedSize = MAXDWORD then
|
||
begin
|
||
if BuffCount < 8 then Break;
|
||
FFileHeader.UncompressedSize := PInt64(GetOffset(BuffCount))^;
|
||
Dec(BuffCount, 8);
|
||
Dec(BlockSize, 8);
|
||
end;
|
||
if FFileHeader.CompressedSize = MAXDWORD then
|
||
begin
|
||
if BuffCount < 8 then Break;
|
||
FFileHeader.CompressedSize := PInt64(GetOffset(BuffCount))^;
|
||
Dec(BuffCount, 8);
|
||
Dec(BlockSize, 8);
|
||
end;
|
||
if FFileHeader.RelativeOffsetOfLocalHeader = MAXDWORD then
|
||
begin
|
||
if BuffCount < 8 then Break;
|
||
FFileHeader.RelativeOffsetOfLocalHeader := PInt64(GetOffset(BuffCount))^;
|
||
Dec(BuffCount, 8);
|
||
Dec(BlockSize, 8);
|
||
end;
|
||
if FFileHeader.DiskNumberStart = MAXWORD then
|
||
begin
|
||
if BuffCount < 4 then Break;
|
||
FFileHeader.DiskNumberStart := PCardinal(GetOffset(BuffCount))^;
|
||
Dec(BuffCount, 4);
|
||
Dec(BlockSize, 4);
|
||
end;
|
||
Dec(BuffCount, BlockSize);
|
||
Include(FPresentStreams, ssZIP64);
|
||
end;
|
||
|
||
SUPPORTED_EXDATA_NTFSTIME:
|
||
begin
|
||
|
||
{
|
||
-PKWARE Win95/WinNT Extra Field (0x000a):
|
||
=======================================
|
||
|
||
The following description covers PKWARE's "NTFS" attributes
|
||
"extra" block, introduced with the release of PKZIP 2.50 for
|
||
Windows. (Last Revision 20001118)
|
||
|
||
(Note: At this time the Mtime, Atime and Ctime values may
|
||
be used on any WIN32 system.)
|
||
[Info-ZIP note: In the current implementations, this field has
|
||
a fixed total data size of 32 bytes and is only stored as local
|
||
extra field.]
|
||
|
||
Value Size Description
|
||
----- ---- -----------
|
||
(NTFS) 0x000a Short Tag for this "extra" block type
|
||
TSize Short Total Data Size for this block
|
||
Reserved Long for future use
|
||
Tag1 Short NTFS attribute tag value #1
|
||
Size1 Short Size of attribute #1, in bytes
|
||
(var.) SubSize1 Attribute #1 data
|
||
.
|
||
.
|
||
.
|
||
TagN Short NTFS attribute tag value #N
|
||
SizeN Short Size of attribute #N, in bytes
|
||
(var.) SubSizeN Attribute #N data
|
||
|
||
For NTFS, values for Tag1 through TagN are as follows:
|
||
(currently only one set of attributes is defined for NTFS)
|
||
|
||
Tag Size Description
|
||
----- ---- -----------
|
||
0x0001 2 bytes Tag for attribute #1
|
||
Size1 2 bytes Size of attribute #1, in bytes (24)
|
||
Mtime 8 bytes 64-bit NTFS file last modification time
|
||
Atime 8 bytes 64-bit NTFS file last access time
|
||
Ctime 8 bytes 64-bit NTFS file creation time
|
||
|
||
The total length for this block is 28 bytes, resulting in a
|
||
fixed size value of 32 for the TSize field of the NTFS block.
|
||
|
||
The NTFS filetimes are 64-bit unsigned integers, stored in Intel
|
||
(least significant byte first) byte order. They determine the
|
||
number of 1.0E-07 seconds (1/10th microseconds!) past WinNT "epoch",
|
||
which is "01-Jan-1601 00:00:00 UTC".
|
||
}
|
||
|
||
// проверяем размерность поля с учетом примечания:
|
||
// this field has a fixed total data size of 32 bytes
|
||
|
||
// если размер буффера меньше 32 байт - то выходим из процедуры
|
||
if BuffCount < 32 then Break;
|
||
|
||
// если же он не равер 32 байтам,
|
||
// то просто пропускаем его и ереходим к слежующей записи
|
||
if BlockSize <> 32 then
|
||
begin
|
||
Dec(BuffCount, BlockSize);
|
||
Continue;
|
||
end;
|
||
|
||
// пропускаем поле Reserved
|
||
Dec(BuffCount, 4);
|
||
|
||
// Проверяем поле Tag
|
||
if PWord(GetOffset(BuffCount))^ <> 1 then
|
||
begin
|
||
Dec(BuffCount, BlockSize);
|
||
Continue;
|
||
end;
|
||
Dec(BuffCount, 2);
|
||
|
||
// Проверяем размер блока данных
|
||
if PWord(GetOffset(BuffCount))^ <> SizeOf(TNTFSFileTime) then
|
||
begin
|
||
Dec(BuffCount, BlockSize);
|
||
Continue;
|
||
end;
|
||
Dec(BuffCount, 2);
|
||
|
||
// Читаем сами данные
|
||
FFileHeader.Attributes.ftLastWriteTime := PFileTime(GetOffset(BuffCount))^;
|
||
Dec(BuffCount, SizeOf(TFileTime));
|
||
FFileHeader.Attributes.ftLastAccessTime := PFileTime(GetOffset(BuffCount))^;
|
||
Dec(BuffCount, SizeOf(TFileTime));
|
||
FFileHeader.Attributes.ftCreationTime := PFileTime(GetOffset(BuffCount))^;
|
||
Dec(BuffCount, SizeOf(TFileTime));
|
||
Include(FPresentStreams, ssNTFS);
|
||
end;
|
||
else
|
||
if Assigned(FOwner.OnLoadExData) then
|
||
begin
|
||
ExDataStream := TMemoryStream.Create;
|
||
try
|
||
ExDataStream.WriteBuffer(GetOffset(BuffCount)^, BlockSize);
|
||
ExDataStream.Position := 0;
|
||
FOwner.OnLoadExData(Self, FItemIndex, HeaderID, ExDataStream);
|
||
finally
|
||
ExDataStream.Free;
|
||
end;
|
||
end;
|
||
Dec(BuffCount, BlockSize);
|
||
end;
|
||
end;
|
||
finally
|
||
FreeMem(Buff);
|
||
end;
|
||
end;
|
||
|
||
//
|
||
// Процедура зачитывает и проверяет валидность структуры LocalFileHeader
|
||
// Задача процедуры получить правильное значение оффсета на начало
|
||
// запакованного блока данных.
|
||
// =============================================================================
|
||
procedure TFWZipReaderItem.LoadLocalFileHeader;
|
||
begin
|
||
// Rouse_ 02.10.2012
|
||
// При чтении учитываем оффсет на начало архива StartZipDataOffset
|
||
FOwner.ZIPStream.Position :=
|
||
FFileHeader.RelativeOffsetOfLocalHeader + FOwner.StartZipDataOffset;
|
||
|
||
if FOwner.ZIPStream.Read(FLocalFileHeader,
|
||
SizeOf(TLocalFileHeader)) <> SizeOf(TLocalFileHeader) then
|
||
raise EZipReaderRead.CreateFmt(
|
||
'Отсутстсвуют данные TLocalFileHeader элемента №%d "%s"', [ItemIndex, FileName]);
|
||
|
||
if FLocalFileHeader.LocalFileHeaderSignature <>
|
||
LOCAL_FILE_HEADER_SIGNATURE then
|
||
raise EZipReaderItem.CreateFmt(
|
||
'Ошибка чтения TLocalFileHeader элемента №%d "%s"', [ItemIndex, FileName]);
|
||
|
||
FFileHeader.DataOffset := FOwner.ZIPStream.Position +
|
||
FLocalFileHeader.FilenameLength + FLocalFileHeader.ExtraFieldLength;
|
||
end;
|
||
|
||
//
|
||
// Процедура зачитывает строковое значение и переводит его в Ansi формат
|
||
// =============================================================================
|
||
procedure TFWZipReaderItem.LoadStringValue(var Value: string;
|
||
nSize: Cardinal; CheckEncoding: Boolean);
|
||
var
|
||
aString: AnsiString;
|
||
begin
|
||
if Integer(nSize) > 0 then
|
||
begin
|
||
SetLength(aString, nSize);
|
||
|
||
if FOwner.ZIPStream.Read(aString[1], nSize) <> Integer(nSize) then
|
||
raise EZipReaderRead.CreateFmt(
|
||
'Ошибка чтения строковых данных элемента №%d "%s"', [ItemIndex, FileName]);
|
||
|
||
// Rouse_ 13.06.2013
|
||
// 11 бит отвечает за UTF8 кодировку
|
||
if FFileHeader.Header.GeneralPurposeBitFlag and PBF_UTF8 = PBF_UTF8 then
|
||
begin
|
||
{$IFDEF UNICODE}
|
||
Value := string(UTF8ToUnicodeString(aString))
|
||
{$ELSE}
|
||
Value := string(UTF8Decode(aString));
|
||
// в неюникодных версиях Delphi юникодные символы будут преобразованы в знаки вопроса
|
||
if CheckEncoding then
|
||
Value := StringReplace(Value, '?', '_', [rfReplaceAll]);
|
||
{$ENDIF}
|
||
end
|
||
else
|
||
begin
|
||
OemToAnsi(@aString[1], @aString[1]);
|
||
Value := string(aString);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
{ TFWZipReader }
|
||
|
||
//
|
||
// Процедура производит проверку архива с учетом маски файла в архиве
|
||
// Данные распаковываются, но не сохраняются
|
||
// =============================================================================
|
||
procedure TFWZipReader.Check(const ExtractMask: string);
|
||
begin
|
||
ProcessExtractOrCheckAllData(ExtractMask, '', True);
|
||
end;
|
||
|
||
//
|
||
// Процедура очищает данные о открытом ранее архиве
|
||
// =============================================================================
|
||
procedure TFWZipReader.Clear;
|
||
begin
|
||
ZeroMemory(@FZip64EOFCentralDirectoryRecord,
|
||
SizeOf(TZip64EOFCentralDirectoryRecord));
|
||
ZeroMemory(@FZip64EOFCentralDirectoryLocator,
|
||
SizeOf(TZip64EOFCentralDirectoryLocator));
|
||
ZeroMemory(@FEndOfCentralDir, SizeOf(TEndOfCentralDir));
|
||
FLocalFiles.Clear;
|
||
FreeAndNil(FFileStream);
|
||
end;
|
||
|
||
//
|
||
// Функция возвращает количество элементов открытого архива
|
||
// =============================================================================
|
||
function TFWZipReader.Count: Integer;
|
||
begin
|
||
Result := FLocalFiles.Count;
|
||
end;
|
||
|
||
// =============================================================================
|
||
constructor TFWZipReader.Create;
|
||
begin
|
||
inherited;
|
||
FLocalFiles := TObjectList.Create;
|
||
FPasswordList := TStringList.Create;
|
||
FPasswordList.Duplicates := dupIgnore;
|
||
FPasswordList.Sorted := True;
|
||
DefaultDuplicateAction := daSkip;
|
||
end;
|
||
|
||
// =============================================================================
|
||
destructor TFWZipReader.Destroy;
|
||
begin
|
||
FPasswordList.Free;
|
||
FLocalFiles.Free;
|
||
FFileStream.Free;
|
||
inherited;
|
||
end;
|
||
|
||
//
|
||
// Процедура вызывает обработчик OnProgress
|
||
// =============================================================================
|
||
procedure TFWZipReader.DoProgress(Sender: TObject; const FileName: string;
|
||
Extracted, TotalSize: Int64; ProgressState: TProgressState);
|
||
var
|
||
Percent, TotalPercent: Byte;
|
||
Cancel: Boolean;
|
||
begin
|
||
if Assigned(FOnProgress) then
|
||
begin
|
||
if TotalSize = 0 then
|
||
if ProgressState in [psStart, psInitialization] then
|
||
Percent := 0
|
||
else
|
||
Percent := 100
|
||
else
|
||
if ProgressState = psEnd then
|
||
Percent := 100
|
||
else
|
||
Percent := Round(Extracted / (TotalSize / 100));
|
||
if FTotalSizeCount = 0 then
|
||
TotalPercent := 100
|
||
else
|
||
TotalPercent :=
|
||
Round((FTotalProcessedCount + Extracted) / (FTotalSizeCount / 100));
|
||
Cancel := False;
|
||
FOnProgress(Self, FileName, Percent, TotalPercent, Cancel, ProgressState);
|
||
if Cancel then Abort;
|
||
end;
|
||
end;
|
||
|
||
//
|
||
// Процедура производит автоматическую распаковку архива в указанную папку
|
||
// с учетом маски файла в архиве
|
||
// =============================================================================
|
||
procedure TFWZipReader.ExtractAll(const ExtractMask: string; Path: string);
|
||
begin
|
||
ProcessExtractOrCheckAllData(ExtractMask, Path, False);
|
||
end;
|
||
|
||
//
|
||
// Процедура производит автоматическую распаковку архива в указанную папку
|
||
// =============================================================================
|
||
procedure TFWZipReader.ExtractAll(const Path: string);
|
||
begin
|
||
ExtractAll('', Path);
|
||
end;
|
||
|
||
//
|
||
// Функция возвращает индекс элемента по его имени
|
||
// =============================================================================
|
||
function TFWZipReader.GetElementIndex(const FileName: string): Integer;
|
||
var
|
||
I: Integer;
|
||
begin
|
||
Result := -1;
|
||
for I := 0 to Count - 1 do
|
||
if AnsiCompareText(Item[I].FileName, FileName) = 0 then
|
||
begin
|
||
Result := I;
|
||
Break;
|
||
end;
|
||
end;
|
||
|
||
//
|
||
// Функция возвращает элемент архива по его индексу
|
||
// =============================================================================
|
||
function TFWZipReader.GetItem(Index: Integer): TFWZipReaderItem;
|
||
begin
|
||
Result := TFWZipReaderItem(FLocalFiles[Index]);
|
||
end;
|
||
|
||
//
|
||
// Процедура зачитывает центральную директорию архива
|
||
// =============================================================================
|
||
procedure TFWZipReader.LoadCentralDirectoryFileHeader;
|
||
var
|
||
EndOfLoadCentralDirectory: Int64;
|
||
begin
|
||
EndOfLoadCentralDirectory := FZIPStream.Position + SizeOfCentralDirectory;
|
||
while FZIPStream.Position < EndOfLoadCentralDirectory do
|
||
FLocalFiles.Add(TFWZipReaderItem.InitFromStream(Self, Count, FZIPStream));
|
||
|
||
// Rouse_ 01.11.2013
|
||
// Исключение будем поднимать только в случае если заявленное кол-во элементов
|
||
// больше чем удалось прочитать.
|
||
// Ибо попался мне один архив в котором кол-во элементов 95188,
|
||
// (превышение по количеству элементов и нужно использовать ZIP64),
|
||
// но ZIP64 не использовался и поле TotalNumberOfEntries хранило значение 29652
|
||
// Собственно что и равняется 95188 - $10000
|
||
|
||
// Поэтому вместо такого условия:
|
||
//if Count <> TotalEntryesCount then
|
||
//пишем вот так:
|
||
if Count < TotalEntryesCount then
|
||
|
||
raise EZipReader.CreateFmt(
|
||
'Ошибка чтения центральной директории. ' + sLineBreak +
|
||
'Прочитанное количество элементов (%d) не соответствует заявленному (%d).',
|
||
[Count, TotalEntryesCount]);
|
||
end;
|
||
|
||
//
|
||
// Процедура проеряет валидность структуры EndOfCentralDirectory
|
||
// Задача процедуры получить оффсет на начало CentralDirectory
|
||
// =============================================================================
|
||
procedure TFWZipReader.LoadEndOfCentralDirectory;
|
||
var
|
||
Zip64LocatorOffset: Int64;
|
||
begin
|
||
// Согласно спецификации в случае наличия 64-битных структур
|
||
// TZip64EOFCentralDirectoryLocator идет сразу перед EndOfCentralDirectory.
|
||
// Запоминаем оффсет на предполагаемую позицию данной структуры.
|
||
Zip64LocatorOffset := FZIPStream.Position -
|
||
SizeOf(TZip64EOFCentralDirectoryLocator);
|
||
|
||
if FZIPStream.Read(FEndOfCentralDir, SizeOf(TEndOfCentralDir)) <>
|
||
SizeOf(TEndOfCentralDir) then
|
||
raise EZipReader.Create('Отсутствуют данные структуры TEndOfCentralDir.');
|
||
|
||
if FEndOfCentralDir.NumberOfThisDisk <> 0 then
|
||
raise EZipReader.Create('Многотомные архивы не поддерживаются.');
|
||
|
||
if FEndOfCentralDir.EndOfCentralDirSignature <>
|
||
END_OF_CENTRAL_DIR_SIGNATURE then
|
||
raise EZipReader.Create('Ошибка чтения структуры TEndOfCentralDir.');
|
||
|
||
LoadStringValue(FEndOfCentralDirComment,
|
||
FEndOfCentralDir.ZipfileCommentLength);
|
||
|
||
{
|
||
6) If one of the fields in the end of central directory
|
||
record is too small to hold required data, the field
|
||
should be set to -1 (0xFFFF or 0xFFFFFFFF) and the
|
||
Zip64 format record should be created.
|
||
}
|
||
|
||
if (FEndOfCentralDir.NumberOfThisDisk = MAXWORD) or
|
||
(FEndOfCentralDir.NumberOfTheDiskWithTheStart = MAXWORD) or
|
||
(FEndOfCentralDir.TotalNumberOfEntriesOnThisDisk = MAXWORD) or
|
||
(FEndOfCentralDir.TotalNumberOfEntries = MAXWORD) or
|
||
(FEndOfCentralDir.SizeOfTheCentralDirectory = MAXDWORD) or
|
||
(FEndOfCentralDir.OffsetOfStartOfCentralDirectory = MAXDWORD) then
|
||
begin
|
||
// Одна из позиций не содержит валидных данных
|
||
// Согласно спецификации их необходимо получить через Zip64Locator
|
||
FZIPStream.Position := Zip64LocatorOffset + StartZipDataOffset;
|
||
LoadZIP64Locator;
|
||
end
|
||
else
|
||
// Rouse_ 02.10.2012
|
||
// При чтении учитываем оффсет на начало архива StartZipDataOffset
|
||
FZIPStream.Position :=
|
||
FEndOfCentralDir.OffsetOfStartOfCentralDirectory + StartZipDataOffset;
|
||
end;
|
||
|
||
//
|
||
// Процедура открывает архив по указанному пути
|
||
// =============================================================================
|
||
procedure TFWZipReader.LoadFromFile(const Value: string;
|
||
SFXOffset, ZipEndOffset: Integer);
|
||
begin
|
||
// Rouse_ 20.02.2012
|
||
// Если TFileStream не создался FFileStream может содержать реф на разрушенный TFileStream,
|
||
// созданный при предыдущем вызове LoadFromFile,
|
||
// что приведет к ошибке в деструкторе при разрушении FFileStream
|
||
// Спасибо v1ctar за найденый глюк
|
||
//FFileStream.Free;
|
||
FreeAndNil(FFileStream);
|
||
FFileStream := TFileStream.Create(Value, fmOpenRead or fmShareDenyWrite);
|
||
LoadFromStream(FFileStream, SFXOffset, ZipEndOffset);
|
||
end;
|
||
|
||
//
|
||
// Процерура открывает архив из переданного стрима
|
||
// =============================================================================
|
||
procedure TFWZipReader.LoadFromStream(Value: TStream;
|
||
SFXOffset, ZipEndOffset: Integer);
|
||
var
|
||
Buff: Pointer;
|
||
I, BuffSize, SignOffset: Integer;
|
||
Offset, EndOfCentralDirectoryOffset: Int64;
|
||
Cursor: PByte;
|
||
begin
|
||
FLocalFiles.Clear;
|
||
FZIPStream := Value;
|
||
|
||
// Rouse_ 02.10.2012
|
||
// Теперь могут передаватся оффсеты на расположение архива в стриме с данными
|
||
// SFXOffset указывает на начало архива
|
||
// ZipEndOffset указывает на позицию после которой не производится поиск
|
||
// сигнатуры EndOfCentralDir
|
||
if SFXOffset < 0 then
|
||
FStartZipDataOffset := 0
|
||
else
|
||
FStartZipDataOffset := SFXOffset;
|
||
|
||
if ZipEndOffset < 0 then
|
||
FEndZipDataOffset := Value.Size
|
||
else
|
||
FEndZipDataOffset := ZipEndOffset;
|
||
|
||
// Ищем сигнатуру EndOfCentralDir
|
||
BuffSize := $FFFF;
|
||
|
||
// Rouse_ 13.03.2015
|
||
// Если архив пустой, то END_OF_CENTRAL_DIR_SIGNATURE будет распологаться
|
||
// по нулевому оффсету, стало быть ноль - это тоже правильное значение
|
||
// Поэтому флаг отсутствия данного маркера будет не ноль, а отрицательное значение
|
||
EndOfCentralDirectoryOffset := -1;
|
||
//EndOfCentralDirectoryOffset := 0;
|
||
|
||
Offset := EndZipDataOffset;
|
||
SignOffset := 0;
|
||
GetMem(Buff, BuffSize);
|
||
try
|
||
while Offset > StartZipDataOffset do
|
||
begin
|
||
Dec(Offset, BuffSize - SignOffset);
|
||
if Offset < StartZipDataOffset then
|
||
begin
|
||
Inc(BuffSize, Offset - StartZipDataOffset);
|
||
Offset := StartZipDataOffset;
|
||
end;
|
||
Value.Position := Offset;
|
||
|
||
if Value.Read(Buff^, BuffSize) <> BuffSize then
|
||
raise EZipReaderRead.Create('Ошибка чтения данных при поиске END_OF_CENTRAL_DIR_SIGNATURE');
|
||
|
||
// Rouse_ 14.02.2013
|
||
// Если в архиве будет незапакованый ZIP архив,
|
||
// то есть большой шанс что первую END_OF_CENTRAL_DIR_SIGNATURE мы
|
||
// обнаружим у него, а не у нашего архива
|
||
|
||
{
|
||
Cursor := Buff;
|
||
for I := 0 to BuffSize - 1 do
|
||
begin
|
||
if PCardinal(Cursor)^ = END_OF_CENTRAL_DIR_SIGNATURE then
|
||
begin
|
||
EndOfCentralDirectoryOffset := Offset + I;
|
||
Break;
|
||
end
|
||
else
|
||
Inc(Cursor);
|
||
}
|
||
|
||
// поэтому сигнатуру END_OF_CENTRAL_DIR_SIGNATURE будем искать вот так
|
||
Cursor := PByte(PAnsiChar(Buff) + BuffSize - 5);
|
||
for I := BuffSize - 5 downto 0 do
|
||
begin
|
||
if PCardinal(Cursor)^ = END_OF_CENTRAL_DIR_SIGNATURE then
|
||
begin
|
||
EndOfCentralDirectoryOffset := Offset + I;
|
||
Break;
|
||
end
|
||
else
|
||
Dec(Cursor);
|
||
end;
|
||
|
||
if EndOfCentralDirectoryOffset >= 0 then
|
||
Break;
|
||
|
||
// Rouse_ 14.02.2013
|
||
// Сигнатура может располагаться на границе между двумя буферами
|
||
// поэтому чтобы считать граничное состояние делаем поправку
|
||
SignOffset := 4;
|
||
|
||
end;
|
||
finally
|
||
FreeMem(Buff);
|
||
end;
|
||
if EndOfCentralDirectoryOffset < 0 then
|
||
raise EZipReader.Create('Не найдена сигнатура END_OF_CENTRAL_DIR_SIGNATURE.');
|
||
|
||
// Зачитываем саму структуру EndOfCentralDirectory
|
||
// При необходимости будут зачитаны данные из 64 битных структур
|
||
Value.Position := EndOfCentralDirectoryOffset;
|
||
LoadEndOfCentralDirectory;
|
||
|
||
// Теперь указатель стрима выставлен на начало структуры CentralDirectory
|
||
// Зачитываем ее саму
|
||
LoadCentralDirectoryFileHeader;
|
||
end;
|
||
|
||
//
|
||
// Процедура зачитывает строковое значение и переводит его в Ansi формат
|
||
// =============================================================================
|
||
procedure TFWZipReader.LoadStringValue(var Value: AnsiString; nSize: Cardinal);
|
||
begin
|
||
if Integer(nSize) > 0 then
|
||
begin
|
||
SetLength(Value, nSize);
|
||
|
||
if FZIPStream.Read(Value[1], nSize) <> Integer(nSize) then
|
||
raise EZipReaderRead.Create('Ошибка чтения коментария к архиву');
|
||
|
||
OemToAnsi(@Value[1], @Value[1]);
|
||
end;
|
||
end;
|
||
|
||
//
|
||
// Процедура проверяет валидность структуры Zip64EOFCentralDirectoryRecord
|
||
// Задача процедуру получить оффсет на CentralDirectory
|
||
// =============================================================================
|
||
procedure TFWZipReader.LoadZip64EOFCentralDirectoryRecord;
|
||
begin
|
||
FZIPStream.ReadBuffer(FZip64EOFCentralDirectoryRecord,
|
||
SizeOf(TZip64EOFCentralDirectoryRecord));
|
||
|
||
if not Zip64Present then
|
||
raise EZipReader.Create(
|
||
'Ошибка чтения структуры TZip64EOFCentralDirectoryRecord');
|
||
|
||
// Rouse_ 02.10.2012
|
||
// При чтении учитываем оффсет на начало архива StartZipDataOffset
|
||
FZIPStream.Position := FZip64EOFCentralDirectoryRecord.Offset +
|
||
StartZipDataOffset;
|
||
end;
|
||
|
||
//
|
||
// Процедура проверяет валидность структуры ZIP64Locator
|
||
// Задача процедуру получить оффсет на Zip64EOFCentralDirectoryRecord
|
||
// =============================================================================
|
||
procedure TFWZipReader.LoadZIP64Locator;
|
||
begin
|
||
FZIPStream.ReadBuffer(FZip64EOFCentralDirectoryLocator,
|
||
SizeOf(TZip64EOFCentralDirectoryLocator));
|
||
|
||
if FZip64EOFCentralDirectoryLocator.Signature <>
|
||
ZIP64_END_OF_CENTRAL_DIR_LOCATOR_SIGNATURE then
|
||
raise EZipReader.Create(
|
||
'Ошибка чтения структуры TZip64EOFCentralDirectoryLocator');
|
||
|
||
// Данная структура хранит оффсет на TZip64EOFCentralDirectoryRecord
|
||
// В котором и храниться расширенная информация
|
||
FZIPStream.Position := FZip64EOFCentralDirectoryLocator.RelativeOffset +
|
||
StartZipDataOffset;
|
||
LoadZip64EOFCentralDirectoryRecord;
|
||
end;
|
||
|
||
{ TFakeStream }
|
||
|
||
//
|
||
// TFakeStream предназначен для проверки архива на целостность
|
||
// =============================================================================
|
||
type
|
||
TFakeStream = class(TStream)
|
||
private
|
||
FSize: Int64;
|
||
FPosition: Int64;
|
||
protected
|
||
procedure SetSize(const NewSize: Int64); override;
|
||
public
|
||
function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
|
||
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
|
||
function Write(const Buffer; Count: Longint): Longint; override;
|
||
function Read(var Buffer; Count: Longint): Longint; override;
|
||
end;
|
||
|
||
function TFakeStream.Read(var Buffer; Count: Longint): Longint;
|
||
begin
|
||
raise Exception.Create('TFakeStream.Read');
|
||
end;
|
||
|
||
function TFakeStream.Write(const Buffer; Count: Longint): Longint;
|
||
begin
|
||
FSize := FSize + Count;
|
||
Result := Count;
|
||
end;
|
||
|
||
function TFakeStream.Seek(Offset: Longint; Origin: Word): Longint;
|
||
begin
|
||
Result := Seek(Int64(Offset), TSeekOrigin(Origin));
|
||
end;
|
||
|
||
function TFakeStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
|
||
begin
|
||
case Origin of
|
||
soBeginning: FPosition := Offset;
|
||
soCurrent: Inc(FPosition, Offset);
|
||
soEnd: FPosition := FSize + Offset;
|
||
end;
|
||
Result := FPosition;
|
||
end;
|
||
|
||
procedure TFakeStream.SetSize(const NewSize: Int64);
|
||
begin
|
||
FSize := NewSize;
|
||
end;
|
||
|
||
//
|
||
// Процедура производит распаковку или проверку архива с учетом маски файла в архиве
|
||
// При проверке архива данные распаковываются, но не сохраняются
|
||
// =============================================================================
|
||
procedure TFWZipReader.ProcessExtractOrCheckAllData(const ExtractMask: string;
|
||
Path: string; CheckMode: Boolean);
|
||
var
|
||
I, A: Integer;
|
||
OldExtractEvent: TZipExtractItemEvent;
|
||
OldDuplicateEvent: TZipDuplicateEvent;
|
||
CurrentItem: TFWZipReaderItem;
|
||
ExtractResult: TExtractResult;
|
||
CancelExtract, Handled: Boolean;
|
||
Password: string;
|
||
FreeAvailable, TotalSpace: TLargeInteger;
|
||
ExtractList: TList;
|
||
FakeStream: TFakeStream;
|
||
begin
|
||
FTotalSizeCount := 0;
|
||
FTotalProcessedCount := 0;
|
||
ExtractList := TList.Create;
|
||
try
|
||
// Производим поиск файлов для распаковки
|
||
for I := 0 to Count - 1 do
|
||
if ExtractMask = '' then
|
||
begin
|
||
ExtractList.Add(Pointer(I));
|
||
Inc(FTotalSizeCount, Item[I].UncompressedSize);
|
||
end
|
||
else
|
||
if MatchesMask(Item[I].FileName, ExtractMask) then
|
||
begin
|
||
ExtractList.Add(Pointer(I));
|
||
Inc(FTotalSizeCount, Item[I].UncompressedSize);
|
||
end;
|
||
|
||
if not CheckMode then
|
||
begin
|
||
// Правка пустого и относительного пути
|
||
Path := PathCanonicalize(Path);
|
||
if Path = '' then
|
||
Path := GetCurrentDirUTF8; { *Преобразовано из GetCurrentDir* }
|
||
|
||
// Проверка хватит ли места на диске?
|
||
if GetDiskFreeSpaceEx(PChar(Path), FreeAvailable, TotalSpace, nil) then
|
||
if FreeAvailable <= FTotalSizeCount then
|
||
raise EZipReader.CreateFmt('Недостаточно места на диске "%s".' + sLineBreak +
|
||
'Необходимо освободить %s.', [Path[1], FileSizeToStr(FTotalSizeCount)]);
|
||
end;
|
||
|
||
FakeStream := TFakeStream.Create;
|
||
try
|
||
for I := 0 to ExtractList.Count - 1 do
|
||
begin
|
||
FakeStream.Size := 0;
|
||
CurrentItem := Item[Integer(ExtractList[I])];
|
||
DoProgress(Self, CurrentItem.FileName, 0, CurrentItem.UncompressedSize, psStart);
|
||
OldExtractEvent := CurrentItem.OnProgress;
|
||
try
|
||
CurrentItem.OnProgress := DoProgress;
|
||
OldDuplicateEvent := CurrentItem.OnDuplicate;
|
||
try
|
||
CurrentItem.OnDuplicate := OnDuplicate;
|
||
// Пробуем извлечь файл
|
||
try
|
||
if CheckMode then
|
||
ExtractResult := CurrentItem.ExtractToStream(FakeStream, '')
|
||
else
|
||
ExtractResult := CurrentItem.Extract(Path, '');
|
||
if ExtractResult = erNeedPassword then
|
||
begin
|
||
// Если произошла обшибка из-за того что файл зашифрован,
|
||
// пробуем расшифровать его используя список известных паролей
|
||
for A := 0 to FPasswordList.Count - 1 do
|
||
begin
|
||
if CheckMode then
|
||
ExtractResult := CurrentItem.ExtractToStream(FakeStream, FPasswordList[A])
|
||
else
|
||
ExtractResult := CurrentItem.Extract(Path, FPasswordList[A]);
|
||
if ExtractResult in [erDone, erSkiped] then Break;
|
||
end;
|
||
// если не получилось, запрашиваем пароль у пользователя
|
||
if ExtractResult = erNeedPassword then
|
||
if Assigned(FOnNeedPwd) then
|
||
begin
|
||
CancelExtract := False;
|
||
while ExtractResult = erNeedPassword do
|
||
begin
|
||
Password := '';
|
||
FOnNeedPwd(Self, CurrentItem.FileName,
|
||
Password, CancelExtract);
|
||
if CancelExtract then Exit;
|
||
if Password <> '' then
|
||
begin
|
||
FPasswordList.Add(Password);
|
||
if CheckMode then
|
||
ExtractResult := CurrentItem.ExtractToStream(FakeStream, Password)
|
||
else
|
||
ExtractResult := CurrentItem.Extract(Path, Password);
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
raise EWrongPasswordException.CreateFmt(
|
||
'Ошибка извлечения данных элемента №%d "%s".' + sLineBreak +
|
||
'Неверный пароль.', [CurrentItem.ItemIndex, CurrentItem.FileName]);
|
||
end;
|
||
except
|
||
|
||
// Пользователь отменил распаковку архива
|
||
on E: EAbort do
|
||
Exit;
|
||
|
||
// Ну не прерывать же распаковку из-за исключения на одном файле?
|
||
// Пусть решение о прерывании распаковки принимают снаружи
|
||
on E: Exception do
|
||
begin
|
||
Handled := False;
|
||
if Assigned(FException) then
|
||
FException(Self, E, Integer(ExtractList[I]), Handled);
|
||
if not Handled then
|
||
// Rouse_ 20.02.2012
|
||
// Неверно перевозбуждено исключение
|
||
// Спасибо v1ctar за найденый глюк
|
||
//raise E;
|
||
raise;
|
||
end;
|
||
end;
|
||
Inc(FTotalProcessedCount, CurrentItem.UncompressedSize);
|
||
finally
|
||
CurrentItem.OnDuplicate := OldDuplicateEvent;
|
||
end;
|
||
finally
|
||
CurrentItem.OnProgress := OldExtractEvent;
|
||
DoProgress(Self, CurrentItem.FileName, 0,
|
||
CurrentItem.UncompressedSize, psEnd);
|
||
end;
|
||
end;
|
||
|
||
finally
|
||
FakeStream.Free;
|
||
end;
|
||
|
||
finally
|
||
ExtractList.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TFWZipReader.SetDefaultDuplicateAction(const Value: TDuplicateAction);
|
||
begin
|
||
if Value = daUseNewFilePath then
|
||
raise EZipReader.Create(
|
||
'Действие daUseNewFilePath можно назначать только в обработчике события OnDuplicate.');
|
||
FDefaultDuplicateAction := Value;
|
||
end;
|
||
|
||
//
|
||
// Функция возвращает размер центральной директории
|
||
// =============================================================================
|
||
function TFWZipReader.SizeOfCentralDirectory: Int64;
|
||
begin
|
||
if Zip64Present then
|
||
Result := FZip64EOFCentralDirectoryRecord.Size
|
||
else
|
||
Result := FEndOfCentralDir.SizeOfTheCentralDirectory;
|
||
end;
|
||
|
||
//
|
||
// Функция возвращает количество элементов архива
|
||
// =============================================================================
|
||
function TFWZipReader.TotalEntryesCount: Integer;
|
||
begin
|
||
if Zip64Present then
|
||
Result := FZip64EOFCentralDirectoryRecord.TotalNumber2
|
||
else
|
||
Result := FEndOfCentralDir.TotalNumberOfEntries;
|
||
end;
|
||
|
||
//
|
||
// Вспомогательная функция,
|
||
// указывает из какого блока данных брать валидное значение
|
||
// =============================================================================
|
||
function TFWZipReader.Zip64Present: Boolean;
|
||
begin
|
||
Result := FZip64EOFCentralDirectoryRecord.Zip64EndOfCentralDirSignature =
|
||
ZIP64_END_OF_CENTRAL_DIR_SIGNATURE
|
||
end;
|
||
|
||
end.
|