abscompression.pas

Absolute Database 是来替代BDE[Borland数据库引擎]的用于Delphi 和 C++ Builder 开发用的数据库引擎. 它小巧, 高速, 健壮, 易于使用. 它能直接编译进

                          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): TABSCompressionAlgorithm;

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;


////////////////////////////////////////////////////////////////////////////////
//
// TABSStream
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// on progress
//------------------------------------------------------------------------------
procedure TABSStream.DoOnProgress(Progress: Double);
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self,Progress);
end; // on progress


//------------------------------------------------------------------------------
// lock
//------------------------------------------------------------------------------
procedure TABSStream.Lock;
begin
 EnterCriticalSection(FCSect);
end; // Lock


//------------------------------------------------------------------------------
// unlock
//------------------------------------------------------------------------------
procedure TABSStream.Unlock;
begin
  LeaveCriticalSection(FCSect);
end; // Unlock


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TABSStream.Create;
begin
 FBlockSize := DefaultMemoryBlockSize;
 FModified := False;
end; // Create


//------------------------------------------------------------------------------
// save all data to another stream
//------------------------------------------------------------------------------
procedure TABSStream.SaveToStream(Stream: TABSStream);
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 EABSException.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 EABSException.Create(10146,ErrorLCannotReadFromStream,
      [Pos,Self.Size,OutSize,ReadBytes]);

   Pos := Stream.Position;
   WriteBytes := Stream.Write(Buf^,OutSize);
   if (WriteBytes <> OutSize) then
    raise EABSException.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 TABSStream.LoadFromStream(Stream: TABSStream);
begin
 LoadFromStreamWithPosition(Stream,0,Stream.Size);
end; // LoadFromStream


//------------------------------------------------------------------------------
// load from stream
//------------------------------------------------------------------------------
procedure TABSStream.LoadFromStreamWithPosition(
                    Stream:       TABSStream;
                    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 EABSException.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 EABSException.Create(10148,ErrorLCannotReadFromStream,
      [Pos,Stream.Size,OutSize,ReadBytes]);

   Pos := Self.Position;
   WriteBytes := Self.Write(Buf^,OutSize);
   if (WriteBytes <> OutSize) then
    raise EABSException.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 TABSStream.LoadFromFile(const FileName: string);
var
  Stream: TABSStream;
begin
  Stream := TABSFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end; // LoadFromFile


//------------------------------------------------------------------------------
// save all data to file
//------------------------------------------------------------------------------
procedure TABSStream.SaveToFile(const FileName: string);
var
  Stream: TABSStream;
begin
  Stream := TABSFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end; // SaveToFile


////////////////////////////////////////////////////////////////////////////////
//
// TABSMemoryStream
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSMemoryStream.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 TABSMemoryStream.InternalSeek(NewPosition: Integer): Integer;
begin
 FPosition := NewPosition;
 result := FPosition;
end; // InternalSeek


//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSMemoryStream.SetSize(NewSize: Longint);
begin
 InternalSetSize(NewSize);
end; // SetSize


{$IFDEF D6H}
//------------------------------------------------------------------------------
// sets new size of the stream
//------------------------------------------------------------------------------
procedure TABSMemoryStream.SetSize(const NewSize: Int64);
begin
 InternalSetSize(NewSize);
end; // SetSize
{$ENDIF}


//------------------------------------------------------------------------------
// set size of compressed stream
//------------------------------------------------------------------------------
function TABSMemoryStream.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 TABSMemoryStream.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 TABSMemoryStream.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 TABSMemoryStream.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
{$ENDIF}