?? myldbtypes.pas
字號:
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 TMYLDBBitsArray.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 TMYLDBBitsArray.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 EMYLDBException.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 TMYLDBBitsArray.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 TMYLDBBitsArray.Destroy;
begin
if (FBits <> nil) then
MemoryManager.FreeAndNillMem(FBits);
end;// Destroy
//------------------------------------------------------------------------------
// get bit value
//------------------------------------------------------------------------------
function TMYLDBBitsArray.GetBit(BitNo: Integer): Boolean;
begin
if (BitNo >= FBitCount) then
raise EMYLDBException.Create(10394,ErrorLInvalidBitNo,[BitNo,FBitCount]);
Result := CheckNullFlag(BitNo, FBits);
end;// GetBit
//------------------------------------------------------------------------------
// set bit value
//------------------------------------------------------------------------------
procedure TMYLDBBitsArray.SetBit(BitNo: Integer; Value: Boolean);
var Bit: Boolean;
begin
if (BitNo >= FBitCount) then
raise EMYLDBException.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 TMYLDBBitsArray.GetBitNoByBitPosition(BitPosition: Integer): Integer;
var i,n: Integer;
b,k,l: Byte;
begin
if (BitPosition >= FNonZeroBitCount) then
raise EMYLDBException.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 TMYLDBBitsArray.GetBitPositionByBitNo(BitNo: Integer): Integer;
var n,i,j: Integer;
b,k: Byte;
begin
if (BitNo >= FBitCount) then
raise EMYLDBException.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 TMYLDBBitsArray.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 TMYLDBBitsArray.FindBit(Value: Boolean; var BitNo: Integer): Boolean;
var
i: Integer;
begin
{$IFDEF DEBUG_TRACE_ALL_ENGINE}aaWriteToLog('TMYLDBBitsArray.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('TMYLDBBitsArray.Find1 end');{$ENDIF}
end;
end;// FindBit
//------------------------------------------------------------------------------
// Find
//------------------------------------------------------------------------------
function TMYLDBBitsArray.Find(Restart,GoForward: Boolean; CurBitNo: Integer; var FoundBitNo: Integer): Boolean;
var
i, step: Integer;
begin
{$IFDEF DEBUG_TRACE_ALL_ENGINE}aaWriteToLog('TMYLDBBitsArray.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('TMYLDBBitsArray.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 MYLDBMaxSQLReservedWords do
if (s = MYLDBSQLReservedWords[i]) then
begin
b := True;
Break;
end;
end;
if b then
Result := '['+name+']'
else
Result := name;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -