abstypes.pas

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

     MemoryManager.FreeAndNillMem(FBits);
    FNonZeroBitCount := 0;
   end // empty array
  else
   begin
    if (FBits = nil) then
     FBits := MemoryManager.AllocMem(SizeInBytes)
    else
     MemoryManager.ReallocMemAndClearTail(FBits, SizeInBytes);
   end;// not empty array
  if (NewSize < FBitCount) then
   begin
    if (NewSize = 0) then
     FNonZeroBitCount := 0
    else
     begin
      FBitCount := NewSize;
      FNonZeroBitCount := GetNonZeroBitCount;
     end;
   end;
  FBitCount := NewSize;
end;// SetSize


//------------------------------------------------------------------------------
// load from stream
//------------------------------------------------------------------------------
procedure TABSBitsArray.LoadFromStream(Stream: TStream);
var aBitsSize: Integer;
begin
 LoadDataFromStream(FBitCount,Sizeof(FBitCount),Stream,10401);
 LoadDataFromStream(FNonZeroBitCount,Sizeof(FNonZeroBitCount),Stream,10426);
 SetSize(FBitCount);
 if (FBitCount > 0) then
  begin
   aBitsSize := FBitCount div 8;
   if ((FBitCount mod 8) > 0) then
    Inc(aBitsSize);
   LoadDataFromStream(FBits^,aBitsSize,Stream,10402);
  end;
end; // LoadFromStream


//------------------------------------------------------------------------------
// save to stream
//------------------------------------------------------------------------------
procedure TABSBitsArray.SaveToStream(Stream: TStream);
var aBitsSize: Integer;
begin
 SaveDataToStream(FBitCount,Sizeof(FBitCount),Stream,10398);
 SaveDataToStream(FNonZeroBitCount,Sizeof(FNonZeroBitCount),Stream,10427);
 if (FBitCount > 0) then
  begin
   if (FBits = nil) then
    raise EABSException.Create(10399,ErrorLNilPointer);
   aBitsSize := FBitCount div 8;
   if ((FBitCount mod 8) > 0) then
    Inc(aBitsSize);
   SaveDataToStream(FBits^,aBitsSize,Stream,10400);
  end;
end; // SaveToStream


//------------------------------------------------------------------------------
// create
//------------------------------------------------------------------------------
constructor TABSBitsArray.Create;
var
    i,c: Byte;
begin
 FBits := nil;
 SetSize(0);
 for i := 0 to 255 do
  begin
   c := 0;
   if ((i and 1) <> 0) then Inc(c);
   if ((i and 2) <> 0) then Inc(c);
   if ((i and 4) <> 0) then Inc(c);
   if ((i and 8) <> 0) then Inc(c);
   if ((i and 16) <> 0) then Inc(c);
   if ((i and 32) <> 0) then Inc(c);
   if ((i and 64) <> 0) then Inc(c);
   if ((i and 128) <> 0) then Inc(c);
   FBitsTable[i] := c;
  end;
end;// Create


//------------------------------------------------------------------------------
// destroy
//------------------------------------------------------------------------------
destructor TABSBitsArray.Destroy;
begin
 if (FBits <> nil) then
  MemoryManager.FreeAndNillMem(FBits);
end;// Destroy


//------------------------------------------------------------------------------
// get bit value
//------------------------------------------------------------------------------
function TABSBitsArray.GetBit(BitNo: Integer): Boolean;
begin
  if (BitNo >= FBitCount) then
   raise EABSException.Create(10394,ErrorLInvalidBitNo,[BitNo,FBitCount]);
  Result := CheckNullFlag(BitNo, FBits);
end;// GetBit


//------------------------------------------------------------------------------
// set bit value
//------------------------------------------------------------------------------
procedure TABSBitsArray.SetBit(BitNo: Integer; Value: Boolean);
var Bit: Boolean;
begin
  if (BitNo >= FBitCount) then
   raise EABSException.Create(10395,ErrorLInvalidBitNo,[BitNo,FBitCount]);
  Bit := CheckNullFlag(BitNo,FBits);
  if (Bit <> Value) then
   begin
    if (Value) then
     Inc(FNonZeroBitCount)
    else
     Dec(FNonZeroBitCount);
    SetNullFlag(Value, BitNo, FBits);
   end;
end;// SetBit


//------------------------------------------------------------------------------
// returns number of bit = 1 in FBits array by bit position
//------------------------------------------------------------------------------
function TABSBitsArray.GetBitNoByBitPosition(BitPosition: Integer): Integer;
var i,n:    Integer;
    b,k,l:        Byte;
begin
 if (BitPosition >= FNonZeroBitCount) then
  raise EABSException.Create(10428,ErrorLInvalidBitNo,
    [BitPosition,FNonZeroBitCount]);

 if (FBitCount = FNonZeroBitCount) then
  begin
   Result := BitPosition;
   Exit;
  end;

 i := 0; // byte number
 n := 0; // bits count
 while (n+FBitsTable[PByte(FBits + i)^] <= BitPosition) do
  begin
   Inc(n,FBitsTable[PByte(FBits + i)^]);
   Inc(i);
  end;
 Result := i * 8;
 b := PByte(FBits + i)^;
 l := 7;
 if (i = (FBitCount div 8)) then
  l := (FBitCount mod 8)-1;
 for k := 0 to l do
  begin
   if ((b and (1 shl k)) <> 0) then Inc(n);
   if (n > BitPosition) then Break;
   Inc(Result);
  end;
end; // GetBitNoByBitPosition


//------------------------------------------------------------------------------
// returns position of bit = 1 by bit no in FBits array
//------------------------------------------------------------------------------
function TABSBitsArray.GetBitPositionByBitNo(BitNo: Integer): Integer;
var n,i,j:    Integer;
    b,k:      Byte;
begin

 if (BitNo >= FBitCount) then
  raise EABSException.Create(10429,ErrorLInvalidBitNo, [BitNo,FBitCount]);
 if (FBitCount = FNonZeroBitCount) then
  begin
   Result := BitNo;
   Exit;
  end;
 // number of byte with flags
 i := Integer(BitNo) div 8;
 Result := -1; // bits count
 for j := 0 to i-1 do
   Result := Result + FBitsTable[PByte(FBits + j)^];
 // scan last byte
 b := PByte(FBits + i)^;
 n := Integer(BitNo) mod 8;
 for k := 0 to n do
   if ((b and (1 shl k)) <> 0) then Inc(Result);
end; // GetBitPositionByBitNo


//------------------------------------------------------------------------------
// set all bits to 1
//------------------------------------------------------------------------------
procedure TABSBitsArray.SetAllBits;
var
    SizeInBytes: Integer;
begin
 if (FBitCount > 0) then
  begin
    SizeInBytes := (FBitCount div 8) + Integer((FBitCount mod 8) > 0);
    FillChar(FBits^,SizeInBytes,$FF);
  end;
  FNonZeroBitCount := FBitCount;
end; // SetAllBits


//------------------------------------------------------------------------------
// find any bit with specified value
//------------------------------------------------------------------------------
function TABSBitsArray.FindBit(Value: Boolean; var BitNo: Integer): Boolean;
var
  i: Integer;
begin
 {$IFDEF DEBUG_TRACE_ALL_ENGINE}aaWriteToLog('TABSBitsArray.Find1 start');{$ENDIF}
 try
  Result := False;
  if (FBitCount > 0) then
   for i := 0 to FBitCount-1 do
    if (GetBit(i) = Value) then
     begin
       Result := True;
       BitNo := i;
       break;
     end
  finally
   {$IFDEF DEBUG_TRACE_ALL_ENGINE}aaWriteToLog('TABSBitsArray.Find1 end');{$ENDIF}
  end;
end;// FindBit


//------------------------------------------------------------------------------
// Find
//------------------------------------------------------------------------------
function TABSBitsArray.Find(Restart,GoForward: Boolean; CurBitNo: Integer; var FoundBitNo: Integer): Boolean;
var
  i, step: Integer;
begin
 {$IFDEF DEBUG_TRACE_ALL_ENGINE}aaWriteToLog('TABSBitsArray.Find2 start');{$ENDIF}
 try
  { TODO : implement fast bit search }
    Result := False;
    if (GoForward) then
      step := 1
    else
      step := -1;

    if (Restart) then
      if (GoForward) then
        i := 0
      else
        i := FBitCount - 1
    else
      i := CurBitNo + step;

    while (i >= 0) and (i < FBitCount) do
      begin
        if (GetBit(i)) then
          begin
            FoundBitNo := i;
            Result := True;
            break;
          end;
        Inc(i, step);
      end;
  finally
   {$IFDEF DEBUG_TRACE_ALL_ENGINE}aaWriteToLog('TABSBitsArray.Find2 end');{$ENDIF}
  end;
end;// Find



////////////////////////////////////////////////////////////////////////////////
//
// Bits functions
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// return true if null flag is set (bit = 1)
//------------------------------------------------------------------------------
function CheckNullFlag(
          BitNo:       Integer; // number of bit to check
          NullFlags:   PChar // pointer to bits of null flags
                      ): Boolean;
begin
 Result := ((PByte(NullFlags+(BitNo div 8))^) and (1 shl (BitNo mod 8)) <> 0);
end; // CheckNullFlag


//------------------------------------------------------------------------------
// set or clear a null flag
//------------------------------------------------------------------------------
procedure SetNullFlag(
          ToSet:       Boolean; // if true - set bit = 1, otherwise set bit = 0
          BitNo:       Integer; // number of bit to check
          NullFlags:   PChar // pointer to bits of null flags
                     );
begin
  NullFlags := PChar(NullFlags + (BitNo div 8));
  if (ToSet) then
    PByte(NullFlags)^ := PByte(NullFlags)^ or (1 shl (BitNo mod 8))
  else
    PByte(NullFlags)^ := PByte(NullFlags)^ and (not (1 shl (BitNo mod 8)));
end; // SetNullFlag

{$IFNDEF D6H}

type

TGUID = record
  D1: LongWord;
  D2: Word;
  D3: Word;
  D4: array[0..7] of Byte;
end;

function CoCreateGuid(out guid: TGUID): HResult; stdcall; external 'ole32.dll' name 'CoCreateGuid';
function StringFromCLSID(const clsid: TGUID; out psz: PWideChar): HResult; stdcall;
  external 'ole32.dll' name 'StringFromCLSID';
procedure CoTaskMemFree(pv: Pointer); stdcall;
  external 'ole32.dll' name 'CoTaskMemFree';


function CreateGUID(out Guid: TGUID): HResult;
begin
  Result := CoCreateGuid(Guid);
end;

function GUIDToString(const GUID: TGUID): string;
var
  P: PWideChar;
begin
  if not Succeeded(StringFromCLSID(GUID, P)) then
    raise Exception.Create('StringFromCLSID failed');
  Result := P;
  CoTaskMemFree(P);
end;


{$ENDIF}



function GetTemporaryName(Prefix: String): String;
var
  G: TGUID;
begin
  CreateGUID(G);
  Result := Prefix + GUIDToString(G);
end; // GetTemporaryName

function BracketFieldName(name: String): String;
var
 b: Boolean;
 s: String;
 i: Integer;
begin
 b := (Pos(' ', name) > 0);
 if not b then
  begin
   s := UpperCase(name);
   for i := 0 to ABSMaxSQLReservedWords do
    if (s = ABSSQLReservedWords[i]) then
     begin
      b := True;
      Break;
     end;
  end;
 if b then
  Result := '['+name+']'
 else
  Result := name;
end;



end.