abstypes.pas

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

//------------------------------------------------------------------------------
// Set length of array to specified size
//------------------------------------------------------------------------------
procedure TABSIntegerArray.Assign(v: TABSIntegerArray);
var
  i: Integer;
begin
  SetSize(v.ItemCount);
  for i := 0 to ItemCount-1 do
    items[i] := v.items[i];
end;// Assign


//------------------------------------------------------------------------------
// Set length of array to specified size
//------------------------------------------------------------------------------
procedure TABSIntegerArray.SetSize(newSize: Integer);
begin
 if (newSize = 0) then
  begin
   ItemCount := 0;
   allocItemCount := 0;
   Items := nil;
   Exit;
  end;

 if (newSize > allocItemCount) then
  begin
     AllocBy := AllocBy * 2;
     if (AllocBy > MaxAllocBy) then
      AllocBy := MaxAllocBy;
     if (allocItemCount + AllocBy > newSize) then
      allocItemCount := allocItemCount + AllocBy
     else
      allocItemCount := newSize;
     SetLength(Items,allocItemCount);
  end
 else
  if (newSize < ItemCount) then
   if (allocItemCount-newSize > deAllocBy) then
    begin
     deAllocBy := deAllocBy * 2;
     if (deAllocBy > MaxAllocBy) then
      deAllocBy := MaxAllocBy;
     SetLength(Items,newSize);
     allocItemCount := newSize;
    end;

 ItemCount := newSize;
end;//TABSIntegerArray.SetSize


//------------------------------------------------------------------------------
// inserts an element to the end of items array
//------------------------------------------------------------------------------
procedure TABSIntegerArray.Append(value: Integer);
begin
 SetSize(itemCount + 1);
 Items[itemCount-1] := value;
end;//TABSIntegerArray.Append


//------------------------------------------------------------------------------
// Insert an element into specified position
//------------------------------------------------------------------------------
procedure TABSIntegerArray.Insert(itemNo: Integer; value: Integer);
begin
 inc(ItemCount);
 SetSize(ItemCount);
 if (itemCount <= 1) then
  items[0] := value
 else
 if (itemNo >= itemCount-1)
  then
   items[itemCount-1] := value
  else
   begin
    Move(items[itemNo],items[itemNo+1],
        (itemCount - itemNo-1) * sizeOf(Integer));
    items[itemNo] := value;
   end;
end;//TABSIntegerArray.Insert


//------------------------------------------------------------------------------
// Delete an element at specified position
//------------------------------------------------------------------------------
procedure TABSIntegerArray.Delete(itemNo: Integer);
begin
 if (itemNo < itemCount-1) then
  Move(items[itemNo+1],items[itemNo],
      (itemCount - itemNo-1) * sizeOf(Integer));
 dec(ItemCount);
 SetSize(ItemCount);
end;//TABSIntegerArray.Delete


//------------------------------------------------------------------------------
// moves element to new position
//------------------------------------------------------------------------------
procedure TABSIntegerArray.MoveTo(itemNo, newItemNo: Integer);
var value : Integer;
begin
 if (itemNo = newItemNo) then
  Exit;
 if (itemNo - newItemNo = 1) or (newItemNo-itemNo = 1) then
  begin
   value := items[itemNo];
   items[itemNo] := items[newItemNo];
   items[newItemNo] := value;
   Exit;
  end;
 if (itemNo > newItemNo) then
  begin
   value := items[itemNo];
   Move(PChar(items[newItemNo]),PChar(items[newItemNo+1]),
        (itemNo-newItemNo) * sizeof(Integer));
   items[newItemNo] := value;
  end
 else
  begin
     value := items[ItemNo];
     Move(PChar(items[ItemNo+1]),PChar(items[ItemNo]),
        (newItemNo-ItemNo-1) * sizeof(Integer));
     items[newItemNo-1] := value;
  end;
end;// MoveTo(itemNo, newItemNo : Integer);


//------------------------------------------------------------------------------
// copies itemCount elements to ar from ItmeNo
//------------------------------------------------------------------------------
procedure TABSIntegerArray.CopyTo(
                      var ar: array of Integer;
                      itemNo, iCount: Integer
                             );
begin
 if (itemCount > 0) then
  Move (PChar(items[itemNo]),PChar(ar[0]),sizeOf(Integer)*iCount);
end;// CopyTo(ar : array of Integer; itemNo,itemCount : Integer);


//------------------------------------------------------------------------------
// returns true if value exists in Items array
//------------------------------------------------------------------------------
function TABSIntegerArray.IsValueExists(value: Integer): Boolean;
var i: Integer;
begin
 Result := false;
 for i := 0 to ItemCount-1 do
  if Items[i] = value then
   begin
    Result := true;
    break;
   end;
end; // IsValueExists

function TABSIntegerArray.IndexOf(value: Integer): Integer;
var i: Integer;
begin
 Result := -1;
 for i := 0 to ItemCount-1 do
  if Items[i] = value then
   begin
    Result := i;
    break;
   end;
end;



////////////////////////////////////////////////////////////////////////////////
//
// TABSCompressedStreamBlockHeadersArray
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// Construct array of specified size
//------------------------------------------------------------------------------
constructor TABSCompressedStreamBlockHeadersArray.Create;
begin
 AllocBy := 10; // default alloc
 DeAllocBy := 10; // default alloc
 MaxAllocBy := 10000; // max alloc
 AllocItemCount := 0;
 ItemCount := 0;
 SetSize(0);
