Browse Source

* created package

master
bergmann 7 years ago
parent
commit
9391c0740f
7 changed files with 3902 additions and 8 deletions
  1. +4
    -0
      .gitignore
  2. +3343
    -0
      KAZip/KAZip.pas
  3. +461
    -0
      KAZip/dzlib.pas
  4. +64
    -0
      bitSpaceVFS.lpk
  5. +22
    -0
      bitSpaceVFS.pas
  6. +3
    -3
      uvfsTarArchive.pas
  7. +5
    -5
      uvfsUtils.pas

+ 4
- 0
.gitignore View File

@@ -0,0 +1,4 @@
lib/
*.exe
*.log
*.dbg

+ 3343
- 0
KAZip/KAZip.pas
File diff suppressed because it is too large
View File


+ 461
- 0
KAZip/dzlib.pas View File

@@ -0,0 +1,461 @@
{*******************************************************}
{ }
{ Delphi Supplemental Components }
{ ZLIB Data Compression Interface Unit }
{ }
{ Copyright (c) 1997 Borland International }
{ Copyright (c) 1998 Jacques Nomssi Nzali }
{ Copyright (c) 2006 Graeme Geldenhuys }
{ }
{*******************************************************}

unit dzlib;

{$WARNINGS OFF}
{$HINTS OFF}

{$MODE OBJFPC}{$H+}

{ At least FPC 2.0.2 is required }
{$if defined(ver1) or (defined(ver2_0) and (fpc_patch<2))}
{$fatal Lazarus requires at least FPC 2.0.2}
{$ELSEIF (defined(ver2_0) and (fpc_patch=2))}
{$DEFINE FPC202}
{$ELSE}
{$DEFINE FPC202OrAbove}
{$ENDIF}


interface
uses
zbase, Sysutils, Classes;


type
{ Internal structure. Ignore. }
TZStreamRec = z_stream;


const
FBufSize = 8192;
type
{ Abstract ancestor class }
TCustomZlibStream = class(TStream)
private
FStrm: TStream;
FStrmPos: Integer;
FOnProgress: TNotifyEvent;
FZRec: TZStreamRec;
FBuffer: array [0..FBufSize-1] 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);


type
EZlibError = class(Exception);
ECompressionError = class(EZlibError);
EDecompressionError = class(EZlibError);


implementation
uses
{$ifdef fpc202}
zutil,
{$endif}
zDeflate, zInflate;


function zlibAllocMem(AppData: Pointer; Items, Size: Cardinal): Pointer;
begin
GetMem(Result, Items*Size);
end;


procedure zlibFreeMem(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);
{$ifdef fpc202}
strm.zalloc := @zlibAllocMem;
strm.zfree := @zlibFreeMem;
{$endif}
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 deflate(strm, Z_FINISH) <> Z_STREAM_END do
begin
P := OutBuf;
Inc(OutBytes, 256);
ReallocMem(OutBuf, OutBytes);
strm.next_out := {$ifdef fpc202}PBytef{$else}PByte{$endif}(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
zlibFreeMem(NIL, 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);
{$ifdef fpc202}
strm.zalloc := @zlibAllocMem;
strm.zfree := @zlibFreeMem;
{$endif}
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 inflate(strm, Z_FINISH) <> Z_STREAM_END do
begin
P := OutBuf;
Inc(OutBytes, BufInc);
ReallocMem(OutBuf, OutBytes);
strm.next_out := {$ifdef fpc202}pBytef{$else}PByte{$endif}(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
zlibFreeMem(NIL, OutBuf);
raise
end;
end;


{ TCustomZlibStream }

constructor TCustomZLibStream.Create(Strm: TStream);
begin
inherited Create;
FStrm := Strm;
FStrmPos := Strm.Position;
{$ifdef fpc202}
FZRec.zalloc := @zlibAllocMem;
FZRec.zfree := @zlibFreeMem;
{$endif}
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 := PByte(@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 := PByte(@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 := PByte(@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 := PByte(@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 := PByte(@FBuffer);
FStrmPos := FStrm.Position;
Progress(Self);
end;
CCheck(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 := PByte(@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.


+ 64
- 0
bitSpaceVFS.lpk View File

@@ -0,0 +1,64 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="bitSpaceVFS"/>
<Type Value="RunAndDesignTime"/>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="3rdParty;KAZip"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Files Count="8">
<Item1>
<Filename Value="uvfsFolder.pas"/>
<UnitName Value="uvfsFolder"/>
</Item1>
<Item2>
<Filename Value="uvfsManager.pas"/>
<UnitName Value="uvfsManager"/>
</Item2>
<Item3>
<Filename Value="uvfsSpecialFolder.pas"/>
<UnitName Value="uvfsSpecialFolder"/>
</Item3>
<Item4>
<Filename Value="uvfsTarArchive.pas"/>
<UnitName Value="uvfsTarArchive"/>
</Item4>
<Item5>
<Filename Value="uvfsUtils.pas"/>
<UnitName Value="uvfsUtils"/>
</Item5>
<Item6>
<Filename Value="uvfsZipArchive.pas"/>
<UnitName Value="uvfsZipArchive"/>
</Item6>
<Item7>
<Filename Value="KAZip\dzlib.pas"/>
<UnitName Value="dzlib"/>
</Item7>
<Item8>
<Filename Value="KAZip\KAZip.pas"/>
<UnitName Value="KAZip"/>
</Item8>
</Files>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="bitSpaceUtils"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

+ 22
- 0
bitSpaceVFS.pas View File

@@ -0,0 +1,22 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}

unit bitSpaceVFS;

{$warn 5023 off : no warning about unused units}
interface

uses
uvfsFolder, uvfsManager, uvfsSpecialFolder, uvfsTarArchive, uvfsUtils, uvfsZipArchive, dzlib, KAZip,
LazarusPackageIntf;

implementation

procedure Register;
begin
end;

initialization
RegisterPackage('bitSpaceVFS', @Register);
end.

+ 3
- 3
uvfsTarArchive.pas View File

@@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, libtar, syncobjs,

uvfsManager, uutlExceptions;
uvfsManager;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -132,7 +132,7 @@ begin
Stream := TvfsStreamHandleRead.Create(ms);
end;
else
raise ENotSupported.Create('tar archive only supports read operations');
raise ENotSupportedException.Create('tar archive only supports read operations');
end;

result := Assigned(Stream);
@@ -193,7 +193,7 @@ var
begin
fFileSpec := FileSpec;
if not FileExists(fFileSpec) then
EFileNotFound.Create(fFileSpec);
EFileNotFoundException.Create(fFileSpec);
fs := TFileStream.Create(fFileSpec, fmOpenRead);
Create(fs, true);
end;


+ 5
- 5
uvfsUtils.pas View File

@@ -5,9 +5,9 @@ unit uvfsUtils;
interface

uses
Classes, SysUtils,
uutlSerialization;
Classes, SysUtils;

{
type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TvfsFileWriter = class(TInterfacedObject, IutlFileWriter)
@@ -19,12 +19,12 @@ type
public
function LoadStream(const aFilename: String; const aStream: TStream): Boolean;
end;
}
implementation

uses
uvfsManager;
{
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TvfsFileReader////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -48,6 +48,6 @@ begin
raise EvfsError.Create('unable to create file: ' + aFilename);
s.GetStream.CopyFrom(aStream, aStream.Size - aStream.Position);
end;
}
end.


Loading…
Cancel
Save