unit DbcHandler;
interface
uses
Windows, Classes, SysUtils, Dialogs, AcedContainers, Variants, IniFiles, StrUtils;
type
TKeyType = (ktIntArray,ktStringHT,ktIntHT);
TOutStringArray=record
OutString: string;
offset: integer;
end;
TFieldTypesRecord=record
name,kind: string;
kind_int: string;
hex: boolean;
end;
TDbcHandler = class
private
FName: string;
FFieldCount,FRowCount,FTextLength,FRowLength,FKeyFieldNumber,FKeyFieldNumber2,
max_ID,toReplaceCount: integer;
KeyType: TKeyType;
int_values_arr: array of integer; //value array
str_values_arr: array of char;
link_recordNumber2offset_arr: array of integer; //links to values from string HT
link_Id2offset_arr: array of integer; //links by ID
link2replace: array of integer;
str_fields_numbers: array of integer;
procedure Add2ReplaceArr(offs: integer);
procedure GetIniSettings(DbcIniFName: string);
procedure PutStringByOffset(value: string; int_offset,
column_number: integer);
public
DbcHT: TIntegerHashtable; //offsets by integer key
DbcStrHT: TStringHashtable; //offsets by string key
function GetStringByOffset(offset: integer): string;
procedure LoadDbcArray(DbcFileName: string; KeyFieldNumber,KeyFieldNumber2: integer; ktType: TKeyType);
procedure SaveDbc;
function ContainStrKey(value: string): boolean;
function ContainIntKey(value: integer): boolean;
function GetIntValueByStrKey(key: string; column_number: integer): integer;
function GetIntValueByIntKey(key, column_number: integer): integer;
function GetStrValueByStrKey(key: string; column_number: integer): string;
function GetStrValueByIntKey(key, column_number: integer): string;
function GetSingleValueByIntKey(key, column_number: integer): single;
function GetSingleValueByStrKey(key: string; column_number: integer): single;
function GetPRValueByStrKey(key: string; PR: pointer):integer;
function GetPointerPRValueByStrKey(key: string):pointer;
function GetPRValueByIntKey(key: integer; PR: pointer): integer;
function GetPointerPRValueByIntKey(key: integer):pointer;
function Get2arrayByIntKey(key, column_number: integer; buff: pointer;
bytesgetlen: integer): integer;
procedure SetIntValueByIntKey(key, column_number, value: integer);
procedure SetIntValueByStrKey(key: string; column_number, value: integer);
function SetPRValueByIntKey(key: integer; PR: pointer): integer;
function SetPRValueByStrKey(key: string; PR: pointer): integer;
procedure SetSingleValueByIntKey(key, column_number: integer; value: single);
procedure SetSingleValueByStrKey(key: string; column_number: integer; value: single);
procedure SetStrValueByIntKey(key, column_number: integer; value: string);
procedure SetStrValueByStrKey(key: string; column_number: integer; value: string);
function AddRecord(data: array of variant):integer;
function AddArray(data: pointer; bytes_arr_len: integer): integer;
procedure RemoveRecordIntKey(key: integer);
procedure RemoveRecordStrKey(key: string);
procedure Add2arrayWholeWithStrings(key, first_column: integer; var mod_arr; var offs: integer);
published
property MaxID: integer read max_ID;
end;
function PJWStringHash(const Key: String; TableHigh: Integer): integer;
var
CharBuffer: array[0..4095]of char;
const
maxlinkarr_size = $100000;
implementation
uses UnitMain, ByteArrayHandler;
function PJWStringHash(const Key: String; TableHigh: Integer): integer;
var
Hash, G: Longint;
i: integer;
begin
hash:=0;
for i:=1 to length(Key) do
begin
Hash:=(Hash shl 4)+ord(Key[i]);
G:=Hash and longint($F0000000);
if (G<>0) then Hash:=(Hash xor (G shl 24) xor G);
end;
Result:=hash mod TableHigh;
end;
function TDbcHandler.GetStringByOffset(offset: integer): string; //ready offset in strings
var
presult: PChar;
begin
try
presult:=@str_values_arr[offset];
result:=strpas(presult);
except AddToLog('GetStringByOffset exception, offset='+IntToStr(offset));
end;
end;
procedure TDbcHandler.GetIniSettings(DbcIniFName: string);
var
DbcIni: TIniFile;
i,rec_count,str_f_count: integer;
promTString: TStringList;
field_kind,iniFName: string;
begin
iniFName:=AnsiReplaceStr(DbcIniFName,'.dbc','.ini');
iniFName:=AnsiReplaceStr(iniFName,'.mbc','.ini');
DbcIni:=TIniFile.Create(iniFName);
promTString:=TStringList.Create;
try
DbcIni.ReadSectionValues('Field name',promTString);
rec_count:=promTString.Count;
str_f_count:=0;
for i:=0 to pred(rec_count) do
begin
field_kind:=DbcIni.ReadString('Field kind','Field '+IntToStr(i),'ftInteger');
if field_kind='ftString' then
begin
inc(str_f_count);
setlength(str_fields_numbers,str_f_count);
str_fields_numbers[str_f_count-1]:=i;
end;
end;
finally DbcIni.Free;
promTString.Free;
end;
end;
procedure TDbcHandler.Add2ReplaceArr(offs: integer);
begin
inc(toReplaceCount);
setlength(link2replace,toReplaceCount);
link2replace[toReplaceCount-1]:=offs;
end;
procedure TDbcHandler.LoadDbcArray(DbcFileName: string; KeyFieldNumber,KeyFieldNumber2: integer; ktType: TKeyType); //KeyFieldNumber for HT only
var
i: integer;
InFile: TFileStream;
HeaderDbc: array[0..4]of integer;
row_count,field_count,row_length,text_length,
HeaderSizeInBytes,curr_max_ID,offs,promint: integer;
key_name: string;
function CheckAdd2Replace(curr_offs,curr_row: integer):boolean;
var
j: integer;
all_zero: boolean;
begin
j:=1;all_zero:=true;
while (j < field_count)and(all_zero) do
begin
if (int_values_arr[curr_offs+j] <> 0) then all_zero:=false;
inc(j);
end;
if all_zero then Add2ReplaceArr(curr_offs);
result:=all_zero;
end;
begin
FName:=DbcFileName;
GetIniSettings(DbcFileName);
InFile:=TFileStream.Create(DbcFileName,fmOpenRead);
try
//try
KeyType:=ktType;
HeaderSizeInBytes:=sizeof(HeaderDbc);
InFile.Read(HeaderDbc,HeaderSizeInBytes);
if HeaderDbc[0]=$43424457 then
begin
row_count:=HeaderDbc[1];
field_count:=HeaderDbc[2];
row_length:=HeaderDbc[3];
text_length:=HeaderDbc[4];
FRowCount:=row_count;
FFieldCount:=field_count;
FRowLength:=row_length;
FTextLength:=text_length;
FKeyFieldNumber:=KeyFieldNumber;
FKeyFieldNumber2:=KeyFieldNumber2;
if (KeyFieldNumber >= field_count)or(KeyFieldNumber2 >= field_count) then
raise Exception.Create('KeyFieldNumber not in field count');
setlength(int_values_arr,row_count*field_count);
InFile.Seek(20,soFromBeginning);
InFile.Read(int_values_arr[0],row_count*row_length);
setlength(str_values_arr,text_length);
InFile.Seek(-text_length,soFromEnd);
InFile.Read(str_values_arr[0],text_length);
max_ID:=0;toReplaceCount:=0;
if ktType=ktIntArray then
begin
setlength(link_recordNumber2offset_arr,row_count);
setlength(link_Id2offset_arr,maxlinkarr_size);
for i:=0 to pred(maxlinkarr_size) do link_Id2offset_arr[i]:=-1;
for i:=0 to pred(row_count) do
begin
offs:=i*field_count;
curr_max_ID:=int_values_arr[offs]; //ID
if (curr_max_ID > max_ID) then max_ID:=curr_max_ID;
link_recordNumber2offset_arr[i]:=offs;
if not(CheckAdd2Replace(offs,i))then
link_Id2offset_arr[int_values_arr[offs]]:=offs;
end;
setlength(link_Id2offset_arr,max_ID+1);
end
else if ktType=ktStringHT then begin
setlength(link_recordNumber2offset_arr,row_count);
DbcStrHT:=TStringHashtable.Create(false,row_count);
for i:=0 to pred(row_count) do
begin
offs:=i*field_count;
curr_max_ID:=int_values_arr[offs]; //ID
if (curr_max_ID > max_ID) then max_ID:=curr_max_ID;
link_recordNumber2offset_arr[i]:=offs;
if not(CheckAdd2Replace(offs,i))then
try
key_name:=GetStringByOffset(int_values_arr[offs+KeyFieldNumber]);
if (key_name <> '') then DbcStrHT.Add(AnsiUpperCase(key_name),@link_recordNumber2offset_arr[i]);
except;
end;
end;
end
else begin //integer HT
setlength(link_recordNumber2offset_arr,row_count);
DbcHT:=TIntegerHashtable.Create(row_count);
for i:=0 to pred(row_count) do
begin
offs:=i*field_count;
curr_max_ID:=int_values_arr[offs]; //ID
if (curr_max_ID > max_ID) then max_ID:=curr_max_ID;
link_recordNumber2offset_arr[i]:=offs;
if not(CheckAdd2Replace(offs,i))then
try
if FKeyFieldNumber2 >= 0 then
promint:=(int_values_arr[offs+FKeyFieldNumber] shl 16)or(int_values_arr[offs+FKeyFieldNumber2] and $FFFF)
else promint:=int_values_arr[offs+FKeyFieldNumber];
DbcHT.Add(promint,@link_recordNumber2offset_arr[i]);
except;
end;
end;
end;
end;
//except ShowMessage('Some problems with '+DbcFileName+' or not found');
//end;
finally InFile.Free;
end;
end;
procedure TDbcHandler.SaveDbc;
var
OutFile: TFileStream;
HeaderDbc: array[0..4]of integer;
i,j,str_fields_numbers_last,HeaderSizeInBytes,
max_string_number,loffs,promstrlen: integer;
OutStringArray: array of char;
StringHT: TStringHashtable;
string_offsets: array of integer;
promstr: string;
pinteger: ^integer;
begin
try
//rebuild strings
if (str_fields_numbers<>nil)and(length(str_fields_numbers)<>0)then
begin
setlength(string_offsets,$1000000);
max_string_number:=1;
string_offsets[max_string_number]:=1;
setlength(OutStringArray,length(str_values_arr));
str_fields_numbers_last:=length(str_fields_numbers)-1;
StringHT:= TStringHashtable.Create(true,FRowCount);
for i:=0 to pred(FRowCount)do
begin
for j:=0 to str_fields_numbers_last do
begin
loffs:=link_recordNumber2offset_arr[i]+str_fields_numbers[j];
promstr:=trim(GetStringByOffset(int_values_arr[loffs]));
if promstr='' then int_values_arr[loffs]:=0
else if (StringHT.Contains(promstr))then
begin
pinteger:=StringHT[promstr];
int_values_arr[loffs]:=pinteger^;
end
else begin
int_values_arr[loffs]:=string_offsets[max_string_number];
StringHT.Add(promstr,@string_offsets[max_string_number]);
promstrlen:=length(promstr);
move((@promstr[1])^,(@OutStringArray[string_offsets[max_string_number]])^,promstrlen);
inc(max_string_number);
string_offsets[max_string_number]:=string_offsets[max_string_number-1]+promstrlen+1;
end;
end;
end;
move(OutStringArray[0],str_values_arr[0],string_offsets[max_string_number]);
setlength(str_values_arr,string_offsets[max_string_number]);
StringHT.Free;
end;
if (int_values_arr <> nil)then
begin
OutFile:=TFileStream.Create(FName,fmCreate);
try
HeaderSizeInBytes:=sizeof(HeaderDbc);
HeaderDbc[0]:=$43424457;
HeaderDbc[1]:=FRowCount;
HeaderDbc[2]:=FFieldCount;
HeaderDbc[3]:=FRowLength;
HeaderDbc[4]:=length(str_values_arr);
OutFile.Write(HeaderDbc,HeaderSizeInBytes);
OutFile.Write(int_values_arr[0],FRowCount*FRowLength);
OutFile.Write(str_values_arr[0],length(str_values_arr));
except;
end;
OutFile.Free;
end;
OutStringArray:=nil;
string_offsets:=nil;
except AddToLog('SveDbc exception, file='+FName);
end;
end;
function TDbcHandler.ContainStrKey(value: string):boolean;
begin
result:=false;
if (KeyType=ktStringHT) then result:=DbcStrHT.Contains(value);
end;
function TDbcHandler.ContainIntKey(value: integer):boolean;
begin
result:=false;
if (KeyType=ktIntHT)then result:=DbcHT.Items[value]<>nil
else if (KeyType=ktIntArray)and(value >= 0)and(value <= max_ID) then result:=true;
end;
function TDbcHandler.GetStrValueByStrKey(key: string; column_number: integer):string;
var
ppos: ^integer;
begin
try
result:='';
if (KeyType=ktStringHT) then
begin
ppos:=DbcStrHT[key];
result:=GetStringByOffset(int_values_arr[ppos^+column_number]);
end;
except AddToLog('GetStrValueByStrKey exception, key='+key+' column='+IntToStr(column_number));
end;
end;
function TDbcHandler.GetStrValueByIntKey(key: integer; column_number: integer):string;
var
ppos: ^integer;
link: integer;
begin
try
result:='';
if (KeyType=ktIntHT)then
begin
ppos:=DbcHT[key];
result:=GetStringByOffset(int_values_arr[ppos^+column_number]);
end
else if (KeyType=ktIntArray)and(key >= 0)and(column_number < FFieldCount)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then result:=GetStringByOffset(int_values_arr[link+column_number]);
end;
except AddToLog('GetStrValueByIntKey exception, key='+IntToStr(key)+' column='+IntToStr(column_number));
end;
end;
function TDbcHandler.GetIntValueByStrKey(key: string; column_number: integer):integer;
var
ppos: ^integer;
begin
result:=-1;
try
if (KeyType=ktStringHT) then //and(DbcStrHT.Contains(key))
begin
ppos:=DbcStrHT[key];
if ppos<>nil then
result:=int_values_arr[ppos^+column_number];
end;
except AddToLog('GetIntValueByStrKey exception, key='+key+' column='+IntToStr(column_number));
end;
end;
function TDbcHandler.GetIntValueByIntKey(key: integer; column_number: integer):integer;
var
ppos: ^integer;
link: integer;
begin
result:=-1;
try
if (KeyType=ktIntHT) then //and(DbcHT.Contains(key))
begin
ppos:=DbcHT[key];
if ppos<>nil then
result:=int_values_arr[ppos^+column_number];
end
else if (KeyType=ktIntArray)and(key >= 0)and(column_number < FFieldCount)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then result:=int_values_arr[link+column_number];
end;
except AddToLog('GetIntValueByIntKey exception, key='+IntToStr(key)+' column='+IntToStr(column_number));
end;
end;
{ pointers to Packed Records }
function TDbcHandler.GetPRValueByStrKey(key: string; PR: pointer):integer;
var
ppos: ^integer;
begin
result:=0;
try
if (KeyType=ktStringHT) then //and(DbcStrHT.Contains(key))
begin
ppos:=DbcStrHT[key];
if ppos<>nil then
begin
result:=FFieldCount shl 2;
move((@int_values_arr[ppos^])^,PR^,result);
end;
end;
except AddToLog('GetPRValueByStrKey exception, key='+key);
end;
end;
function TDbcHandler.GetPointerPRValueByStrKey(key: string):pointer;
begin
//result:=nil;
try
if (KeyType=ktStringHT) then result:=DbcStrHT[key]; //and(DbcStrHT.Contains(key))
except AddToLog('GetPointerPRValueByStrKey exception, key='+key);
end;
end;
function TDbcHandler.GetPRValueByIntKey(key: integer; PR: pointer):integer;
var
ppos: ^integer;
link: integer;
begin
result:=0;
try
if (KeyType=ktIntHT)then
begin
ppos:=DbcHT[key];
result:=FFieldCount shl 2;
move((@int_values_arr[ppos^])^,PR^,result);
end
else if (KeyType=ktIntArray)and(key >= 0)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then
begin
result:=FFieldCount shl 2;
move((@int_values_arr[link])^,PR^,result);
end;
end;
except AddToLog('GetPRValueByIntKey exception, key='+IntToStr(key));
end;
end;
function TDbcHandler.GetPointerPRValueByIntKey(key: integer):pointer;
var
link: integer;
ppos: ^integer;
begin
result:=nil;
try
if (KeyType=ktIntHT)then
begin
ppos:=DbcHT[key];
if ppos<>nil then //DbcHT.Contains(key)
result:=@int_values_arr[ppos^];
end
else if (KeyType=ktIntArray)and(key >= 0)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then result:=@int_values_arr[link];
end;
except AddToLog('GetPointerPRValueByIntKey exception, key='+IntToStr(key));
end;
end;
function TDbcHandler.GetSingleValueByStrKey(key: string; column_number: integer):single;
var
ppos: ^integer;
psingle: ^single;
begin
result:=-1;
try
if (KeyType=ktStringHT) then //and(DbcStrHT.Contains(key))
begin
ppos:=DbcStrHT[key];
if ppos<>nil then
begin
psingle:=@int_values_arr[ppos^+column_number];
result:=psingle^;
end;
end;
except AddToLog('GetSingleValueByStrKey exception, key='+key+' column='+IntToStr(column_number));
end;
end;
function TDbcHandler.GetSingleValueByIntKey(key: integer; column_number: integer):single;
var
ppos: ^integer;
psingle: ^single;
link: integer;
begin
result:=-1;
try
if (KeyType=ktIntHT) then //and(DbcHT.Contains(key))
begin
ppos:=DbcHT[key];
if ppos<>nil then
begin
psingle:=@int_values_arr[ppos^+column_number];
result:=psingle^;
end;
end
else if (KeyType=ktIntArray)and(key >= 0)and(column_number < FFieldCount)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then
begin
psingle:=@int_values_arr[link+column_number];
result:=psingle^;
end;
end;
except AddToLog('GetSingleValueByIntKey exception, key='+IntToStr(key)+' column='+IntToStr(column_number));
end;
end;
function TDbcHandler.Get2arrayByIntKey(key: integer; column_number: integer; buff: pointer; bytesgetlen: integer):integer;
var
ppos: ^integer;
link: integer;
begin
result:=-1;
try
if (KeyType=ktIntHT) then //and(DbcHT.Contains(key))
begin
ppos:=DbcHT[key];
if ppos<>nil then
begin
move(int_values_arr[ppos^+column_number],buff^,bytesgetlen);
result:=bytesgetlen;
end;
end
else if (KeyType=ktIntArray)and(key >= 0)and(column_number < FFieldCount)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then
begin
move(int_values_arr[link+column_number],buff^,bytesgetlen);
result:=bytesgetlen;
end;
end;
except AddToLog('Get2arrayByIntKey exception, key='+IntToStr(key)+' column='+IntToStr(column_number));
end;
end;
procedure TDbcHandler.PutStringByOffset(value: string; int_offset, column_number: integer);
var
j,new_str_offset: integer;
promstr: string;
begin
promstr:=trim(value);
if (promstr = '') then int_values_arr[int_offset+column_number]:=0
else begin
new_str_offset:=length(str_values_arr);
setlength(str_values_arr,new_str_offset+succ(length(promstr)));
for j:=1 to length(promstr) do str_values_arr[new_str_offset+j-1]:=promstr[j];
int_values_arr[int_offset+column_number]:=new_str_offset;
end;
end;
procedure TDbcHandler.SetStrValueByStrKey(key: string; column_number: integer; value: string);
var
ppos: ^integer;
begin
try
if (KeyType=ktStringHT) then
begin
ppos:=DbcStrHT[key];
PutStringByOffset(value,ppos^,column_number);
end;
except AddToLog('SetStrValueByStrKey exception, key='+key+' column='+IntToStr(column_number));
end;
end;
procedure TDbcHandler.SetStrValueByIntKey(key: integer; column_number: integer; value: string);
var
ppos: ^integer;
link: integer;
begin
try
if (KeyType=ktIntHT)then
begin
ppos:=DbcHT[key];
PutStringByOffset(value,ppos^,column_number);
end
else if (KeyType=ktIntArray)and(key >= 0)and(column_number < FFieldCount)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then PutStringByOffset(value,int_values_arr[link],column_number);
end;
except AddToLog('SetStrValueByIntKey exception, key='+IntToStr(key)+' column='+IntToStr(column_number));
end;
end;
procedure TDbcHandler.SetIntValueByStrKey(key: string; column_number, value: integer);
var
ppos: ^integer;
begin
try
if (KeyType=ktStringHT) then //and(DbcStrHT.Contains(key))
begin
ppos:=DbcStrHT[key];
if ppos<>nil then
int_values_arr[ppos^+column_number]:=value;
end;
except AddToLog('SetIntValueByStrKey exception, key='+key+' column='+IntToStr(column_number));
end;
end;
procedure TDbcHandler.SetIntValueByIntKey(key: integer; column_number, value: integer);
var
ppos: ^integer;
link: integer;
begin
try
if (KeyType=ktIntHT) then //and(DbcHT.Contains(key))
begin
ppos:=DbcHT[key];
if ppos<>nil then
int_values_arr[ppos^+column_number]:=value;
end
else if (KeyType=ktIntArray)and(key >= 0)and(column_number < FFieldCount)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then int_values_arr[link+column_number]:=value;
end;
except AddToLog('SetIntValueByIntKey exception, key='+IntToStr(key)+' column='+IntToStr(column_number));
end;
end;
function TDbcHandler.SetPRValueByStrKey(key: string; PR: pointer):integer;
{var TODO
ppos: ^integer;}
begin
result:=0;
{try
if (KeyType=ktStringHT) then //and(DbcStrHT.Contains(key))
begin
ppos:=DbcStrHT[key];
if ppos<>nil then
begin
result:=FFieldCount shl 2;
move((@int_values_arr[ppos^])^,PR^,result);
end;
end;
except AddToLog('SetPRValueByStrKey exception, key='+key);
end;}
end;
function TDbcHandler.SetPRValueByIntKey(key: integer; PR: pointer):integer;
{var TODO
ppos: ^integer;
link: integer; }
begin
result:=0;
{try
if (KeyType=ktIntHT)then
begin
ppos:=DbcHT[key];
result:=FFieldCount shl 2;
move((@int_values_arr[ppos^])^,PR^,result);
end
else if (KeyType=ktIntArray)and(key >= 0)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then
begin
result:=FFieldCount shl 2;
move((@int_values_arr[link])^,PR^,result);
end;
end;
except AddToLog('SetPRValueByIntKey exception, key='+IntToStr(key));
end;}
end;
procedure TDbcHandler.SetSingleValueByStrKey(key: string; column_number: integer; value :single);
var
ppos,pint: ^integer;
begin
try
if (KeyType=ktStringHT) then //and(DbcStrHT.Contains(key))
begin
ppos:=DbcStrHT[key];
if ppos<>nil then
begin
pint:=@value;
int_values_arr[ppos^+column_number]:=pint^;
end;
end;
except AddToLog('SetSingleValueByStrKey exception, key='+key+' column='+IntToStr(column_number));
end;
end;
procedure TDbcHandler.SetSingleValueByIntKey(key: integer; column_number: integer; value: single);
var
ppos,pint: ^integer;
link: integer;
begin
try
if (KeyType=ktIntHT) then //and(DbcHT.Contains(key))
begin
ppos:=DbcHT[key];
if ppos<>nil then
begin
pint:=@value;
int_values_arr[ppos^+column_number]:=pint^;
end;
end
else if (KeyType=ktIntArray)and(key >= 0)and(column_number < FFieldCount)and(key <= max_ID) then
begin
link:=link_Id2offset_arr[key];
if link>=0 then
begin
pint:=@value;
int_values_arr[+column_number]:=pint^;
end;
end;
except AddToLog('SetSingleValueByIntKey exception, key='+IntToStr(key)+' column='+IntToStr(column_number));
end;
end;
function TDbcHandler.AddRecord(data: array of variant):integer;
var
i,last_iter,new_int_offset,insert2row: integer;
key_name: string;
promsingle: single;
//promdouble: double;
pint: ^integer;
//pint64: ^int64;
begin
result:=0;
try
last_iter:=length(data);
if (FFieldCount < last_iter) then last_iter:=FFieldCount;
new_int_offset:=length(int_values_arr);
insert2row:=FRowCount;
if toReplaceCount > 0 then
begin
new_int_offset:=link2replace[toReplaceCount-1];
dec(toReplaceCount);
setlength(link2replace,toReplaceCount);
insert2row:=new_int_offset div FFieldCount;
end
else begin
setlength(int_values_arr,new_int_offset+FFieldCount);
inc(FRowCount);
end;
inc(max_ID);
result:=max_ID;
int_values_arr[new_int_offset]:=max_ID;
i:=1;
while (i < last_iter) do //0 - ID, auto
begin
case VarType(data[i]) of
varString: PutStringByOffset(data[i],new_int_offset,i);
varDouble: begin //single through double %|
promsingle:=data[i];
pint:=@promsingle;
int_values_arr[new_int_offset+i]:=pint^;
end;
varEmpty : int_values_arr[new_int_offset+i]:=0;
else begin
int_values_arr[new_int_offset+i]:=data[i];
end;
end;
inc(i);
end;
if KeyType=ktIntArray then
begin
setlength(link_Id2offset_arr,max_ID+1);
link_Id2offset_arr[max_ID]:=new_int_offset;
setlength(link_recordNumber2offset_arr,FRowCount);
link_recordNumber2offset_arr[insert2row]:=new_int_offset;
end
else if KeyType=ktStringHT then begin
setlength(link_recordNumber2offset_arr,FRowCount);
link_recordNumber2offset_arr[insert2row]:=new_int_offset;
try
key_name:=GetStringByOffset(int_values_arr[new_int_offset+FKeyFieldNumber]);
if (key_name <> '') then DbcStrHT.Add(AnsiUpperCase(key_name),@link_recordNumber2offset_arr[insert2row]);
except;
end;
end
else begin
setlength(link_recordNumber2offset_arr,FRowCount);
link_recordNumber2offset_arr[insert2row]:=new_int_offset;
try
DbcHT.Add(int_values_arr[new_int_offset+FKeyFieldNumber],@link_recordNumber2offset_arr[insert2row]);
except;
end;
end;
FTextLength:=length(str_values_arr);
except AddToLog('AddRecord exception, variants');
end;
end;
function TDbcHandler.AddArray(data: pointer; bytes_arr_len: integer):integer; //starting from 0 pos, not for StringHT, result new ID
var
new_int_offset,insert2row,bytes_count: integer; //i,last_iter,
//pint: ^integer;
//pint64: ^int64;
//found: boolean;
//intList: array of integer;
begin
result:=0;
if KeyType=ktStringHT then exit;
try
{last_iter:=length(data);
if (FFieldCount < last_iter) then last_iter:=FFieldCount;}
new_int_offset:=length(int_values_arr);
insert2row:=FRowCount;
if toReplaceCount > 0 then
begin
new_int_offset:=link2replace[toReplaceCount-1];
dec(toReplaceCount);
setlength(link2replace,toReplaceCount);
insert2row:=new_int_offset div FFieldCount;
end
else begin
setlength(int_values_arr,new_int_offset+FFieldCount);
inc(FRowCount);
end;
inc(max_ID);
result:=max_ID;
bytes_count:=FRowLength;
if bytes_count>bytes_arr_len then bytes_count:=bytes_arr_len;
move(data^,int_values_arr[new_int_offset],bytes_count);
int_values_arr[new_int_offset]:=max_ID;
if KeyType=ktIntArray then
begin
setlength(link_Id2offset_arr,max_ID+1);
link_Id2offset_arr[max_ID]:=new_int_offset;
setlength(link_recordNumber2offset_arr,FRowCount);
link_recordNumber2offset_arr[insert2row]:=new_int_offset;
end
else if KeyType=ktIntHT then begin
setlength(link_recordNumber2offset_arr,FRowCount);
link_recordNumber2offset_arr[insert2row]:=new_int_offset;
try
DbcHT.Add(int_values_arr[new_int_offset+FKeyFieldNumber],@link_recordNumber2offset_arr[insert2row]);
except;
end;
end;
except AddToLog('AddArray exception');
end;
end;
procedure TDbcHandler.RemoveRecordStrKey(key: string);
var
i: integer;
ppos: ^integer;
begin
try
if (KeyType=ktStringHT) then
begin
ppos:=DbcStrHT[key];
Add2ReplaceArr(link_Id2offset_arr[int_values_arr[ppos^]]);
for i:=1 to pred(FFieldCount)do
int_values_arr[ppos^+i]:=0;
DbcStrHT.Remove(key);
end;
except AddToLog('RemoveRecordStrKey exception, key='+key);
end;
end;
procedure TDbcHandler.RemoveRecordIntKey(key: integer);
var
i: integer;
ppos: ^integer;
begin
try
if (KeyType=ktIntHT)then
begin
ppos:=DbcHT[key];
Add2ReplaceArr(link_Id2offset_arr[int_values_arr[ppos^]]);
for i:=1 to pred(FFieldCount)do
int_values_arr[ppos^+i]:=0;
DbcHT.Remove(key);
end
else if (KeyType=ktIntArray)and(key >= 0)and(key <= max_ID) then
begin
Add2ReplaceArr(link_Id2offset_arr[key]);
for i:=1 to pred(FFieldCount)do
int_values_arr[link_Id2offset_arr[key]+i]:=0;
end;
except AddToLog('RemoveRecordIntKey exception, key='+IntToStr(key));
end;
end;
//integer keys only
procedure TDbcHandler.Add2arrayWholeWithStrings(key, first_column: integer; var mod_arr; var offs: integer);
var
i,str_offs,key_offs,next_string_column,curr_column,move_count: integer;
ppos: ^integer;
begin
key_offs:=0;
if (KeyType=ktIntHT) then //and(DbcHT.Contains(key))
begin
ppos:=DbcHT[key];
if ppos<>nil then
key_offs:=ppos^;
end
else if (KeyType=ktIntArray)and(key >= 0)and(key <= max_ID) then
key_offs:=link_Id2offset_arr[key];
if key_offs>=0 then
begin
curr_column:=first_column;
for i:=0 to pred(length(str_fields_numbers)) do
begin
next_string_column:=str_fields_numbers[i];
if next_string_column < curr_column then continue
else if next_string_column = curr_column then
begin
str_offs:=int_values_arr[key_offs+next_string_column];
Add2byteArr(GetStringByOffset(str_offs),mod_arr,offs);
inc(curr_column);
end
else begin //next_string_column > curr_column
move_count:=(next_string_column - curr_column) shl 2;
move(int_values_arr[key_offs+curr_column],(@TBytes(mod_arr)[offs])^,move_count);
inc(offs,move_count);
curr_column:=next_string_column;
//now string
str_offs:=int_values_arr[key_offs+next_string_column];
Add2byteArr(GetStringByOffset(str_offs),mod_arr,offs);
inc(curr_column);
end;
end;
//fill rest
move_count:=pred(FFieldCount) - curr_column;
if move_count > 0 then
begin
move_count:=move_count shl 2;
move(int_values_arr[key_offs+curr_column],(@TBytes(mod_arr)[offs])^,move_count);
inc(offs,move_count);
end;
end;
end;
end.