350 lines
13 KiB
Plaintext
350 lines
13 KiB
Plaintext
|
unit JclZLib;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
JclZLibStreamDefaultBufferSize = 32 * 1024;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
{$IFDEF MSWINDOWS}
|
|||
|
|
JclZLibDefaultLineSeparator = #$0D#$0A;
|
|||
|
|
{$ENDIF MSWINDOWS}
|
|||
|
|
{$IFDEF UNIX}
|
|||
|
|
JclZLibDefaultLineSeparator = #$0A;
|
|||
|
|
{$ENDIF UNIX}
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
WindowsPathDelimiter = '\';
|
|||
|
|
UnixPathDelimiter = '/';
|
|||
|
|
{$IFNDEF RTL140_UP}
|
|||
|
|
{$IFDEF MSWINDOWS}
|
|||
|
|
PathDelim = WindowsPathDelimiter;
|
|||
|
|
{$ENDIF MSWINDOWS}
|
|||
|
|
{$IFDEF UNIX}
|
|||
|
|
PathDelim = UnixPathDelimiter;
|
|||
|
|
{$ENDIF UNIX}
|
|||
|
|
{$ENDIF ~RTL140_UP}
|
|||
|
|
|
|||
|
|
//--------------------------------------------------------------------------------------------------
|
|||
|
|
// zlib format support
|
|||
|
|
//--------------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TJclZLibStream = class(TStream)
|
|||
|
|
protected
|
|||
|
|
FStream: TStream;
|
|||
|
|
FBufferSize: Integer;
|
|||
|
|
FBuffer: Pointer;
|
|||
|
|
FZLibStream: TZStreamRec;
|
|||
|
|
procedure SetSize(NewSize: Longint); override;
|
|||
|
|
public
|
|||
|
|
constructor Create(const Stream: TStream; const BufferSize: Integer);
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
function Seek(Offset: Longint; Origin: Word): Longint; override;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TJclZLibReader = class(TJclZLibStream)
|
|||
|
|
protected
|
|||
|
|
FEndOfStream: Boolean;
|
|||
|
|
procedure ReadNextBlock;
|
|||
|
|
procedure FinishZLibStream;
|
|||
|
|
public
|
|||
|
|
constructor Create(const Stream: TStream;
|
|||
|
|
const BufferSize: Integer = JclZLibStreamDefaultBufferSize;
|
|||
|
|
const WindowBits: Integer = DEF_WBITS);
|
|||
|
|
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
|
|||
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|||
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|||
|
|
function Seek(Offset: Longint; Origin: Word): Longint; override;
|
|||
|
|
|
|||
|
|
procedure Reset;
|
|||
|
|
procedure SyncZLibStream;
|
|||
|
|
|
|||
|
|
property EndOfStream: Boolean read FEndOfStream;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TJclZLibWriter = class(TJclZLibStream)
|
|||
|
|
protected
|
|||
|
|
procedure WriteNextBlock;
|
|||
|
|
procedure FlushZLibStream(const Flush: Integer);
|
|||
|
|
public
|
|||
|
|
constructor Create(const Stream: TStream;
|
|||
|
|
const BufferSize: Integer = JclZLibStreamDefaultBufferSize;
|
|||
|
|
const Level: Integer = Z_DEFAULT_COMPRESSION;
|
|||
|
|
const Strategy: Integer = Z_DEFAULT_STRATEGY;
|
|||
|
|
const WindowBits: Integer = DEF_WBITS);
|
|||
|
|
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
|
|||
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|||
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|||
|
|
function Seek(Offset: Longint; Origin: Word): Longint; override;
|
|||
|
|
|
|||
|
|
procedure Reset;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
EJclZLibError = class(EJclError);
|
|||
|
|
|
|||
|
|
// zlib error texts
|
|||
|
|
function GetZLibErrorText(const ErrorCode: Integer): PResStringRec;
|
|||
|
|
|
|||
|
|
function ZLibCompressMem(const Src: Pointer; SrcLen: Integer;
|
|||
|
|
out Dst: Pointer; out DstLen: Integer; out DstCapacity: Integer;
|
|||
|
|
const Level: Integer = Z_DEFAULT_COMPRESSION): Boolean;
|
|||
|
|
|
|||
|
|
// Flush:
|
|||
|
|
// Z_SYNC_FLUSH: DstCapacity can be 0
|
|||
|
|
// Z_FINISH: decompress with faster routine in a single step
|
|||
|
|
// DstCapacity must be >= uncompressed size
|
|||
|
|
function ZLibDecompressMem(const Src: Pointer; SrcLen: Integer;
|
|||
|
|
out Dst: Pointer; out DstLen: Integer; var DstCapacity: Integer;
|
|||
|
|
const Flush: Integer = Z_SYNC_FLUSH): Boolean;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TJclGZipStream = class(TStream)
|
|||
|
|
protected
|
|||
|
|
FStream: TStream;
|
|||
|
|
FCRC32: LongWord;
|
|||
|
|
FUncompressedSize: LongWord;
|
|||
|
|
procedure SetSize(NewSize: Longint); override;
|
|||
|
|
public
|
|||
|
|
constructor Create(const Stream: TStream);
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
function Seek(Offset: Longint; Origin: Word): Longint; override;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TJclGZipReader = class(TJclGZipStream)
|
|||
|
|
private
|
|||
|
|
FZLibReader: TJclZLibReader;
|
|||
|
|
FTextMode: Boolean;
|
|||
|
|
FFilename: string;
|
|||
|
|
FComment: string;
|
|||
|
|
FTimeStamp: TJclUnixTime32;
|
|||
|
|
FLevel: Integer;
|
|||
|
|
FOperatingSystem: Byte;
|
|||
|
|
FMultipartNumber: Word;
|
|||
|
|
FExtraField: Pointer;
|
|||
|
|
FExtraFieldSize: Integer;
|
|||
|
|
FEndOfStream: Boolean;
|
|||
|
|
public
|
|||
|
|
constructor Create(const Stream: TStream;
|
|||
|
|
const BufferSize: Integer = JclZLibStreamDefaultBufferSize;
|
|||
|
|
const LineSeparator: string = JclZLibDefaultLineSeparator);
|
|||
|
|
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
|
|||
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|||
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|||
|
|
|
|||
|
|
property TextMode: Boolean read FTextMode;
|
|||
|
|
property Filename: string read FFilename;
|
|||
|
|
property Comment: string read FComment;
|
|||
|
|
property TimeStamp: TJclUnixTime32 read FTimeStamp;
|
|||
|
|
property Level: Integer read FLevel;
|
|||
|
|
property OperatingSystem: Byte read FOperatingSystem;
|
|||
|
|
property MultipartNumber: Word read FMultipartNumber; // 0 = first part
|
|||
|
|
property ExtraField: Pointer read FExtraField;
|
|||
|
|
property ExtraFieldSize: Integer read FExtraFieldSize;
|
|||
|
|
|
|||
|
|
property EndOfStream: Boolean read FEndOfStream;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TJclGZipWriter = class(TJclGZipStream)
|
|||
|
|
private
|
|||
|
|
FTextMode: Boolean;
|
|||
|
|
FZLibWriter: TJclZLibWriter;
|
|||
|
|
public
|
|||
|
|
constructor Create(const Stream: TStream;
|
|||
|
|
const BufferSize: Integer = JclZLibStreamDefaultBufferSize;
|
|||
|
|
const Level: Integer = Z_DEFAULT_COMPRESSION;
|
|||
|
|
const Strategie: Integer = Z_DEFAULT_STRATEGY;
|
|||
|
|
const Filename: string = '';
|
|||
|
|
const TimeStamp: TJclUnixTime32 = 0;
|
|||
|
|
const Comment: string = '';
|
|||
|
|
const TextMode: Boolean = False;
|
|||
|
|
const ExtraField: Pointer = nil;
|
|||
|
|
const ExtraFieldSize: Integer = 0);
|
|||
|
|
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
|
|||
|
|
function Read(var Buffer; Count: Longint): Longint; override;
|
|||
|
|
function Write(const Buffer; Count: Longint): Longint; override;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
EJclGZipError = class(EJclError);
|
|||
|
|
|
|||
|
|
// gzip file extension
|
|||
|
|
const
|
|||
|
|
JclGZipDefaultFileExtension = '.gz';
|
|||
|
|
|
|||
|
|
// if DstFilename = '' -> DstFilename := SrcFilename + JclGZipDefaultFileExtension
|
|||
|
|
procedure GZipCompressFile(const SrcFilename: string; DstFilename: string;
|
|||
|
|
const Level: Integer = Z_DEFAULT_COMPRESSION);
|
|||
|
|
procedure GZipDecompressFile(const SrcFilename: string; DstFilename: string);
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
TarBlockSize = 512;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TTarArchiveFormat = (
|
|||
|
|
tafDefaultFormat, // format to be decided later
|
|||
|
|
tafV7Format, // old V7 tar format
|
|||
|
|
tafOldGnuFormat, // GNU format as per before tar 1.12
|
|||
|
|
tafPosixFormat, // restricted, pure POSIX format
|
|||
|
|
tafGnuFormat); // POSIX format with GNU extensions
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
PSparse = ^TSparse;
|
|||
|
|
TSparse = packed record // offset
|
|||
|
|
Offset: array [0..11] of AnsiChar; // $00
|
|||
|
|
NumBytes: array [0..11] of AnsiChar; // $0C
|
|||
|
|
end; // $18
|
|||
|
|
|
|||
|
|
PTarHeader = ^TTarHeader;
|
|||
|
|
TTarHeader = packed record // offset
|
|||
|
|
case Integer of
|
|||
|
|
0: (Buffer: array [0..TarBlockSize - 1] of Byte);
|
|||
|
|
1: (
|
|||
|
|
// Old UNIX TAR format
|
|||
|
|
Name: array [0..99] of AnsiChar; // $000 Char + #0 / mit 0 gef<65>llt
|
|||
|
|
Mode: array [0..7] of AnsiChar; // $064 Octal + ' '#0 9 + 3 bits 20 34 30 37 35 35 20 00
|
|||
|
|
UID: array [0..7] of AnsiChar; // $06C Octal + ' '#0 ignore on DOS 20 20 31 37 35 36 20 00
|
|||
|
|
GID: array [0..7] of AnsiChar; // $074 Octal + ' '#0 ignore on DOS 20 20 20 31 34 34 20 00
|
|||
|
|
Size: array [0..11] of AnsiChar; // $07C Octal + ' ' size in bytes 20 20 20 20 20 20 20 20 20 20 30 20
|
|||
|
|
MTime: array [0..11] of AnsiChar; // $088 Octal + ' ' last modify Unix 20 36 37 32 32 34 34 36 31 30 37 20
|
|||
|
|
Chksum: array [0..7] of AnsiChar; // $094 Octal + ' '#0 >= 17 bit, init 0, add 20 20 37 35 37 32 00 20
|
|||
|
|
TypeFlag: AnsiChar; // $09C Octal + ' '#0 ?? 35
|
|||
|
|
Linkname: array [0..99] of AnsiChar; // $09D Char + #0
|
|||
|
|
// Extension of POSIX P1003.1
|
|||
|
|
Magic: array [0..5] of AnsiChar; // $101 Char + #0 75 73 74 61 72 20
|
|||
|
|
Version: array [0..1] of AnsiChar; // $107 Octal + ' ' 20 00
|
|||
|
|
UName: array [0..31] of AnsiChar; // $109 Char + #0 72 63 64 00 ...
|
|||
|
|
GName: array [0..31] of AnsiChar; // $129 Char + #0 75 73 65 72 73 00 ...
|
|||
|
|
DevMajor: array [0..7] of AnsiChar; // $149 Octal + ' '#0
|
|||
|
|
DevMinor: array [0..7] of AnsiChar; // $151 Octal + ' '#0
|
|||
|
|
case TTarArchiveFormat of
|
|||
|
|
tafV7Format: (
|
|||
|
|
FillV7: array [0..166] of AnsiChar); // $159
|
|||
|
|
tafPosixFormat: (
|
|||
|
|
Prefix: array [0..154] of AnsiChar; // $159 Prefix for name
|
|||
|
|
FillPosix: array [0..11] of AnsiChar); // $1F4
|
|||
|
|
tafOldGnuFormat: (
|
|||
|
|
ATime: array [0..11] of AnsiChar; // $159
|
|||
|
|
CTime: array [0..11] of AnsiChar; // $165
|
|||
|
|
Offset: array [0..11] of AnsiChar; // $171
|
|||
|
|
Longnames: array [0..3] of AnsiChar; // $17D
|
|||
|
|
Pad: AnsiChar; // $181
|
|||
|
|
Sparses: array [0..3] of TSparse; // $182
|
|||
|
|
IsExtended: AnsiChar; // $1E2
|
|||
|
|
RealSize: array [0..11] of AnsiChar; // $1E3
|
|||
|
|
FillGnu: array [0..16] of AnsiChar)); // $1EF
|
|||
|
|
end; // $200
|
|||
|
|
|
|||
|
|
// ModeFlag Flags
|
|||
|
|
type
|
|||
|
|
TTarMode = (
|
|||
|
|
tmOtherExec, // execute/search by other
|
|||
|
|
tmOtherWrite, // write by other
|
|||
|
|
tmOtherRead, // read by other
|
|||
|
|
tmGroupExec, // execute/search by group
|
|||
|
|
tmGroupWrite, // write by group
|
|||
|
|
tmGroupRead, // read by group
|
|||
|
|
tmOwnerExec, // execute/search by owner
|
|||
|
|
tmOwnerWrite, // write by owner
|
|||
|
|
tmOwnerRead, // read by owner
|
|||
|
|
tmSaveText, // reserved
|
|||
|
|
tmSetGID, // set GID on execution
|
|||
|
|
tmSetUID); // set UID on execution
|
|||
|
|
TTarModes = set of TTarMode;
|
|||
|
|
|
|||
|
|
// TypeFlag
|
|||
|
|
type
|
|||
|
|
TTarTypeFlag = AnsiChar;
|
|||
|
|
|
|||
|
|
const // V7 Posix
|
|||
|
|
ttfRegFile = '0'; // regular file x x
|
|||
|
|
ttfARegFile = #0; // regular file x x
|
|||
|
|
ttfLink = '1'; // link x x
|
|||
|
|
ttfSymbolicLink = '2'; // symbolic link x
|
|||
|
|
ttfCharacter = '3'; // character special x
|
|||
|
|
ttfBlock = '4'; // block special x
|
|||
|
|
ttfDirectory = '5'; // directory x
|
|||
|
|
ttfFIFO = '6'; // FIFO special x
|
|||
|
|
ttfContiguous = '7'; // contiguous file
|
|||
|
|
|
|||
|
|
// GNU extensions
|
|||
|
|
ttfGnuDumpDir = 'D';
|
|||
|
|
ttfGnuLongLink = 'K'; // next file have a long link name
|
|||
|
|
ttfGnuLongName = 'L'; // next file have a long name
|
|||
|
|
ttfGnuMultiVol = 'M'; // file began on another volume
|
|||
|
|
ttfGnuNames = 'N'; // long filename
|
|||
|
|
ttfGnuSparse = 'S'; // sparse files
|
|||
|
|
ttfGnuVolHeader = 'V'; // Volume label (must be the first file)
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
TarOldGnuMagic = 'ustar '#0; // old GNU Magic + Version
|
|||
|
|
TarPosixMagic = 'ustar'#0; // Posix or GNU
|
|||
|
|
TarGnuVersion = '00';
|
|||
|
|
|
|||
|
|
// other version for GNU-Magic: 'GNUtar '#0
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TJclTarFileType = (tftUnknown, tftEof, tftFile, tftDirectory);
|
|||
|
|
|
|||
|
|
TJclTarFileSize = Int64;
|
|||
|
|
|
|||
|
|
|
|||
|
|
TJclTarReader = class(TObject)
|
|||
|
|
private
|
|||
|
|
function GetFileDateTime: TDateTime;
|
|||
|
|
protected
|
|||
|
|
FTarStream: TStream;
|
|||
|
|
FHeader: TTarHeader;
|
|||
|
|
FArchiveFormat: TTarArchiveFormat;
|
|||
|
|
FFileType: TJclTarFileType;
|
|||
|
|
FFilename: string;
|
|||
|
|
FFileSize: TJclTarFileSize;
|
|||
|
|
FFileTime: TJclUnixTime32;
|
|||
|
|
function ReadHeader: Boolean; // False if Eof
|
|||
|
|
procedure ScanHeader;
|
|||
|
|
public
|
|||
|
|
constructor Create(const TarStream: TStream);
|
|||
|
|
procedure CopyToStream(const FileStream: TStream; CanSeek: Boolean = False);
|
|||
|
|
procedure CopyToFile(const FilePath: string);
|
|||
|
|
procedure SkipFile;
|
|||
|
|
procedure SkipFileSeek;
|
|||
|
|
property FileType: TJclTarFileType read FFileType;
|
|||
|
|
property Filename: string read FFilename;
|
|||
|
|
property FileSize: TJclTarFileSize read FFileSize;
|
|||
|
|
property FileTime: TJclUnixTime32 read FFileTime;
|
|||
|
|
property FileDateTime: TDateTime read GetFileDateTime;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TJclTarWriter = class(TObject)
|
|||
|
|
protected
|
|||
|
|
FTarStream: TStream;
|
|||
|
|
procedure AddEof;
|
|||
|
|
public
|
|||
|
|
constructor Create(const TarStream: TStream);
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
procedure AddFile(FileRoot, Filename: string);
|
|||
|
|
procedure AddStream(const Stream: TStream; Filename: string;
|
|||
|
|
FileSize: TJclTarFileSize; FileTime: TJclUnixTime32);
|
|||
|
|
procedure AddDirectory(DirName: string);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
EJclTarError = class(EJclError);
|
|||
|
|
|
|||
|
|
procedure TarAllFiles(const TarFilename, FileRoot: string);
|
|||
|
|
procedure TarFileList(const TarFilename, FileRoot: string; List: TStrings);
|
|||
|
|
procedure TarFileArray(const TarFilename, FileRoot: string; const Filenames: array of string);
|
|||
|
|
procedure TarGZipAllFiles(const TgzFilename, FileRoot: string);
|
|||
|
|
procedure TarGZipFileList(const TgzFilename, FileRoot: string; List: TStrings);
|
|||
|
|
procedure TarGZipFileArray(const TgzFilename, FileRoot: string; const Filenames: array of string);
|
|||
|
|
|
|||
|
|
procedure UnTarAllFiles(const TarFilename: string; DstDir: string);
|
|||
|
|
procedure UnGZipTarAllFiles(const TgzFilename: string; DstDir: string);
|
|||
|
|
|
|||
|
|
procedure GetFileList(RootDir: string; List: TStrings);
|
|||
|
|
|