?? myldbcompression.pas
字號:
FCompressedSize := FUncompressedSize;
// check if stream size is too small
if (not FRepair) then
if (FCompressedStream.Size - FCompressedStream.Position <
FUncompressedSize) then
raise EMYLDBException.Create(10081,ErrorLStreamSizeTooSmall,
[FCompressedStream.Size,
(FUncompressedSize + FCompressedStream.Position)]);
end;
end // no compression
else
// create compressed stream, load headers
InternalCreate(ToCreate);
end; // Create
//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMYLDBCompressedBLOBStream.Destroy;
begin
if (FHeaders <> nil) then
FHeaders.Free;
FHeaders := nil;
inherited;
end; // Destroy
//------------------------------------------------------------------------------
// read from compressed stream
//------------------------------------------------------------------------------
function TMYLDBCompressedBLOBStream.Read(var Buffer; Count: Longint): Longint;
var ReadSize: Int64;
OutBuf: PChar;
begin
if (FCompressionAlgorithm = acaNone) then
begin
Result := FCompressedStream.Read(Buffer,Count);
FPosition := FCompressedStream.Position - FStartPosition;
end // no compression
else
begin
Result := 0;
if ((Count > 0) and (FPosition >= 0) and (FPosition < FUncompressedSize)) then
begin
FCurrentHeader := FPosition div FBlockSize;
while ((FPosition < FUncompressedSize) and (Result < Count)) do
begin
LoadBlock(FCurrentHeader,OutBuf);
// read from current position to the end of the block
ReadSize := FBlockSize -
((FPosition + FBlockSize) mod FBlockSize);
// if we Result + ReadSize exceeds Count read only Count - Result
if (Result + ReadSize > Count) then
ReadSize := Count - Result;
// reading only till EOF
if (FPosition + ReadSize >= FUncompressedSize) then
ReadSize := FUncompressedSize - FPosition;
if (ReadSize <= 0) then
raise EMYLDBException.Create(10090,
ErrorLCannotReadFromStreamInvalidReadSize,[ReadSize]);
// move data from decompressed buffer to Buffer
Move(PChar(OutBuf + ((FPosition + FBlockSize) mod FBlockSize))^,
PChar(PChar(@Buffer) + Result)^,ReadSize);
FreeMem(OutBuf);
Inc(Result,ReadSize);
if (Result < Count) then
Inc(FCurrentHeader);
Inc(FPosition,ReadSize);
end; // reading loop
end; // FPosition < FUncompressedSize
end; // compression
end; // Read
//------------------------------------------------------------------------------
// write beyond EOF
//------------------------------------------------------------------------------
procedure TMYLDBCompressedBLOBStream.InternalWriteBeyondEOF;
var OldPos: Int64;
begin
OldPos := FPosition;
Self.Position := 0;
Self.SetSize(OldPos);
Self.Position := OldPos;
if (Self.Position <> OldPos) then
raise EMYLDBException.Create(10091,ErrorLCannotSetPosition,
[OldPos,FPosition,FUncompressedSize]);
if (FUncompressedSize <> OldPos) then
raise EMYLDBException.Create(10092,ErrorLInvalidStreamSize,
[FUncompressedSize,OldPos]);
end; // InternalWriteBeyondEOF
//------------------------------------------------------------------------------
// write block
//------------------------------------------------------------------------------
procedure TMYLDBCompressedBLOBStream.InternalWriteBlock(InBuf: PChar; InSize: Integer);
var OutBuf: PChar;
WriteBytes: Integer;
OldPos: Int64;
begin
PrepareBufferForWriting(InBuf,InSize,OutBuf,
FHeaders.Items[FCurrentHeader]);
try
// Commented By Leo Martin - changed from absolute to relative offset
FHeaders.Items[FCurrentHeader].OffsetToNextHeader :=
// FHeaders.Positions[FCurrentHeader] +
sizeof(TMYLDBCompressedStreamBlockHeader) +
FHeaders.Items[FCurrentHeader].CompressedSize;
FCompressedStream.Position := FHeaders.Positions[FCurrentHeader];
if (FCompressedStream.Position <> FHeaders.Positions[FCurrentHeader]) then
raise EMYLDBException.Create(10099,ErrorLCannotSetPosition,
[FHeaders.Positions[FCurrentHeader],
FCompressedStream.Position,FCompressedStream.Size]);
OldPos := FCompressedStream.Position;
WriteBytes := FCompressedStream.Write(FHeaders.Items[FCurrentHeader],
sizeof(TMYLDBCompressedStreamBlockHeader));
if (WriteBytes <> sizeof(TMYLDBCompressedStreamBlockHeader)) then
raise EMYLDBException.Create(10100,ErrorLCannotWriteToStream,
[OldPos,FCompressedStream.Size,sizeof(TMYLDBCompressedStreamBlockHeader),WriteBytes]);
OldPos := FCompressedStream.Position;
WriteBytes := FCompressedStream.Write(OutBuf^,
FHeaders.Items[FCurrentHeader].CompressedSize);
if (WriteBytes <> FHeaders.Items[FCurrentHeader].CompressedSize) then
raise EMYLDBException.Create(10101,ErrorLCannotWriteToStream,
[OldPos,FCompressedStream.Size,FHeaders.Items[FCurrentHeader].CompressedSize,WriteBytes]);
finally
if (OutBuf <> nil) then
FreeMem(OutBuf);
end;
end; // InternalWriteBlock
//------------------------------------------------------------------------------
// write prepare
//------------------------------------------------------------------------------
procedure TMYLDBCompressedBLOBStream.InternalWritePrepare(Count, Result: Integer);
var
NumBlocks,NewPos: Int64;
begin
// calculate start position and current header number for next block
if (FHeaders.ItemCount = 0) then
begin
NewPos := FBLOBDescriptor.StartPosition;
FCurrentHeader := 0;
end
else
begin
// Commented By Leo Martin - changed from absolute to relative offset
// NewPos := FHeaders.Items[FCurrentHeader].OffsetToNextHeader;
NewPos := FHeaders.Positions[FCurrentHeader] +
FHeaders.Items[FCurrentHeader].OffsetToNextHeader;
FCurrentHeader := FHeaders.ItemCount;
end;
NumBlocks := (Count - Result) div FBlockSize;
if (((Count - Result) mod FBlockSize) > 0) then
Inc(NumBlocks);
FHeaders.SetSize(FHeaders.ItemCount + NumBlocks);
// set new position
FCompressedStream.Position := NewPos;
if (FCompressedStream.Position <> NewPos) then
raise EMYLDBException.Create(10102,ErrorLCannotSetPosition,
[NewPos,FCompressedStream.Position,FCompressedStream.Size]);
end; // InternalWritePrepare
//------------------------------------------------------------------------------
// write to compressed stream
//------------------------------------------------------------------------------
function TMYLDBCompressedBLOBStream.Write(const Buffer; Count: Longint): Longint;
var WriteSize: Integer;
InBuf,TempBuf: PChar;
Offset: Integer;
begin
Result := 0;
if (FCompressionAlgorithm = acaNone) then
begin
Result := FCompressedStream.Write(Buffer,Count);
FUncompressedSize := FCompressedStream.Size - FStartPosition;
FPosition := FCompressedStream.Position - FStartPosition;
end // no compression
else
if ((Count > 0) and (FPosition >= FUncompressedSize)) then
begin
// write beyond end of the file
if (FPosition > FUncompressedSize) then
InternalWriteBeyondEOF;
if (FHeaders.ItemCount > 0) then
FCurrentHeader := FHeaders.ItemCount-1
else
FCurrentHeader := 0;
Offset := FPosition mod FBlockSize;
// rewrite last block
if (Offset > 0) then
begin
// load last block
InBuf := MemoryManager.GetMem(FBlockSize);
try
LoadBlock(FCurrentHeader,TempBuf);
try
Move(TempBuf^,InBuf^,FHeaders.Items[FCurrentHeader].UncompressedSize);
finally
FreeMem(TempBuf);
end;
if (Count < (FBlockSize - Offset)) then
WriteSize := Count
else
WriteSize := FBlockSize - Offset;
Move(PChar(@Buffer)^,PChar(InBuf + Offset)^,WriteSize);
InternalWriteBlock(InBuf,Offset + WriteSize);
Inc(Result,WriteSize);
Inc(FCurrentHeader);
finally
MemoryManager.FreeAndNillMem(InBuf);
end;
end; // Offset > 0
InBuf := nil;
if (Result < Count) then
begin
InBuf := MemoryManager.GetMem(FBlockSize);
if (Offset > 0) and (FCurrentHeader > 0) then
Dec(FCurrentHeader);
InternalWritePrepare(Count,Result);
end; // Result < Count
try
while (Result < Count) do
begin
if ((Count - Result) < FBlockSize) then
WriteSize := Count - Result
else
WriteSize := FBlockSize;
Move(PChar(PChar(@Buffer) + Result)^,PChar(InBuf)^,WriteSize);
FHeaders.Positions[FCurrentHeader] := FCompressedStream.Position;
InternalWriteBlock(InBuf,WriteSize);
// write nex block;
Inc(Result,WriteSize);
Inc(FCurrentHeader);
end;
finally
if (InBuf <> nil) then
MemoryManager.FreeAndNillMem(InBuf);
end;
Inc(FUncompressedSize,Result);
Inc(FPosition,Result);
FBLOBDescriptor.NumBlocks := FHeaders.ItemCount;
end; // compression
FBLOBDescriptor.UncompressedSize := FUncompressedSize;
CalculateRate;
end; // Write
//------------------------------------------------------------------------------
// seek in compressed stream
//------------------------------------------------------------------------------
function TMYLDBCompressedBLOBStream.Seek(Offset: Longint; Origin: Word): Longint;
var NewPosition: Int64;
begin
NewPosition := FPosition;
case (Origin) of
soFromBeginning:
NewPosition := Offset;
soFromCurrent:
NewPosition := Integer(FPosition) + Offset;
soFromEnd:
NewPosition := Integer(FUncompressedSize) + Offset;
end;
Result := InternalSeek(NewPosition);
end; // Seek
{$IFDEF D6H}
function TMYLDBCompressedBLOBStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var NewPosition: Int64;
begin
NewPosition := FPosition;
case (Origin) of
soBeginning:
NewPosition := Offset;
soCurrent:
NewPosition := Integer(FPosition) + Offset;
soEnd:
NewPosition := Integer(FUncompressedSize) + Offset;
end;
Result := InternalSeek(NewPosition);
end; // Seek
{$ENDIF}
//------------------------------------------------------------------------------
// compresses buffer
// returns true if successful
// outBuf - pointer to compressed data
// outSize - size of compressed data
//------------------------------------------------------------------------------
function MYLDBInternalCompressBuffer(
CompressionAlgorithm: TMYLDBCompressionAlgorithm;
CompressionMode: Byte;
InBuf: PChar;
InSize: Integer;
out OutBuf: PChar;
out OutSize: Integer
): Boolean;
begin
Result := false;
OutSize := 0;
// empty buffer cannot be compressed
// none compression is not allowed
if ((CompressionAlgorithm = acaNone) or (InSize = 0)) then Exit;
Result := true;
case CompressionAlgorithm of
{$IFDEF ZLIB}
acaZLIB:
begin
try
ZLIBCompressBuf(InBuf,InSize,Pointer(Outbuf),Integer(OutSize),CompressionMode);
except
Result := false;
end;
if (OutSize <= 0) then
Result := false;
end
{$ENDIF}
{$IFDEF BZIP}
{$IFDEF ZLIB}
;
{$ENDIF}
acaBZIP:
begin
try
bzCompressBuf(InBuf,InSize,Pointer(Outbuf),Integer(OutSize),CompressionMode)
except
Result := false;
end;
if (OutSize <= 0) then
Result := false;
end
{$ENDIF}
{$IFDEF PPMD}
{$IFDEF ZLIB}
;
{$ELSE}
{$IFDEF ZLIB}
;
{$ENDIF}
{$ENDIF}
acaPPM:
begin
try
// some memory reserve for none-compressible data
OutSize := InSize + InSize div 20 + 50;
OutBuf := AllocMem(OutSize);
OutSize := PPMCompressBuffer(
InBuf,InSize,OutBuf,
PPM_MO[CompressionMode],
PPM_SA[CompressionMode]
);
except
Result := false;
end;
if (OutSize <= 0) then
Result := false;
end
{$ENDIF}
;
else
Result := false;
end; // case compression ?????????
end; // MYLDBInternalCompressBuffer;
//------------------------------------------------------------------------------
// decompresse buffer
// Outsize must be set to uncompressed size
// return true if successful
// OutBuf - pointer to compressed data
// OutSize - size of compressed data
//------------------------------------------------------------------------------
function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -