9e216da9ef
After go1.16, go will use module mode by default, even when the repository is checked out under GOPATH or in a one-off directory. Add go.mod, go.sum to keep this repo buildable without opting out of the module mode. > go mod init github.com/mmcgrana/gobyexample > go mod tidy > go mod vendor In module mode, the 'vendor' directory is special and its contents will be actively maintained by the go command. pygments aren't the dependency the go will know about, so it will delete the contents from vendor directory. Move it to `third_party` directory now. And, vendor the blackfriday package. Note: the tutorial contents are not affected by the change in go1.16 because all the examples in this tutorial ask users to run the go command with the explicit list of files to be compiled (e.g. `go run hello-world.go` or `go build command-line-arguments.go`). When the source list is provided, the go command does not have to compute the build list and whether it's running in GOPATH mode or module mode becomes irrelevant.
744 lines
21 KiB
ObjectPascal
744 lines
21 KiB
ObjectPascal
//
|
|
// Sourcecode from http://www.delphi-library.de/topic_47880.html
|
|
//
|
|
uses Windows, Messages;
|
|
|
|
const
|
|
FFM_INIT = WM_USER + 1976;
|
|
FFM_ONFILEFOUND = WM_USER + 1974; // wParam: not used, lParam: Filename
|
|
FFM_ONDIRFOUND = WM_USER + 1975; // wParam: NumFolder, lParam: Directory
|
|
var
|
|
CntFolders : Cardinal = 0;
|
|
NumFolder : Cardinal = 0;
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
//
|
|
// FindAllFilesInit
|
|
//
|
|
//
|
|
procedure FindAllFilesInit; external;
|
|
label foo;
|
|
begin
|
|
CntFolders := 0;
|
|
NumFolder := 0;
|
|
foo:
|
|
Blub;
|
|
goto foo;
|
|
end;
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
//
|
|
// CountFolders
|
|
//
|
|
//
|
|
procedure CountFolders(Handle: THandle; RootFolder: string; Recurse: Boolean = True);
|
|
var
|
|
hFindFile : THandle;
|
|
wfd : TWin32FindData;
|
|
begin
|
|
SendMessage(Handle, FFM_INIT, 0, 0);
|
|
if RootFolder[length(RootFolder)] <> '\' then
|
|
RootFolder := RootFolder + '\';
|
|
ZeroMemory(@wfd, sizeof(wfd));
|
|
wfd.dwFileAttributes := FILE_ATTRIBUTE_NORMAL;
|
|
if Recurse then
|
|
begin
|
|
hFindFile := FindFirstFile(pointer(RootFolder + '*.*'), wfd);
|
|
if hFindFile <> 0 then
|
|
try
|
|
repeat
|
|
if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then
|
|
begin
|
|
if (string(wfd.cFileName) <> '.') and (string(wfd.cFileName) <> '..') then
|
|
begin
|
|
CountFolders(Handle, RootFolder + wfd.cFileName, Recurse);
|
|
end;
|
|
end;
|
|
until FindNextFile(hFindFile, wfd) = False;
|
|
Inc(CntFolders);
|
|
finally
|
|
Windows.FindClose(hFindFile);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
////////////////////////////////////////////////////////////////////////////////
|
|
//
|
|
// FindAllFiles
|
|
//
|
|
procedure FindAllFiles(Handle: THandle; RootFolder: string; Mask: string; Recurse: Boolean = True);
|
|
var
|
|
hFindFile : THandle;
|
|
wfd : TWin32FindData;
|
|
begin
|
|
if RootFolder[length(RootFolder)] <> '\' then
|
|
RootFolder := RootFolder + '\';
|
|
ZeroMemory(@wfd, sizeof(wfd));
|
|
wfd.dwFileAttributes := FILE_ATTRIBUTE_NORMAL;
|
|
if Recurse then
|
|
begin
|
|
hFindFile := FindFirstFile(pointer(RootFolder + '*.*'), wfd);
|
|
if hFindFile <> 0 then
|
|
try
|
|
repeat
|
|
if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then
|
|
begin
|
|
if (string(wfd.cFileName) <> '.') and (string(wfd.cFileName) <> '..') then
|
|
begin
|
|
FindAllFiles(Handle, RootFolder + wfd.cFileName, Mask, Recurse);
|
|
end;
|
|
end;
|
|
until FindNextFile(hFindFile, wfd) = False;
|
|
Inc(NumFolder);
|
|
SendMessage(Handle, FFM_ONDIRFOUND, NumFolder, lParam(string(RootFolder)));
|
|
finally
|
|
Windows.FindClose(hFindFile);
|
|
end;
|
|
end;
|
|
hFindFile := FindFirstFile(pointer(RootFolder + Mask), wfd);
|
|
if hFindFile <> INVALID_HANDLE_VALUE then
|
|
try
|
|
repeat
|
|
if (wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> FILE_ATTRIBUTE_DIRECTORY) then
|
|
begin
|
|
SendMessage(Handle, FFM_ONFILEFOUND, 0, lParam(string(RootFolder + wfd.cFileName)));
|
|
end;
|
|
until FindNextFile(hFindFile, wfd) = False;
|
|
finally
|
|
Windows.FindClose(hFindFile);
|
|
end;
|
|
end;
|
|
|
|
|
|
property test: boolean read ftest write ftest;
|
|
procedure test: boolean read ftest write ftest;
|
|
|
|
//
|
|
// This sourcecode is part of omorphia
|
|
//
|
|
|
|
Function IsValidHandle(Const Handle: THandle): Boolean; {$IFDEF OMORPHIA_FEATURES_USEASM} Assembler;
|
|
Asm
|
|
TEST EAX, EAX
|
|
JZ @@Finish
|
|
NOT EAX
|
|
TEST EAX, EAX
|
|
SETNZ AL
|
|
|
|
{$IFDEF WINDOWS}
|
|
JZ @@Finish
|
|
|
|
//Save the handle against modifications or loss
|
|
PUSH EAX
|
|
|
|
//reserve some space for a later duplicate
|
|
PUSH EAX
|
|
|
|
//Check if we are working on NT-Platform
|
|
CALL IsWindowsNTSystem
|
|
TEST EAX, EAX
|
|
JZ @@NoNTSystem
|
|
|
|
PUSH DWORD PTR [ESP]
|
|
LEA EAX, DWORD PTR [ESP+$04]
|
|
PUSH EAX
|
|
CALL GetHandleInformation
|
|
TEST EAX, EAX
|
|
JNZ @@Finish2
|
|
|
|
@@NoNTSystem:
|
|
//Result := DuplicateHandle(GetCurrentProcess, Handle, GetCurrentProcess,
|
|
// @Duplicate, 0, False, DUPLICATE_SAME_ACCESS);
|
|
PUSH DUPLICATE_SAME_ACCESS
|
|
PUSH $00000000
|
|
PUSH $00000000
|
|
LEA EAX, DWORD PTR [ESP+$0C]
|
|
PUSH EAX
|
|
CALL GetCurrentProcess
|
|
PUSH EAX
|
|
PUSH DWORD PTR [ESP+$18]
|
|
PUSH EAX
|
|
CALL DuplicateHandle
|
|
|
|
TEST EAX, EAX
|
|
JZ @@Finish2
|
|
|
|
// Result := CloseHandle(Duplicate);
|
|
PUSH DWORD PTR [ESP]
|
|
CALL CloseHandle
|
|
|
|
@@Finish2:
|
|
POP EDX
|
|
POP EDX
|
|
|
|
PUSH EAX
|
|
PUSH $00000000
|
|
CALL SetLastError
|
|
POP EAX
|
|
{$ENDIF}
|
|
|
|
@@Finish:
|
|
End;
|
|
{$ELSE}
|
|
Var
|
|
Duplicate: THandle;
|
|
Flags: DWORD;
|
|
Begin
|
|
If IsWinNT Then
|
|
Result := GetHandleInformation(Handle, Flags)
|
|
Else
|
|
Result := False;
|
|
If Not Result Then
|
|
Begin
|
|
// DuplicateHandle is used as an additional check for those object types not
|
|
// supported by GetHandleInformation (e.g. according to the documentation,
|
|
// GetHandleInformation doesn't support window stations and desktop although
|
|
// tests show that it does). GetHandleInformation is tried first because its
|
|
// much faster. Additionally GetHandleInformation is only supported on NT...
|
|
Result := DuplicateHandle(GetCurrentProcess, Handle, GetCurrentProcess,
|
|
@Duplicate, 0, False, DUPLICATE_SAME_ACCESS);
|
|
If Result Then
|
|
Result := CloseHandle(Duplicate);
|
|
End;
|
|
End;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
|
|
{*******************************************************}
|
|
{ }
|
|
{ Delphi Supplemental Components }
|
|
{ ZLIB Data Compression Interface Unit }
|
|
{ }
|
|
{ Copyright (c) 1997 Borland International }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
{ Modified for zlib 1.1.3 by Davide Moretti <dave@rimini.com }
|
|
|
|
unit zlib;
|
|
|
|
interface
|
|
|
|
uses Sysutils, Classes;
|
|
|
|
type
|
|
TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
|
|
TFree = procedure (AppData, Block: Pointer);
|
|
|
|
// Internal structure. Ignore.
|
|
TZStreamRec = packed record
|
|
next_in: PChar; // next input byte
|
|
avail_in: Integer; // number of bytes available at next_in
|
|
total_in: Integer; // total nb of input bytes read so far
|
|
|
|
next_out: PChar; // next output byte should be put here
|
|
avail_out: Integer; // remaining free space at next_out
|
|
total_out: Integer; // total nb of bytes output so far
|
|
|
|
msg: PChar; // last error message, NULL if no error
|
|
internal: Pointer; // not visible by applications
|
|
|
|
zalloc: TAlloc; // used to allocate the internal state
|
|
zfree: TFree; // used to free the internal state
|
|
AppData: Pointer; // private data object passed to zalloc and zfree
|
|
|
|
data_type: Integer; // best guess about the data type: ascii or binary
|
|
adler: Integer; // adler32 value of the uncompressed data
|
|
reserved: Integer; // reserved for future use
|
|
end;
|
|
|
|
// Abstract ancestor class
|
|
TCustomZlibStream = class(TStream)
|
|
private
|
|
FStrm: TStream;
|
|
FStrmPos: Integer;
|
|
FOnProgress: TNotifyEvent;
|
|
FZRec: TZStreamRec;
|
|
FBuffer: array [Word] of Char;
|
|
protected
|
|
procedure Progress(Sender: TObject); dynamic;
|
|
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
|
|
constructor Create(Strm: TStream);
|
|
end;
|
|
|
|
{ TCompressionStream compresses data on the fly as data is written to it, and
|
|
stores the compressed data to another stream.
|
|
|
|
TCompressionStream is write-only and strictly sequential. Reading from the
|
|
stream will raise an exception. Using Seek to move the stream pointer
|
|
will raise an exception.
|
|
|
|
Output data is cached internally, written to the output stream only when
|
|
the internal output buffer is full. All pending output data is flushed
|
|
when the stream is destroyed.
|
|
|
|
The Position property returns the number of uncompressed bytes of
|
|
data that have been written to the stream so far.
|
|
|
|
CompressionRate returns the on-the-fly percentage by which the original
|
|
data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100
|
|
If raw data size = 100 and compressed data size = 25, the CompressionRate
|
|
is 75%
|
|
|
|
The OnProgress event is called each time the output buffer is filled and
|
|
written to the output stream. This is useful for updating a progress
|
|
indicator when you are writing a large chunk of data to the compression
|
|
stream in a single call.}
|
|
|
|
|
|
TCompressionLevel = (clNone, clFastest, clDefault, clMax);
|
|
|
|
TCompressionStream = class(TCustomZlibStream)
|
|
private
|
|
function GetCompressionRate: Single;
|
|
public
|
|
constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
|
|
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;
|
|
property CompressionRate: Single read GetCompressionRate;
|
|
property OnProgress;
|
|
end;
|
|
|
|
{ TDecompressionStream decompresses data on the fly as data is read from it.
|
|
|
|
Compressed data comes from a separate source stream. TDecompressionStream
|
|
is read-only and unidirectional; you can seek forward in the stream, but not
|
|
backwards. The special case of setting the stream position to zero is
|
|
allowed. Seeking forward decompresses data until the requested position in
|
|
the uncompressed data has been reached. Seeking backwards, seeking relative
|
|
to the end of the stream, requesting the size of the stream, and writing to
|
|
the stream will raise an exception.
|
|
|
|
The Position property returns the number of bytes of uncompressed data that
|
|
have been read from the stream so far.
|
|
|
|
The OnProgress event is called each time the internal input buffer of
|
|
compressed data is exhausted and the next block is read from the input stream.
|
|
This is useful for updating a progress indicator when you are reading a
|
|
large chunk of data from the decompression stream in a single call.}
|
|
|
|
TDecompressionStream = class(TCustomZlibStream)
|
|
public
|
|
constructor Create(Source: TStream);
|
|
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;
|
|
property OnProgress;
|
|
end;
|
|
|
|
|
|
|
|
{ CompressBuf compresses data, buffer to buffer, in one call.
|
|
In: InBuf = ptr to compressed data
|
|
InBytes = number of bytes in InBuf
|
|
Out: OutBuf = ptr to newly allocated buffer containing decompressed data
|
|
OutBytes = number of bytes in OutBuf }
|
|
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
|
|
out OutBuf: Pointer; out OutBytes: Integer);
|
|
|
|
|
|
{ DecompressBuf decompresses data, buffer to buffer, in one call.
|
|
In: InBuf = ptr to compressed data
|
|
InBytes = number of bytes in InBuf
|
|
OutEstimate = zero, or est. size of the decompressed data
|
|
Out: OutBuf = ptr to newly allocated buffer containing decompressed data
|
|
OutBytes = number of bytes in OutBuf }
|
|
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
|
|
OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
|
|
|
|
const
|
|
zlib_version = '1.1.3';
|
|
|
|
type
|
|
EZlibError = class(Exception);
|
|
ECompressionError = class(EZlibError);
|
|
EDecompressionError = class(EZlibError);
|
|
|
|
function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
|
|
|
|
implementation
|
|
|
|
const
|
|
Z_NO_FLUSH = 0;
|
|
Z_PARTIAL_FLUSH = 1;
|
|
Z_SYNC_FLUSH = 2;
|
|
Z_FULL_FLUSH = 3;
|
|
Z_FINISH = 4;
|
|
|
|
Z_OK = 0;
|
|
Z_STREAM_END = 1;
|
|
Z_NEED_DICT = 2;
|
|
Z_ERRNO = (-1);
|
|
Z_STREAM_ERROR = (-2);
|
|
Z_DATA_ERROR = (-3);
|
|
Z_MEM_ERROR = (-4);
|
|
Z_BUF_ERROR = (-5);
|
|
Z_VERSION_ERROR = (-6);
|
|
|
|
Z_NO_COMPRESSION = 0;
|
|
Z_BEST_SPEED = 1;
|
|
Z_BEST_COMPRESSION = 9;
|
|
Z_DEFAULT_COMPRESSION = (-1);
|
|
|
|
Z_FILTERED = 1;
|
|
Z_HUFFMAN_ONLY = 2;
|
|
Z_DEFAULT_STRATEGY = 0;
|
|
|
|
Z_BINARY = 0;
|
|
Z_ASCII = 1;
|
|
Z_UNKNOWN = 2;
|
|
|
|
Z_DEFLATED = 8;
|
|
|
|
_z_errmsg: array[0..9] of PChar = (
|
|
'need dictionary', // Z_NEED_DICT (2)
|
|
'stream end', // Z_STREAM_END (1)
|
|
'', // Z_OK (0)
|
|
'file error', // Z_ERRNO (-1)
|
|
'stream error', // Z_STREAM_ERROR (-2)
|
|
'data error', // Z_DATA_ERROR (-3)
|
|
'insufficient memory', // Z_MEM_ERROR (-4)
|
|
'buffer error', // Z_BUF_ERROR (-5)
|
|
'incompatible version', // Z_VERSION_ERROR (-6)
|
|
''
|
|
);
|
|
|
|
{$L deflate.obj}
|
|
{$L inflate.obj}
|
|
{$L inftrees.obj}
|
|
{$L trees.obj}
|
|
{$L adler32.obj}
|
|
{$L infblock.obj}
|
|
{$L infcodes.obj}
|
|
{$L infutil.obj}
|
|
{$L inffast.obj}
|
|
|
|
procedure _tr_init; external;
|
|
procedure _tr_tally; external;
|
|
procedure _tr_flush_block; external;
|
|
procedure _tr_align; external;
|
|
procedure _tr_stored_block; external;
|
|
function adler32; external;
|
|
procedure inflate_blocks_new; external;
|
|
procedure inflate_blocks; external;
|
|
procedure inflate_blocks_reset; external;
|
|
procedure inflate_blocks_free; external;
|
|
procedure inflate_set_dictionary; external;
|
|
procedure inflate_trees_bits; external;
|
|
procedure inflate_trees_dynamic; external;
|
|
procedure inflate_trees_fixed; external;
|
|
procedure inflate_codes_new; external;
|
|
procedure inflate_codes; external;
|
|
procedure inflate_codes_free; external;
|
|
procedure _inflate_mask; external;
|
|
procedure inflate_flush; external;
|
|
procedure inflate_fast; external;
|
|
|
|
procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
|
|
begin
|
|
FillChar(P^, count, B);
|
|
end;
|
|
|
|
procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
|
|
begin
|
|
Move(source^, dest^, count);
|
|
end;
|
|
|
|
|
|
|
|
// deflate compresses data
|
|
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
|
|
recsize: Integer): Integer; external;
|
|
function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
|
|
function deflateEnd(var strm: TZStreamRec): Integer; external;
|
|
|
|
// inflate decompresses data
|
|
function inflateInit_(var strm: TZStreamRec; version: PChar;
|
|
recsize: Integer): Integer; external;
|
|
function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
|
|
function inflateEnd(var strm: TZStreamRec): Integer; external;
|
|
function inflateReset(var strm: TZStreamRec): Integer; external;
|
|
|
|
|
|
function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
|
|
begin
|
|
GetMem(Result, Items*Size);
|
|
end;
|
|
|
|
procedure zcfree(AppData, Block: Pointer);
|
|
begin
|
|
FreeMem(Block);
|
|
end;
|
|
|
|
function zlibCheck(code: Integer): Integer;
|
|
begin
|
|
Result := code;
|
|
if code < 0 then
|
|
raise EZlibError.Create('error'); //!!
|
|
end;
|
|
|
|
function CCheck(code: Integer): Integer;
|
|
begin
|
|
Result := code;
|
|
if code < 0 then
|
|
raise ECompressionError.Create('error'); //!!
|
|
end;
|
|
|
|
function DCheck(code: Integer): Integer;
|
|
begin
|
|
Result := code;
|
|
if code < 0 then
|
|
raise EDecompressionError.Create('error'); //!!
|
|
end;
|
|
|
|
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
|
|
out OutBuf: Pointer; out OutBytes: Integer);
|
|
var
|
|
strm: TZStreamRec;
|
|
P: Pointer;
|
|
begin
|
|
FillChar(strm, sizeof(strm), 0);
|
|
OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
|
|
GetMem(OutBuf, OutBytes);
|
|
try
|
|
strm.next_in := InBuf;
|
|
strm.avail_in := InBytes;
|
|
strm.next_out := OutBuf;
|
|
strm.avail_out := OutBytes;
|
|
CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)));
|
|
try
|
|
while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
|
|
begin
|
|
P := OutBuf;
|
|
Inc(OutBytes, 256);
|
|
ReallocMem(OutBuf, OutBytes);
|
|
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
|
|
strm.avail_out := 256;
|
|
end;
|
|
finally
|
|
CCheck(deflateEnd(strm));
|
|
end;
|
|
ReallocMem(OutBuf, strm.total_out);
|
|
OutBytes := strm.total_out;
|
|
except
|
|
FreeMem(OutBuf);
|
|
raise
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
|
|
OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
|
|
var
|
|
strm: TZStreamRec;
|
|
P: Pointer;
|
|
BufInc: Integer;
|
|
begin
|
|
FillChar(strm, sizeof(strm), 0);
|
|
BufInc := (InBytes + 255) and not 255;
|
|
if OutEstimate = 0 then
|
|
OutBytes := BufInc
|
|
else
|
|
OutBytes := OutEstimate;
|
|
GetMem(OutBuf, OutBytes);
|
|
try
|
|
strm.next_in := InBuf;
|
|
strm.avail_in := InBytes;
|
|
strm.next_out := OutBuf;
|
|
strm.avail_out := OutBytes;
|
|
DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
|
|
try
|
|
while DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do
|
|
begin
|
|
P := OutBuf;
|
|
Inc(OutBytes, BufInc);
|
|
ReallocMem(OutBuf, OutBytes);
|
|
strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
|
|
strm.avail_out := BufInc;
|
|
end;
|
|
finally
|
|
DCheck(inflateEnd(strm));
|
|
end;
|
|
ReallocMem(OutBuf, strm.total_out);
|
|
OutBytes := strm.total_out;
|
|
except
|
|
FreeMem(OutBuf);
|
|
raise
|
|
end;
|
|
end;
|
|
|
|
|
|
// TCustomZlibStream
|
|
|
|
constructor TCustomZLibStream.Create(Strm: TStream);
|
|
begin
|
|
inherited Create;
|
|
FStrm := Strm;
|
|
FStrmPos := Strm.Position;
|
|
end;
|
|
|
|
procedure TCustomZLibStream.Progress(Sender: TObject);
|
|
begin
|
|
if Assigned(FOnProgress) then FOnProgress(Sender);
|
|
end;
|
|
|
|
|
|
// TCompressionStream
|
|
|
|
constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
|
|
Dest: TStream);
|
|
const
|
|
Levels: array [TCompressionLevel] of ShortInt =
|
|
(Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
|
|
begin
|
|
inherited Create(Dest);
|
|
FZRec.next_out := FBuffer;
|
|
FZRec.avail_out := sizeof(FBuffer);
|
|
CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
|
|
end;
|
|
|
|
destructor TCompressionStream.Destroy;
|
|
begin
|
|
FZRec.next_in := nil;
|
|
FZRec.avail_in := 0;
|
|
try
|
|
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
|
|
while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
|
|
and (FZRec.avail_out = 0) do
|
|
begin
|
|
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
|
|
FZRec.next_out := FBuffer;
|
|
FZRec.avail_out := sizeof(FBuffer);
|
|
end;
|
|
if FZRec.avail_out < sizeof(FBuffer) then
|
|
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
|
|
finally
|
|
deflateEnd(FZRec);
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
raise ECompressionError.Create('Invalid stream operation');
|
|
end;
|
|
|
|
function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
FZRec.next_in := @Buffer;
|
|
FZRec.avail_in := Count;
|
|
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
|
|
while (FZRec.avail_in > 0) do
|
|
begin
|
|
CCheck(deflate(FZRec, 0));
|
|
if FZRec.avail_out = 0 then
|
|
begin
|
|
FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
|
|
FZRec.next_out := FBuffer;
|
|
FZRec.avail_out := sizeof(FBuffer);
|
|
FStrmPos := FStrm.Position;
|
|
Progress(Self);
|
|
end;
|
|
end;
|
|
Result := Count;
|
|
end;
|
|
|
|
function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
begin
|
|
if (Offset = 0) and (Origin = soFromCurrent) then
|
|
Result := FZRec.total_in
|
|
else
|
|
raise ECompressionError.Create('Invalid stream operation');
|
|
end;
|
|
|
|
function TCompressionStream.GetCompressionRate: Single;
|
|
begin
|
|
if FZRec.total_in = 0 then
|
|
Result := 0
|
|
else
|
|
Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
|
|
end;
|
|
|
|
|
|
// TDecompressionStream
|
|
|
|
constructor TDecompressionStream.Create(Source: TStream);
|
|
begin
|
|
inherited Create(Source);
|
|
FZRec.next_in := FBuffer;
|
|
FZRec.avail_in := 0;
|
|
DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
|
|
end;
|
|
|
|
destructor TDecompressionStream.Destroy;
|
|
begin
|
|
inflateEnd(FZRec);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
|
|
begin
|
|
FZRec.next_out := @Buffer;
|
|
FZRec.avail_out := Count;
|
|
if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
|
|
while (FZRec.avail_out > 0) do
|
|
begin
|
|
if FZRec.avail_in = 0 then
|
|
begin
|
|
FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
|
|
if FZRec.avail_in = 0 then
|
|
begin
|
|
Result := Count - FZRec.avail_out;
|
|
Exit;
|
|
end;
|
|
FZRec.next_in := FBuffer;
|
|
FStrmPos := FStrm.Position;
|
|
Progress(Self);
|
|
end;
|
|
DCheck(inflate(FZRec, 0));
|
|
end;
|
|
Result := Count;
|
|
end;
|
|
|
|
function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
|
|
begin
|
|
raise EDecompressionError.Create('Invalid stream operation');
|
|
end;
|
|
|
|
function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
|
|
var
|
|
I: Integer;
|
|
Buf: array [0..4095] of Char;
|
|
begin
|
|
if (Offset = 0) and (Origin = soFromBeginning) then
|
|
begin
|
|
DCheck(inflateReset(FZRec));
|
|
FZRec.next_in := FBuffer;
|
|
FZRec.avail_in := 0;
|
|
FStrm.Position := 0;
|
|
FStrmPos := 0;
|
|
end
|
|
else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
|
|
( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
|
|
begin
|
|
if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
|
|
if Offset > 0 then
|
|
begin
|
|
for I := 1 to Offset div sizeof(Buf) do
|
|
ReadBuffer(Buf, sizeof(Buf));
|
|
ReadBuffer(Buf, Offset mod sizeof(Buf));
|
|
end;
|
|
end
|
|
else
|
|
raise EDecompressionError.Create('Invalid stream operation');
|
|
Result := FZRec.total_out;
|
|
end;
|
|
|
|
end.
|