end; // Create


//------------------------------------------------------------------------------
// Destruct array (free mem)
//------------------------------------------------------------------------------
destructor TABSCompressedStreamBlockHeadersArray.Destroy;
begin
 SetSize(0);
 inherited Destroy;
end;//Destroy;


//------------------------------------------------------------------------------
// Set length of array to specified size
//------------------------------------------------------------------------------
procedure TABSCompressedStreamBlockHeadersArray.SetSize(NewSize: Int64);
begin
 if (NewSize = 0) then
  begin
   ItemCount := 0;
   allocItemCount := 0;
   Items := nil;
   Positions := nil;
   Exit;
  end;

 if (NewSize > allocItemCount) then
  begin
     AllocBy := AllocBy * 2;
     if (AllocBy > MaxAllocBy) then
      AllocBy := MaxAllocBy;
     if (allocItemCount + AllocBy > NewSize) then
      allocItemCount := allocItemCount + AllocBy
     else
      allocItemCount := NewSize;
     SetLength(Items,allocItemCount);
     SetLength(Positions,allocItemCount);
  end
 else
  if (NewSize < ItemCount) then
   if (allocItemCount-NewSize > deAllocBy) then
    begin
     deAllocBy := deAllocBy * 2;
     if (deAllocBy > MaxAllocBy) then
      deAllocBy := MaxAllocBy;
     SetLength(Items,NewSize);
     SetLength(Positions,NewSize);
     allocItemCount := NewSize;
    end;
 ItemCount := NewSize;
end;// SetSize


//------------------------------------------------------------------------------
// Finds block containing specified position in user data
//------------------------------------------------------------------------------
function TABSCompressedStreamBlockHeadersArray.FindPosition(Pos: Int64) : Integer;
var i,dx,f,
    oldRes,res: Int64;

 function Compare: Integer;
 begin
  //---------------------------- start of compare -----------------------------------
       // by parent
       if (Positions[i] = pos) then
        Result := 0
       else
        if (Positions[i] < pos) then
         Result := 1
        else
         Result := -1;
  //---------------------------- end of compare -----------------------------------
 end;

begin

 i := ItemCount shr 1;
 dx := i;
 Result := 0;
 if (ItemCount <= 0) then
  begin
   Result := 0;
   Exit;
  end;
  f := 0;
  res := 2;
  while (true) do
   begin
    dx := dx shr 1;
    if (dx < 1) then dx := 1;
     oldRes := res;
     // compare, ascending
     res := Compare;
    if (res < 0) then
     begin
      //  element, specified by value should be higher then current element (+->0)
      i := i - dx;
     end
    else
    if (res > 0) then
     begin
      //  element, specified by value should be lower then current element (+->0)
      i := i + dx;
     end
    else
     begin
      // values are equal
      Result := i;
      break;
     end;
    if  (i < 0) and (dx = 1) then
     begin
      // equal not found
      Result := 0;
      break;
     end;
    if  (i > ItemCount-1) and (dx = 1) then
     begin
      // equal not found
      Result := ItemCount;
      break;
     end;

    if  (i > ItemCount-1) then
     i := ItemCount-1;
    if  i < 0 then
     i := 0;

    if (dx = 1) and (f > 1) then
     begin
      // dx minimum
      // compare, ascending
      res := Compare;
      if (res < 0) and (oldRes > 0) then
       Result := i;
      if (res > 0) and (oldRes < 0) then
       Result := i+1;
      if (res = oldRes) then
       continue;
      break;
     end;// last step
    if (res <> oldRes) and (dx = 1) and (oldRes <> 2) then
     inc(f);
  end;//while dx
 if (Result >= ItemCount) then
     Result := ItemCount-1;
 if (Result > 0) then
  if (Positions[Result] > pos) then
   dec(Result);
 if (Result < 0) then
   Result := 0;
end; //FindPosition


//------------------------------------------------------------------------------
// Insert an element into specified position
//------------------------------------------------------------------------------
procedure TABSCompressedStreamBlockHeadersArray.AppendItem(Value: TABSCompressedStreamBlockHeader; Pos: Int64);
begin
 Inc(ItemCount);
 SetSize(ItemCount);
 Items[ItemCount-1] := value;
 Positions[ItemCount-1] := pos;
end; // AppendItem


////////////////////////////////////////////////////////////////////////////////
//
// TABSBitsArray
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// return number of bits = 1
//------------------------------------------------------------------------------
function TABSBitsArray.GetNonZeroBitCount: Integer;
var i: Integer;
begin
 Result := 0;
 if (FBitCount > 0) then
  for i := 0 to FBitCount - 1 do
   if (GetBit(i)) then
    Inc(Result);
end; // GetNonZeroBitCount


//------------------------------------------------------------------------------
// set new size
//------------------------------------------------------------------------------
procedure TABSBitsArray.SetSize(NewSize: Integer);
var
  SizeInBytes: Integer;
begin
  SizeInBytes := (NewSize div 8) + Integer((NewSize mod 8) > 0);
  if (NewSize = 0) then
   begin
    if (FBits <> nil) then