?? myldbcompression.pas
字號:
out OutBuf: PChar;
out OutSize: Integer
): Boolean;
function CRC32(CRC: LongWord; Data: Pointer; DataSize: LongWord): LongWord;
function GetTempFileName: String;
procedure SaveDataToStream(var Data; DataSize: Integer; Stream: TStream; ErrorCode: Integer);
procedure LoadDataFromStream(var Data; DataSize: Integer; Stream: TStream; ErrorCode: Integer);
procedure SetStreamPosition(Stream: TStream; NewPosition: Int64; ErrorCode: Integer);
function GetCompressionAlgorithm(Name: String): TMYLDBCompressionAlgorithm;
implementation
{$IFDEF PPMD}
{$L ppmd.OBJ}
function PPMCompressBuffer(inBuf : pChar;
inSize : Integer;
outBuf : pChar;
Max_Order:integer = 6;
SASize:integer = 10
) : Integer; external;
function PPMDecompressBuffer(
inBuf : pChar;
inSize : Integer;
outBuf : pChar
) : Integer; external;
{$ENDIF}
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;
function aa_malloc(count : integer) : pChar;cdecl;
begin
result := AllocMem(count);
end;
procedure aa_free(buffer : pChar);cdecl;
begin
FreeMem(buffer);
end;
////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBStream
//
////////////////////////////////////////////////////////////////////////////////
//------------------------------------------------------------------------------
// on progress
//------------------------------------------------------------------------------
procedure TMYLDBStream.DoOnProgress(Progress: Double);
begin
if Assigned(FOnProgress) then
FOnProgress(Self,Progress);
end; // on progress
//------------------------------------------------------------------------------
// lock
//------------------------------------------------------------------------------
procedure TMYLDBStream.Lock;
begin
EnterCriticalSection(FCSect);
end; // Lock
//------------------------------------------------------------------------------
// unlock
//------------------------------------------------------------------------------
procedure TMYLDBStream.Unlock;
begin
LeaveCriticalSection(FCSect);
end; // Unlock
//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMYLDBStream.Create;
begin
FBlockSize := DefaultMemoryBlockSize;
FModified := False;
end; // Create
//------------------------------------------------------------------------------
// save all data to another stream
//------------------------------------------------------------------------------
procedure TMYLDBStream.SaveToStream(Stream: TMYLDBStream);
var OutBytes,OldPos,OldPos1,InSize: Int64;
OutSize: Integer;
Buf: PChar;
FProgress: Extended;
FProgressMax: Extended;
ReadBytes,WriteBytes: Integer;
Pos: Int64;
begin
if (FBlockSize = 0) then
raise EMYLDBException.Create(10418,ErrorLZeroBlockSizeIsNotAllowed);
OldPos := Position;
OldPos1 := Stream.Position;
Position := 0;
OutBytes := 0;
DoOnProgress(0);
InSize := Size;
Buf := AllocMem(FBlockSize);
while OutBytes < InSize do
begin
if (InSize - OutBytes > FBlockSize) then
OutSize := FBlockSize
else
OutSize := Size - OutBytes;
Pos := Self.Position;
ReadBytes := Self.Read(Buf^,OutSize);
if (ReadBytes <> OutSize) then
raise EMYLDBException.Create(10146,ErrorLCannotReadFromStream,
[Pos,Self.Size,OutSize,ReadBytes]);
Pos := Stream.Position;
WriteBytes := Stream.Write(Buf^,OutSize);
if (WriteBytes <> OutSize) then
raise EMYLDBException.Create(10147,ErrorLCannotWriteToStream,
[Pos,Stream.Size,OutSize,WriteBytes]);
Inc(OutBytes,OutSize);
FProgressMax := Size;
FProgress := OutBytes;
DoOnProgress(FProgress/FProgressMax*100.0);
end;
FreeMem(Buf);
Position := OldPos;
Stream.Position := OldPos1;
DoOnProgress(100.0);
end; // SaveToStream
//------------------------------------------------------------------------------
// load all data from another stream
//------------------------------------------------------------------------------
procedure TMYLDBStream.LoadFromStream(Stream: TMYLDBStream);
begin
LoadFromStreamWithPosition(Stream,0,Stream.Size);
end; // LoadFromStream
//------------------------------------------------------------------------------
// load from stream
//------------------------------------------------------------------------------
procedure TMYLDBStream.LoadFromStreamWithPosition(
Stream: TMYLDBStream;
FromPosition: Int64;
StreamSize: Int64
);
var OldPos,OldPos1: Int64;
OutSize: Integer;
Buf: PChar;
FProgress: Extended;
FProgressMax: Extended;
ReadBytes,WriteBytes: Integer;
Pos: Int64;
begin
if (FBlockSize = 0) then
raise EMYLDBException.Create(10419,ErrorLZeroBlockSizeIsNotAllowed);
OldPos := Position;
OldPos1 := Stream.Position;
Stream.Position := FromPosition;
Size := 0;
Position := 0;
DoOnProgress(0);
Buf := AllocMem(FBlockSize);
while (Stream.Position < FromPosition + StreamSize) do
begin
if ((FromPosition + StreamSize) - Stream.Position > FBlockSize) then
OutSize := FBlockSize
else
OutSize := (FromPosition + StreamSize) - Stream.Position;
Pos := Stream.Position;
ReadBytes := Stream.Read(Buf^,OutSize);
if (ReadBytes <> OutSize) then
raise EMYLDBException.Create(10148,ErrorLCannotReadFromStream,
[Pos,Stream.Size,OutSize,ReadBytes]);
Pos := Self.Position;
WriteBytes := Self.Write(Buf^,OutSize);
if (WriteBytes <> OutSize) then
raise EMYLDBException.Create(10149,ErrorLCannotWriteToStream,
[Pos,Self.Size,OutSize,WriteBytes]);
FProgressMax := Stream.Size;
FProgress := Stream.Position;
DoOnProgress(FProgress/FProgressMax*100.0);
end;
FreeMem(buf);
Position := OldPos;
Stream.Position := OldPos1;
DoOnProgress(100.0);
end;
//------------------------------------------------------------------------------
// load all data from file
//------------------------------------------------------------------------------
procedure TMYLDBStream.LoadFromFile(const FileName: string);
var
Stream: TMYLDBStream;
begin
Stream := TMYLDBFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end; // LoadFromFile
//------------------------------------------------------------------------------
// save all data to file
//------------------------------------------------------------------------------
procedure TMYLDBStream.SaveToFile(const FileName: string);
var
Stream: TMYLDBStream;
begin
Stream := TMYLDBFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end; // SaveToFile
////////////////////////////////////////////////////////////////////////////////
//
// TMYLDBMemoryStream
//
////////////////////////////////////////////////////////////////////////////////
//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TMYLDBMemoryStream.InternalSetSize(const NewSize: Int64);
begin
if (NewSize <= 0) then
begin
FBufferSize := 0;
FAllocatedBufferSize := 0;
if (FBuffer <> nil) then
MemoryManager.FreeAndNillMem(FBuffer);
end
else
if (FAllocatedBufferSize = 0) then
begin
FBuffer := MemoryManager.GetMem(NewSize);
FBufferSize := NewSize;
FAllocatedBufferSize := NewSize;
end
else
begin
FBufferSize := NewSize;
if (FBufferSize > FAllocatedBufferSize) then
begin
FAllocatedBufferSize := FBufferSize * 2;
MemoryManager.ReallocMem(FBuffer,FAllocatedBufferSize);
end;
end;
if (FPosition > FBufferSize) then
FPosition := FBufferSize;
end; // InternalSetSize
//------------------------------------------------------------------------------
// seek
//------------------------------------------------------------------------------
function TMYLDBMemoryStream.InternalSeek(NewPosition: Integer): Integer;
begin
FPosition := NewPosition;
result := FPosition;
end; // InternalSeek
//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TMYLDBMemoryStream.SetSize(NewSize: Longint);
begin
InternalSetSize(NewSize);
end; // SetSize
{$IFDEF D6H}
//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TMYLDBMemoryStream.SetSize(const NewSize: Int64);
begin
InternalSetSize(NewSize);
end; // SetSize
{$ENDIF}
//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TMYLDBMemoryStream.Read(var Buffer; Count: Longint): Longint;
var NewCount: Integer;
begin
Result := 0;
if ((FPosition < FBufferSize) and (Count > 0)) then
begin
// count more than size of the buffer minus position
if (Count > FBufferSize - FPosition) then
NewCount := FBufferSize - FPosition
else
NewCount := Count;
Move(PChar(FBuffer + FPosition)^,Buffer,NewCount);
Result := NewCount;
Inc(FPosition,NewCount);
end;
end; // Read
//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TMYLDBMemoryStream.Write(const Buffer; Count: Longint): Longint;
begin
if (FBufferSize < FPosition + Count) then
InternalSetSize(FPosition + Count);
Result := Count;
System.Move(Buffer,PChar(FBuffer + FPosition)^,Count);
Inc(FPosition,Count);
end; // Write
//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TMYLDBMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
var NewPosition: Integer;
begin
NewPosition := FPosition;
case (Origin) of
soFromBeginning:
NewPosition := Offset;
soFromCurrent:
NewPosition := Integer(FPosition) + Offset;
soFromEnd:
NewPosition := Integer(FBufferSize) + Offset;
end;
Result := InternalSeek(NewPosition);
end; // Seek
{$IFDEF D6H}
//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TMYLDBMemoryStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
var NewPosition: Integer;
begin
NewPosition := 0;
case (Origin) of
soBeginning:
NewPosition := Offset;
soCurrent:
NewPosition := FPosition + Offset;
soEnd:
NewPosition := FBufferSize + Offset;
end;
Result := InternalSeek(NewPosition);
end; // Seek
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -