//////////////////////////////////////////////////////////////////////////////// // // **************************************************************************** // * Project : FWZip // * Unit Name : FWZipStream // * Purpose : Вспомогательные стримы для поддержки шифрования на лету, // * : и усеченного заголовка ZLib // * 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/ // // // Описание идеи модуля: // При помещении в архив сжатого блока данных методом Deflate у него // отрезается двухбайтный заголовок в котором указаны параметры сжатия. // Т.е. в архив помещаются сами данные в чистом виде. // Для распаковки необходимо данный заголовок восстановить. // Данный класс позволяет добавить данный заголовок "на лету" // абсолютно прозрачно для внешнего кода. // Сам заголовок генерируется в конструкторе и подставляется в методе Read. // Так-же класс, выступая посредником между двумя стримами, // позволяет производить шифрование и дешифровку передаваемых данных. // Шифрование производится в методе Write, в этот момент класс является // посредником между TCompressionStream и результирующим стримом. // Дешифрование осуществляется в методе Read, в этот момент класс является // посредником между стримом со сжатыми и // пошифрованными данными и TDecompressionStream. // unit FWZipStream; {$mode delphi} {$codepage UTF8} interface {$I fwzip.inc} uses Classes, FWZipConsts, FWZipCrypt, FWZipCrc32, FWZipZLib; type TFWZipItemStream = class(TStream) private FOwner: TStream; FCryptor: TFWZipCryptor; FDecryptor: TFWZipDecryptor; FSize, FStart, FPosition: Int64; {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER} FHeader: Word; {$ENDIF} protected function GetSize: Int64; override; public constructor Create(AOwner: TStream; Cryptor: TFWZipCryptor; Decryptor: TFWZipDecryptor; CompressLevel: Byte; ASize: Int64); function Seek(Offset: Longint; Origin: Word): Longint; overload; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override; function Read(var Buffer; Count: Longint): Longint; override; function Write(const Buffer; Count: Longint): Longint; override; end; implementation { TFWZipItemStream } constructor TFWZipItemStream.Create(AOwner: TStream; Cryptor: TFWZipCryptor; Decryptor: TFWZipDecryptor; CompressLevel: Byte; ASize: Int64); begin inherited Create; FOwner := AOwner; FCryptor := Cryptor; FDecryptor := Decryptor; FSize := ASize; FStart := AOwner.Position; FPosition := 0; // Rouse_ 30.10.2013 // Устаревший код {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER} // Rouse_ 17.03.2011 // Размерчик все-же нужно править увеличикая на размер заголовка Inc(FSize, 2); // Восстанавливаем пропущенный заголовок ZLib стрима // см. deflate.c - int ZEXPORT deflate (strm, flush) // uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8; FHeader := (Z_DEFLATED + (7 {32k Window size} shl 4)) shl 8; // if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2) // level_flags = 0; // else if (s->level < 6) // level_flags = 1; // else if (s->level == 6) // level_flags = 2; // else // level_flags = 3; // // сам CompressLevel (level_flags) // берется из уже заполненного GeneralPurposeBitFlag // здесь мы из битовой маски восстанавливаем оригинальные значения case CompressLevel of PBF_COMPRESS_SUPERFAST: CompressLevel := 0; PBF_COMPRESS_FAST: CompressLevel := 1; PBF_COMPRESS_NORMAL: CompressLevel := 2; PBF_COMPRESS_MAXIMUM: CompressLevel := 3; end; // header |= (level_flags << 6); FHeader := FHeader or (CompressLevel shl 6); // if (s->strstart != 0) header |= PRESET_DICT; // словарь не используется - оставляем без изменений // header += 31 - (header % 31); Inc(FHeader, 31 - (FHeader mod 31)); // putShortMSB(s, header); FHeader := (FHeader shr 8) + (FHeader and $FF) shl 8; {$ENDIF} end; function TFWZipItemStream.GetSize: Int64; begin Result := FSize; end; function TFWZipItemStream.Read(var Buffer; Count: Integer): Longint; var P: PByte; DecryptBuff: Pointer; begin // Rouse_ 30.10.2013 // Устаревший код {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER} if FPosition = 0 then begin // если зачитываются данные с самого начала // необходимо перед ними разместить заголовок ZLib P := @FHeader; Move(P^, Buffer, 2); FOwner.Position := FStart; P := @Buffer; Inc(P, 2); if Count > Size then Count := Size; FOwner.Position := FStart; if FDecryptor <> nil then begin // в случае если файл зашифрован, производим расшифровку блока GetMem(DecryptBuff, Count - 2); try Result := FOwner.Read(DecryptBuff^, Count - 2); FDecryptor.DecryptBuffer(DecryptBuff, Result); Move(DecryptBuff^, P^, Result); finally FreeMem(DecryptBuff); end; end else Result := FOwner.Read(P^, Count - 2); Inc(Result, 2); Inc(FPosition, Result); end else begin FOwner.Position := FStart + Position - 2; {$ELSE} begin FOwner.Position := FStart + Position; {$ENDIF} if Count > Size - Position then Count := Size - Position; if FDecryptor <> nil then begin // в случае если файл зашифрован, производим расшифровку блока GetMem(DecryptBuff, Count); try Result := FOwner.Read(DecryptBuff^, Count); FDecryptor.DecryptBuffer(DecryptBuff, Result); P := @Buffer; Move(DecryptBuff^, P^, Result); finally FreeMem(DecryptBuff); end; end else Result := FOwner.Read(Buffer, Count); Inc(FPosition, Result); end; end; function TFWZipItemStream.Seek(Offset: Integer; Origin: Word): Longint; begin Result := Seek(Int64(Offset), TSeekOrigin(Origin)); end; function TFWZipItemStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin case Origin of soBeginning: FPosition := Offset; soCurrent: Inc(FPosition, Offset); soEnd: FPosition := Size + Offset; end; Result := FPosition; end; function TFWZipItemStream.Write(const Buffer; Count: Integer): Longint; var EncryptBuffer: PByte; begin if FCryptor = nil then Result := FOwner.Write(Buffer, Count) else begin // криптуем буфер GetMem(EncryptBuffer, Count); try Move(Buffer, EncryptBuffer^, Count); // Rouse_ 31.10.2013 // Устаревший код {$IFDEF USE_AUTOGENERATED_ZLIB_HEADER} // Шифровать блок нужно пропустив двубайтный заголовок ZLib if FPosition = 0 then begin Inc(EncryptBuffer, 2); FCryptor.EncryptBuffer(EncryptBuffer, Count - 2); Dec(EncryptBuffer, 2); end else {$ENDIF} FCryptor.EncryptBuffer(EncryptBuffer, Count); Result := FOwner.Write(EncryptBuffer^, Count); finally FreeMem(EncryptBuffer); end; end; Inc(FPosition, Result); end; end.