paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-28 15:01:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ Patch from Luiz Américo to fix several issues

Browse Source
This commit is contained in:
michael 2005-02-18 22:34:38 +00:00
parent 24a0d113f9
commit a21420401f
1 changed files with 187 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

379
fcl/db/sqlite/sqliteds.pas
View File

@ -40,7 +40,7 @@ type
Next: PDataRecord; Next: PDataRecord;
Previous: PDataRecord; Previous: PDataRecord;
end; end;
TSqliteDataset = class(TDataSet) TSqliteDataset = class(TDataSet)
private private
FFileName: String; FFileName: String;
@ -49,7 +49,7 @@ type
FIndexFieldName: String; FIndexFieldName: String;
FIndexFieldNo: Integer; FIndexFieldNo: Integer;
FAutoIncFieldNo: Integer; FAutoIncFieldNo: Integer;
FNextAutoInc:Integer; FNextAutoInc:Integer;
FCurrentItem: PDataRecord; FCurrentItem: PDataRecord;
FBeginItem: PDataRecord; FBeginItem: PDataRecord;
FEndItem: PDataRecord; FEndItem: PDataRecord;
@ -72,7 +72,6 @@ type
FOrphanItems: TList; FOrphanItems: TList;
procedure BuildLinkedList; procedure BuildLinkedList;
procedure DisposeLinkedList; procedure DisposeLinkedList;
procedure SetSql (AValue:String);
protected protected
function AllocRecordBuffer: PChar; override; function AllocRecordBuffer: PChar; override;
procedure FreeRecordBuffer(var Buffer: PChar); override; procedure FreeRecordBuffer(var Buffer: PChar); override;
@ -81,7 +80,7 @@ type
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function GetRecordCount: Integer; override; function GetRecordCount: Integer; override;
function GetRecNo: Integer; override; function GetRecNo: Integer; override;
function GetRecordSize: Word; override; function GetRecordSize: Word; override;
procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override; procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
procedure InternalClose; override; procedure InternalClose; override;
procedure InternalDelete; override; procedure InternalDelete; override;
@ -94,13 +93,13 @@ type
procedure InternalOpen; override; procedure InternalOpen; override;
procedure InternalPost; override; procedure InternalPost; override;
procedure InternalSetToRecord(Buffer: PChar); override; procedure InternalSetToRecord(Buffer: PChar); override;
function IsCursorOpen: Boolean; override; function IsCursorOpen: Boolean; override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetExpectedAppends(AValue:Integer); procedure SetExpectedAppends(AValue:Integer);
procedure SetExpectedUpdates(AValue:Integer); procedure SetExpectedUpdates(AValue:Integer);
procedure SetExpectedDeletes(AValue:Integer); procedure SetExpectedDeletes(AValue:Integer);
procedure SetFieldData(Field: TField; Buffer: Pointer); override; procedure SetFieldData(Field: TField; Buffer: Pointer); override;
procedure SetRecNo(Value: Integer); override; procedure SetRecNo(Value: Integer); override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -123,15 +122,15 @@ type
property ExpectedUpdates: Integer read FExpectedUpdates write SetExpectedUpdates; property ExpectedUpdates: Integer read FExpectedUpdates write SetExpectedUpdates;
property ExpectedDeletes: Integer read FExpectedDeletes write SetExpectedDeletes; property ExpectedDeletes: Integer read FExpectedDeletes write SetExpectedDeletes;
property SqliteReturnId: Integer read FSqliteReturnId; property SqliteReturnId: Integer read FSqliteReturnId;
published published
property FileName: String read FFileName write FFileName; property FileName: String read FFileName write FFileName;
property IndexFieldName: String read FIndexFieldName write FIndexFieldName; property IndexFieldName: String read FIndexFieldName write FIndexFieldName;
property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose; property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose;
property SQL: String read FSql write SetSql; property SQL: String read FSql write FSql;
property TableName: String read FTableName write FTableName; property TableName: String read FTableName write FTableName;
//property Active; //property Active;
property FieldDefs; property FieldDefs;
//Events //Events
property BeforeOpen; property BeforeOpen;
property AfterOpen; property AfterOpen;
@ -152,9 +151,9 @@ type
property OnDeleteError; property OnDeleteError;
property OnEditError; property OnEditError;
end; end;
procedure Register; procedure Register;
implementation implementation
uses SQLite; uses SQLite;
@ -166,13 +165,13 @@ begin
TempInt:=-1; TempInt:=-1;
if ColumnValues[0] <> nil then if ColumnValues[0] <> nil then
begin begin
Val(StrPas(ColumnValues[0]),TempInt,CodeError); Val(StrPas(ColumnValues[0]),TempInt,CodeError);
if CodeError <> 0 then if CodeError <> 0 then
DatabaseError('SqliteDs - Error trying to get last autoinc value'); DatabaseError('SqliteDs - Error trying to get last autoinc value');
end; end;
Integer(NextValue^):=Succ(TempInt); Integer(NextValue^):=Succ(TempInt);
Result:=1; Result:=1;
end; end;
function GetFieldDefs(TheDataset: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl; function GetFieldDefs(TheDataset: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
var var
@ -180,20 +179,19 @@ var
Counter:Integer; Counter:Integer;
AType:TFieldType; AType:TFieldType;
ColumnStr:String; ColumnStr:String;
TempAttributes:TFieldAttributes;
begin begin
// Sqlite is typeless (allows any type in any field) // Sqlite is typeless (allows any type in any field)
// regardless of what is in Create Table, but returns // regardless of what is in Create Table, but returns
// exactly what is in Create Table statement // exactly what is in Create Table statement
// here is a trick to get the datatype. // here is a trick to get the datatype.
// If the field contains another type, there will be problems // If the field contains another type, there will be problems
For Counter:= 0 to Columns - 1 do For Counter:= 0 to Columns - 1 do
begin begin
ColumnStr:= UpCase(StrPas(ColumnNames[Counter + Columns])); ColumnStr:= UpCase(StrPas(ColumnNames[Counter + Columns]));
If (ColumnStr = 'INTEGER') or (ColumnStr = 'INT') then If (ColumnStr = 'INTEGER') then
begin begin
AType:= ftInteger; AType:= ftInteger;
FieldSize:=SizeOf(Integer); FieldSize:=SizeOf(Integer);
end else if (ColumnStr = 'BOOLEAN') then end else if (ColumnStr = 'BOOLEAN') then
begin begin
AType:= ftBoolean; AType:= ftBoolean;
@ -220,37 +218,32 @@ begin
FieldSize:=SizeOf(TDateTime); FieldSize:=SizeOf(TDateTime);
end else if (ColumnStr = 'AUTOINC') then end else if (ColumnStr = 'AUTOINC') then
begin begin
//Todo: remove this check. do it in open
if TSqliteDataset(TheDataset).Tablename = '' then if TSqliteDataset(TheDataset).Tablename = '' then
DatabaseError('Sqliteds - AutoInc fields requires Tablename to be set'); DatabaseError('Sqliteds - AutoInc fields requires Tablename to be set');
AType:= ftAutoInc; AType:= ftAutoInc;
FieldSize:=SizeOf(Integer); FieldSize:=SizeOf(Integer);
if TSqliteDataset(TheDataset).FAutoIncFieldNo = -1 then if TSqliteDataset(TheDataset).FAutoIncFieldNo = -1 then
TSqliteDataset(TheDataset).FAutoIncFieldNo:= Counter; TSqliteDataset(TheDataset).FAutoIncFieldNo:= Counter;
end else end else
begin begin
AType:= ftString; AType:= ftString;
FieldSize:=0; FieldSize:=10; //??
end; end;
TDataset(TheDataset).FieldDefs.Add(StrPas(ColumnNames[Counter]), AType, FieldSize, False);
with TDataset(TheDataset).FieldDefs do
begin
Add(StrPas(ColumnNames[Counter]), AType, FieldSize, False);
If Items[Counter].Name = '_ROWID_' then
begin
TempAttributes:=Items[Counter].Attributes;
System.Include(TempAttributes,faReadonly);
Items[Counter].Attributes:=TempAttributes;
end;
end;
end; end;
result:=-1; result:=-1;
end; end;
// TSqliteDataset override methods // TSqliteDataset override methods
function TSqliteDataset.AllocRecordBuffer: PChar; function TSqliteDataset.AllocRecordBuffer: PChar;
var
APointer:Pointer;
begin begin
Result := AllocMem(FBufferSize); APointer := AllocMem(FBufferSize);
PDataRecord(APointer^):=FBeginItem;
Result:=APointer;
end; end;
procedure TSqliteDataset.BuildLinkedList; procedure TSqliteDataset.BuildLinkedList;
@ -263,23 +256,24 @@ begin
//Get AutoInc Field initial value //Get AutoInc Field initial value
if FAutoIncFieldNo <> -1 then if FAutoIncFieldNo <> -1 then
sqlite_exec(FSqliteHandle,PChar('Select Max('+Fields[FAutoIncFieldNo].FieldName+') from ' + FTableName), sqlite_exec(FSqliteHandle,PChar('Select Max('+Fields[FAutoIncFieldNo].FieldName+') from ' + FTableName),
@GetAutoIncValue,@FNextAutoInc,nil); @GetAutoIncValue,@FNextAutoInc,nil);
FSqliteReturnId:=sqlite_compile(FSqliteHandle,Pchar(FSql),nil,@vm,nil); FSqliteReturnId:=sqlite_compile(FSqliteHandle,Pchar(FSql),nil,@vm,nil);
if FSqliteReturnId <> SQLITE_OK then if FSqliteReturnId <> SQLITE_OK then
case FSqliteReturnId of case FSqliteReturnId of
SQLITE_ERROR: SQLITE_ERROR:
DatabaseError('Invalid Sql',Self); DatabaseError('Invalid Sql',Self);
else else
DatabaseError('Unknow Error',Self); DatabaseError('Unknow Error',Self);
end; end;
FDataAllocated:=True; FDataAllocated:=True;
New(FBeginItem); New(FBeginItem);
FBeginItem^.Next:=nil; FBeginItem^.Next:=nil;
FBeginItem^.Previous:=nil; FBeginItem^.Previous:=nil;
FBeginItem^.BookMarkFlag:=bfBOF;
TempItem:=FBeginItem; TempItem:=FBeginItem;
FRecordCount:=0; FRecordCount:=0;
FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames); FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames);
while FSqliteReturnId = SQLITE_ROW do while FSqliteReturnId = SQLITE_ROW do
begin begin
@ -289,29 +283,29 @@ begin
TempItem:=TempItem^.Next; TempItem:=TempItem^.Next;
GetMem(TempItem^.Row,FRowBufferSize); GetMem(TempItem^.Row,FRowBufferSize);
For Counter := 0 to FRowCount - 1 do For Counter := 0 to FRowCount - 1 do
TempItem^.Row[Counter]:=StrNew(ColumnValues[Counter]); TempItem^.Row[Counter]:=StrNew(ColumnValues[Counter]);
FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames); FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames);
end; end;
sqlite_finalize(vm, nil); sqlite_finalize(vm, nil);
// Init EndItem // Init EndItem
if FRecordCount <> 0 then if FRecordCount <> 0 then
begin begin
New(TempItem^.Next); New(TempItem^.Next);
TempItem^.Next^.Previous:=TempItem; TempItem^.Next^.Previous:=TempItem;
FEndItem:=TempItem^.Next; FEndItem:=TempItem^.Next;
end end
else else
begin begin
New(FEndItem); New(FEndItem);
FEndItem^.Previous:=FBeginItem; FEndItem^.Previous:=FBeginItem;
FBeginItem^.Next:=FEndItem; FBeginItem^.Next:=FEndItem;
end; end;
FEndItem^.Next:=nil; FEndItem^.Next:=nil;
// Alloc item used in append/insert // Alloc item used in append/insert
New(FCacheItem); New(FCacheItem);
GetMem(FCacheItem^.Row,FRowBufferSize); GetMem(FCacheItem^.Row,FRowBufferSize);
For Counter := 0 to FRowCount - 1 do For Counter := 0 to FRowCount - 1 do
FCacheItem^.Row[Counter]:=nil; FCacheItem^.Row[Counter]:=nil;
end; end;
constructor TSqliteDataset.Create(AOwner: TComponent); constructor TSqliteDataset.Create(AOwner: TComponent);
@ -358,21 +352,21 @@ begin
while TempItem^.Next <> nil do while TempItem^.Next <> nil do
begin begin
for Counter:= 0 to FRowCount - 1 do for Counter:= 0 to FRowCount - 1 do
StrDispose(TempItem^.Row[Counter]); StrDispose(TempItem^.Row[Counter]);
FreeMem(TempItem^.Row,FRowBufferSize); FreeMem(TempItem^.Row,FRowBufferSize);
TempItem:=TempItem^.Next; TempItem:=TempItem^.Next;
Dispose(TempItem^.Previous); Dispose(TempItem^.Previous);
end; end;
// Free last item // Free last item
Dispose(TempItem); Dispose(TempItem);
for Counter:= 0 to FOrphanItems.Count - 1 do for Counter:= 0 to FOrphanItems.Count - 1 do
begin begin
TempItem:=PDataRecord(FOrphanItems[Counter]); TempItem:=PDataRecord(FOrphanItems[Counter]);
for I:= 0 to FRowCount - 1 do for I:= 0 to FRowCount - 1 do
StrDispose(TempItem^.Row[I]); StrDispose(TempItem^.Row[I]);
FreeMem(TempItem^.Row,FRowBufferSize); FreeMem(TempItem^.Row,FRowBufferSize);
Dispose(TempItem); Dispose(TempItem);
end; end;
end; end;
procedure TSqliteDataset.FreeRecordBuffer(var Buffer: PChar); procedure TSqliteDataset.FreeRecordBuffer(var Buffer: PChar);
@ -394,14 +388,20 @@ function TSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var var
ValError:Word; ValError:Word;
FieldRow:PChar; FieldRow:PChar;
//FieldIndex:Integer;
begin begin
if FRecordCount = 0 then // avoid exception in empty datasets if FRecordCount = 0 then // avoid exception in empty datasets -Todo: see if still applys
begin begin
Result:=False; Result:=False;
Exit; Exit;
end; end;
FieldRow:=PPDataRecord(ActiveBuffer)^^.Row[Field.Index]; //Small hack to allow reopening datasets with TDbEdit
Result := FieldRow <> nil; //while not fix it in LCL (It seems that TDataLink doesnt update Field property
//after Closing and reopening datasets)
//FieldRow:=PPDataRecord(ActiveBuffer)^^.Row[Field.Index];
//FieldIndex:=Field.FieldNo - 1;
FieldRow:=PPDataRecord(ActiveBuffer)^^.Row[Field.FieldNo - 1];
Result := FieldRow <> nil;
if Result and (Buffer <> nil) then //supports GetIsNull if Result and (Buffer <> nil) then //supports GetIsNull
begin begin
case Field.Datatype of case Field.Datatype of
@ -412,15 +412,15 @@ begin
ftInteger,ftBoolean,ftWord,ftAutoInc: ftInteger,ftBoolean,ftWord,ftAutoInc:
begin begin
Val(StrPas(FieldRow),LongInt(Buffer^),ValError); Val(StrPas(FieldRow),LongInt(Buffer^),ValError);
Result:= ValError = 0; Result:= ValError = 0;
end; end;
ftFloat,ftDateTime,ftTime,ftDate: ftFloat,ftDateTime,ftTime,ftDate:
begin begin
Val(StrPas(FieldRow),Double(Buffer^),ValError); Val(StrPas(FieldRow),Double(Buffer^),ValError);
Result:= ValError = 0; Result:= ValError = 0;
end; end;
end; end;
end; end;
end; end;
function TSqliteDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; function TSqliteDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
@ -468,11 +468,11 @@ var
begin begin
Result:= -1; Result:= -1;
if FRecordCount = 0 then if FRecordCount = 0 then
Exit; Exit;
TempItem:=FBeginItem; TempItem:=FBeginItem;
TempActive:=PPDataRecord(ActiveBuffer)^; TempActive:=PPDataRecord(ActiveBuffer)^;
if TempActive = FCacheItem then // Record not posted yet if TempActive = FCacheItem then // Record not posted yet
Result:=FRecordCount Result:=FRecordCount
else else
while TempActive <> TempItem do while TempActive <> TempItem do
begin begin
@ -480,14 +480,14 @@ begin
begin begin
inc(Result); inc(Result);
TempItem:=TempItem^.Next; TempItem:=TempItem^.Next;
end end
else else
begin begin
Result:=-1; Result:=-1;
DatabaseError('Sqliteds.GetRecNo - ActiveItem Not Found',Self); DatabaseError('Sqliteds.GetRecNo - ActiveItem Not Found',Self);
break; break;
end; end;
end; end;
end; end;
function TSqliteDataset.GetRecordSize: Word; function TSqliteDataset.GetRecordSize: Word;
@ -505,8 +505,8 @@ begin
DatabaseError('PPDataRecord(Buffer) <> FCacheItem - Problem',Self); DatabaseError('PPDataRecord(Buffer) <> FCacheItem - Problem',Self);
New(NewItem); New(NewItem);
GetMem(NewItem^.Row,FRowBufferSize); GetMem(NewItem^.Row,FRowBufferSize);
for Counter := 0 to FRowCount - 1 do for Counter := 0 to FRowCount - 1 do
NewItem^.Row[Counter]:=StrNew(FCacheItem^.Row[Counter]); NewItem^.Row[Counter]:=StrNew(FCacheItem^.Row[Counter]);
FEndItem^.Previous^.Next:=NewItem; FEndItem^.Previous^.Next:=NewItem;
NewItem^.Previous:=FEndItem^.Previous; NewItem^.Previous:=FEndItem^.Previous;
NewItem^.Next:=FEndItem; NewItem^.Next:=FEndItem;
@ -520,11 +520,12 @@ end;
procedure TSqliteDataset.InternalClose; procedure TSqliteDataset.InternalClose;
begin begin
if FSaveOnClose then if FSaveOnClose then
ApplyUpdates; ApplyUpdates;
//BindFields(False);
if DefaultFields then if DefaultFields then
DestroyFields; DestroyFields;
if FDataAllocated then if FDataAllocated then
DisposeLinkedList; DisposeLinkedList;
if FSqliteHandle <> nil then if FSqliteHandle <> nil then
begin begin
sqlite_close(FSqliteHandle); sqlite_close(FSqliteHandle);
@ -541,6 +542,8 @@ procedure TSqliteDataset.InternalDelete;
var var
TempItem:PDataRecord; TempItem:PDataRecord;
begin begin
If FRecordCount = 0 then
Exit;
Dec(FRecordCount); Dec(FRecordCount);
TempItem:=PPDataRecord(ActiveBuffer)^; TempItem:=PPDataRecord(ActiveBuffer)^;
// Remove from changed list // Remove from changed list
@ -555,9 +558,9 @@ begin
if FCurrentItem^.Previous <> FBeginItem then if FCurrentItem^.Previous <> FBeginItem then
FCurrentItem:= FCurrentItem^.Previous FCurrentItem:= FCurrentItem^.Previous
else else
FCurrentItem:= FCurrentItem^.Next; FCurrentItem:= FCurrentItem^.Next;
end; end;
// Dec FNextAutoInc // Dec FNextAutoInc
if FAutoIncFieldNo <> -1 then if FAutoIncFieldNo <> -1 then
if StrToInt(StrPas(TempItem^.Row[FAutoIncFieldNo])) = (FNextAutoInc - 1) then if StrToInt(StrPas(TempItem^.Row[FAutoIncFieldNo])) = (FNextAutoInc - 1) then
Dec(FNextAutoInc); Dec(FNextAutoInc);
@ -594,7 +597,7 @@ end;
procedure TSqliteDataset.InternalInitRecord(Buffer: PChar); procedure TSqliteDataset.InternalInitRecord(Buffer: PChar);
var var
Counter:Integer; Counter:Integer;
TempStr:String; TempStr:String;
begin begin
for Counter:= 0 to FRowCount - 1 do for Counter:= 0 to FRowCount - 1 do
begin begin
@ -606,8 +609,8 @@ begin
Str(FNextAutoInc,TempStr); Str(FNextAutoInc,TempStr);
FCacheItem^.Row[FAutoIncFieldNo]:=StrAlloc(Length(TempStr)+1); FCacheItem^.Row[FAutoIncFieldNo]:=StrAlloc(Length(TempStr)+1);
StrPCopy(FCacheItem^.Row[FAutoIncFieldNo],TempStr); StrPCopy(FCacheItem^.Row[FAutoIncFieldNo],TempStr);
end; end;
PPDataRecord(Buffer)^:=FCacheItem; PPDataRecord(Buffer)^:=FCacheItem;
end; end;
procedure TSqliteDataset.InternalLast; procedure TSqliteDataset.InternalLast;
@ -622,22 +625,22 @@ begin
DatabaseError('File '+FFileName+' not found',Self); DatabaseError('File '+FFileName+' not found',Self);
FSqliteHandle:=sqlite_open(PChar(FFileName),0,nil); FSqliteHandle:=sqlite_open(PChar(FFileName),0,nil);
InternalInitFieldDefs; InternalInitFieldDefs;
if DefaultFields then if DefaultFields then
CreateFields; CreateFields;
BindFields(True); BindFields(True);
// Get indexfieldno if available // Get indexfieldno if available
if FIndexFieldName <> '' then if FIndexFieldName <> '' then
FIndexFieldNo:=FieldByName(FIndexFieldName).Index FIndexFieldNo:=FieldByName(FIndexFieldName).FieldNo - 1
else else
FIndexFieldNo:=FAutoIncFieldNo; FIndexFieldNo:=FAutoIncFieldNo;
BuildLinkedList; BuildLinkedList;
FCurrentItem:=FBeginItem; FCurrentItem:=FBeginItem;
end; end;
procedure TSqliteDataset.InternalPost; procedure TSqliteDataset.InternalPost;
begin begin
if (State<>dsEdit) then if (State<>dsEdit) then
InternalAddRecord(ActiveBuffer,True); InternalAddRecord(ActiveBuffer,True);
end; end;
@ -665,54 +668,52 @@ procedure TSqliteDataset.SetExpectedAppends(AValue:Integer);
begin begin
if Assigned(FAddedItems) then if Assigned(FAddedItems) then
FAddedItems.Capacity:=AValue; FAddedItems.Capacity:=AValue;
end; end;
procedure TSqliteDataset.SetExpectedUpdates(AValue:Integer); procedure TSqliteDataset.SetExpectedUpdates(AValue:Integer);
begin begin
if Assigned(FUpdatedItems) then if Assigned(FUpdatedItems) then
FUpdatedItems.Capacity:=AValue; FUpdatedItems.Capacity:=AValue;
end; end;
procedure TSqliteDataset.SetExpectedDeletes(AValue:Integer); procedure TSqliteDataset.SetExpectedDeletes(AValue:Integer);
begin begin
if Assigned(FDeletedItems) then if Assigned(FDeletedItems) then
FDeletedItems.Capacity:=AValue; FDeletedItems.Capacity:=AValue;
end; end;
procedure TSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer); procedure TSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer);
var var
TempStr:String; TempStr:String;
ActiveItem:PDataRecord; ActiveItem:PDataRecord;
begin begin
if (FRecordCount = 0) and (State <> dsInsert) then //avoid exception in win32 + lcl + TDbEdit
Exit;
ActiveItem:=PPDataRecord(ActiveBuffer)^; ActiveItem:=PPDataRecord(ActiveBuffer)^;
if (ActiveItem <> FCacheItem) and (FUpdatedItems.IndexOf(ActiveItem) = -1) and (FAddedItems.IndexOf(ActiveItem) = -1) then if (ActiveItem <> FCacheItem) and (FUpdatedItems.IndexOf(ActiveItem) = -1) and (FAddedItems.IndexOf(ActiveItem) = -1) then
FUpdatedItems.Add(ActiveItem); FUpdatedItems.Add(ActiveItem);
if Buffer = nil then if Buffer = nil then
ActiveItem^.Row[Field.Index]:=nil ActiveItem^.Row[Pred(Field.FieldNo)]:=nil
else else
case Field.Datatype of begin
ftString: StrDispose(ActiveItem^.Row[Pred(Field.FieldNo)]);
begin case Field.Datatype of
StrDispose(ActiveItem^.Row[Field.Index]); ftString:
ActiveItem^.Row[Field.Index]:=StrNew(PChar(Buffer)); begin
end; ActiveItem^.Row[Pred(Field.FieldNo)]:=StrNew(PChar(Buffer));
ftInteger,ftBoolean,ftWord: end;
begin ftInteger,ftBoolean,ftWord:
StrDispose(ActiveItem^.Row[Field.Index]); begin
Str(LongInt(Buffer^),TempStr); Str(LongInt(Buffer^),TempStr);
ActiveItem^.Row[Field.Index]:=StrAlloc(Length(TempStr)+1); ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
StrPCopy(ActiveItem^.Row[Field.Index],TempStr); StrPCopy(ActiveItem^.Row[Pred(Field.FieldNo)],TempStr);
end; end;
ftFloat,ftDateTime,ftDate,ftTime: ftFloat,ftDateTime,ftDate,ftTime:
begin begin
StrDispose(ActiveItem^.Row[Field.Index]); Str(Double(Buffer^),TempStr);
Str(Double(Buffer^),TempStr); ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
ActiveItem^.Row[Field.Index]:=StrAlloc(Length(TempStr)+1); StrPCopy(ActiveItem^.Row[Pred(Field.FieldNo)],TempStr);
StrPCopy(ActiveItem^.Row[Field.Index],TempStr); end;
end; end;// case
end; end;//if
end; end;
procedure TSqliteDataset.SetRecNo(Value: Integer); procedure TSqliteDataset.SetRecNo(Value: Integer);
@ -720,21 +721,15 @@ var
Counter:Integer; Counter:Integer;
TempItem:PDataRecord; TempItem:PDataRecord;
begin begin
if Value >= FRecordCount then if (Value >= FRecordCount) or (Value < 0) then
DatabaseError('SqliteDs - Record Number Out Of Range'); DatabaseError('SqliteDs - Record Number Out Of Range');
TempItem:=FBeginItem; TempItem:=FBeginItem;
for Counter := 0 to Value do for Counter := 0 to Value do
TempItem:=TempItem^.Next; TempItem:=TempItem^.Next;
PPDataRecord(ActiveBuffer)^:=TempItem; PPDataRecord(ActiveBuffer)^:=TempItem;
end; end;
// Specific functions // Specific functions
procedure TSqliteDataset.SetSql(AValue:String);
begin
FSql:=AValue;
// Todo: Retrieve Tablename from SQL ??
end;
function TSqliteDataset.ExecSQL(ASql:String):Integer; function TSqliteDataset.ExecSQL(ASql:String):Integer;
begin begin
@ -743,12 +738,12 @@ begin
begin begin
FSqliteReturnId:= sqlite_exec(FSqliteHandle,PChar(ASql),nil,nil,nil); FSqliteReturnId:= sqlite_exec(FSqliteHandle,PChar(ASql),nil,nil,nil);
Result:=sqlite_changes(FSqliteHandle); Result:=sqlite_changes(FSqliteHandle);
end; end;
end; end;
function TSqliteDataset.ExecSQL:Integer; function TSqliteDataset.ExecSQL:Integer;
begin begin
Result:=ExecSQL(FSql); Result:=ExecSQL(FSql);
end; end;
function TSqliteDataset.ApplyUpdates:Boolean; function TSqliteDataset.ApplyUpdates:Boolean;
@ -769,45 +764,45 @@ begin
{$endif} {$endif}
SqlTemp:='BEGIN TRANSACTION; '; SqlTemp:='BEGIN TRANSACTION; ';
// Update changed records // Update changed records
For CounterItems:= 0 to FUpdatedItems.Count - 1 do For CounterItems:= 0 to FUpdatedItems.Count - 1 do
begin begin
SqlTemp:=SqlTemp+'UPDATE '+FTableName+' SET '; SqlTemp:=SqlTemp+'UPDATE '+FTableName+' SET ';
for CounterFields:= 1 to Fields.Count - 1 do for CounterFields:= 0 to Fields.Count - 1 do
begin begin
if PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields] <> nil then if PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields] <> nil then
begin begin
if Fields[CounterFields].DataType = ftString then if Fields[CounterFields].DataType = ftString then
Quote:='"' Quote:='"'
else else
Quote:=' '; Quote:=' ';
SqlTemp:=SqlTemp + Fields[CounterFields].FieldName +' = '+Quote+ SqlTemp:=SqlTemp + Fields[CounterFields].FieldName +' = '+Quote+
StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields])+Quote+' , '; StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields])+Quote+' , ';
end end
else else
SqlTemp:=SqlTemp + Fields[CounterFields].FieldName +' = NULL , '; SqlTemp:=SqlTemp + Fields[CounterFields].FieldName +' = NULL , ';
end; end;
system.delete(SqlTemp,Length(SqlTemp)-2,2); system.delete(SqlTemp,Length(SqlTemp)-2,2);
SqlTemp:=SqlTemp+'WHERE '+KeyName+' = '+StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[FIndexFieldNo])+';'; SqlTemp:=SqlTemp+'WHERE '+KeyName+' = '+StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[FIndexFieldNo])+';';
end; end;
// Add new records // Add new records
For CounterItems:= 0 to FAddedItems.Count - 1 do For CounterItems:= 0 to FAddedItems.Count - 1 do
begin begin
SqlTemp:=SqlTemp+'INSERT INTO '+FTableName+ ' ( '; SqlTemp:=SqlTemp+'INSERT INTO '+FTableName+ ' ( ';
for CounterFields:= 1 to Fields.Count - 1 do for CounterFields:= 0 to Fields.Count - 1 do
begin begin
SqlTemp:=SqlTemp + Fields[CounterFields].FieldName; SqlTemp:=SqlTemp + Fields[CounterFields].FieldName;
if CounterFields <> Fields.Count - 1 then if CounterFields <> Fields.Count - 1 then
SqlTemp:=SqlTemp+' , '; SqlTemp:=SqlTemp+' , ';
end; end;
SqlTemp:=SqlTemp+') VALUES ( '; SqlTemp:=SqlTemp+') VALUES ( ';
for CounterFields:= 1 to Fields.Count - 1 do for CounterFields:= 0 to Fields.Count - 1 do
begin begin
if PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields] <> nil then if PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields] <> nil then
begin begin
if Fields[CounterFields].DataType = ftString then if Fields[CounterFields].DataType = ftString then
Quote:='"' Quote:='"'
else else
Quote:=' '; Quote:=' ';
SqlTemp:=SqlTemp + Quote+ StrPas(PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields])+Quote; SqlTemp:=SqlTemp + Quote+ StrPas(PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields])+Quote;
end end
else else
@ -815,28 +810,28 @@ begin
if CounterFields <> Fields.Count - 1 then if CounterFields <> Fields.Count - 1 then
SqlTemp:=SqlTemp+' , '; SqlTemp:=SqlTemp+' , ';
end; end;
SqlTemp:=SqlTemp+') ;'; SqlTemp:=SqlTemp+') ;';
end; end;
// Delete Items // Delete Items
For CounterItems:= 0 to FDeletedItems.Count - 1 do For CounterItems:= 0 to FDeletedItems.Count - 1 do
begin begin
SqlTemp:=SqlTemp+'DELETE FROM '+FTableName+ ' WHERE '+KeyName+' = '+ SqlTemp:=SqlTemp+'DELETE FROM '+FTableName+ ' WHERE '+KeyName+' = '+
StrPas(PDataRecord(FDeletedItems[CounterItems])^.Row[FIndexFieldNo])+';'; StrPas(PDataRecord(FDeletedItems[CounterItems])^.Row[FIndexFieldNo])+';';
end; end;
SqlTemp:=SqlTemp+'END TRANSACTION; '; SqlTemp:=SqlTemp+'END TRANSACTION; ';
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('ApplyUpdates Sql: ',SqlTemp); writeln('ApplyUpdates Sql: ',SqlTemp);
{$endif} {$endif}
FAddedItems.Clear; FAddedItems.Clear;
FUpdatedItems.Clear; FUpdatedItems.Clear;
FDeletedItems.Clear; FDeletedItems.Clear;
FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(SqlTemp),nil,nil,nil); FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(SqlTemp),nil,nil,nil);
Result:= FSqliteReturnId = SQLITE_OK; Result:= FSqliteReturnId = SQLITE_OK;
end; end;
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('ApplyUpdates Result: ',Result); writeln('ApplyUpdates Result: ',Result);
{$endif} {$endif}
end; end;
function TSqliteDataset.CreateTable: Boolean; function TSqliteDataset.CreateTable: Boolean;
var var
@ -846,7 +841,7 @@ begin
{$ifdef DEBUG} {$ifdef DEBUG}
if FTableName = '' then if FTableName = '' then
WriteLn('CreateTable : TableName Not Set'); WriteLn('CreateTable : TableName Not Set');
if FieldDefs.Count = 0 then if FieldDefs.Count = 0 then
WriteLn('CreateTable : FieldDefs Not Initialized'); WriteLn('CreateTable : FieldDefs Not Initialized');
{$endif} {$endif}
if (FTableName <> '') and (FieldDefs.Count > 0) then if (FTableName <> '') and (FieldDefs.Count > 0) then
@ -864,7 +859,7 @@ begin
ftBoolean: ftBoolean:
SqlTemp:=SqlTemp + ' BOOLEAN'; SqlTemp:=SqlTemp + ' BOOLEAN';
ftFloat: ftFloat:
SqlTemp:=SqlTemp + ' FLOAT'; SqlTemp:=SqlTemp + ' FLOAT';
ftWord: ftWord:
SqlTemp:=SqlTemp + ' WORD'; SqlTemp:=SqlTemp + ' WORD';
ftDateTime: ftDateTime:
@ -872,66 +867,66 @@ begin
ftDate: ftDate:
SqlTemp:=SqlTemp + ' DATE'; SqlTemp:=SqlTemp + ' DATE';
ftTime: ftTime:
SqlTemp:=SqlTemp + ' TIME'; SqlTemp:=SqlTemp + ' TIME';
ftAutoInc: ftAutoInc:
SqlTemp:=SqlTemp + ' AUTOINC'; SqlTemp:=SqlTemp + ' AUTOINC';
else else
SqlTemp:=SqlTemp + ' VARCHAR'; SqlTemp:=SqlTemp + ' VARCHAR';
end; end;
if Counter <> FieldDefs.Count - 1 then if Counter <> FieldDefs.Count - 1 then
SqlTemp:=SqlTemp+ ' , '; SqlTemp:=SqlTemp+ ' , ';
end; end;
SqlTemp:=SqlTemp+');'; SqlTemp:=SqlTemp+');';
{$ifdef DEBUG} {$ifdef DEBUG}
writeln('CreateTable Sql: ',SqlTemp); writeln('CreateTable Sql: ',SqlTemp);
{$endif} {$endif}
FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(SqlTemp),nil,nil,nil); FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(SqlTemp),nil,nil,nil);
Result:= FSqliteReturnId = SQLITE_OK; Result:= FSqliteReturnId = SQLITE_OK;
sqlite_close(FSqliteHandle); sqlite_close(FSqliteHandle);
end end
else else
Result:=False; Result:=False;
end; end;
function TSqliteDataset.SqliteReturnString: String; function TSqliteDataset.SqliteReturnString: String;
begin begin
case FSqliteReturnId of case FSqliteReturnId of
SQLITE_OK : Result := 'SQLITE_OK '; SQLITE_OK : Result := 'SQLITE_OK ';
SQLITE_ERROR : Result := 'SQLITE_ERROR '; SQLITE_ERROR : Result := 'SQLITE_ERROR ';
SQLITE_INTERNAL : Result := 'SQLITE_INTERNAL '; SQLITE_INTERNAL : Result := 'SQLITE_INTERNAL ';
SQLITE_PERM : Result := 'SQLITE_PERM '; SQLITE_PERM : Result := 'SQLITE_PERM ';
SQLITE_ABORT : Result := 'SQLITE_ABORT '; SQLITE_ABORT : Result := 'SQLITE_ABORT ';
SQLITE_BUSY : Result := 'SQLITE_BUSY '; SQLITE_BUSY : Result := 'SQLITE_BUSY ';
SQLITE_LOCKED : Result := 'SQLITE_LOCKED '; SQLITE_LOCKED : Result := 'SQLITE_LOCKED ';
SQLITE_NOMEM : Result := 'SQLITE_NOMEM '; SQLITE_NOMEM : Result := 'SQLITE_NOMEM ';
SQLITE_READONLY : Result := 'SQLITE_READONLY '; SQLITE_READONLY : Result := 'SQLITE_READONLY ';
SQLITE_INTERRUPT : Result := 'SQLITE_INTERRUPT '; SQLITE_INTERRUPT : Result := 'SQLITE_INTERRUPT ';
SQLITE_IOERR : Result := 'SQLITE_IOERR '; SQLITE_IOERR : Result := 'SQLITE_IOERR ';
SQLITE_CORRUPT : Result := 'SQLITE_CORRUPT '; SQLITE_CORRUPT : Result := 'SQLITE_CORRUPT ';
SQLITE_NOTFOUND : Result := 'SQLITE_NOTFOUND '; SQLITE_NOTFOUND : Result := 'SQLITE_NOTFOUND ';
SQLITE_FULL : Result := 'SQLITE_FULL '; SQLITE_FULL : Result := 'SQLITE_FULL ';
SQLITE_CANTOPEN : Result := 'SQLITE_CANTOPEN '; SQLITE_CANTOPEN : Result := 'SQLITE_CANTOPEN ';
SQLITE_PROTOCOL : Result := 'SQLITE_PROTOCOL '; SQLITE_PROTOCOL : Result := 'SQLITE_PROTOCOL ';
SQLITE_EMPTY : Result := 'SQLITE_EMPTY '; SQLITE_EMPTY : Result := 'SQLITE_EMPTY ';
SQLITE_SCHEMA : Result := 'SQLITE_SCHEMA '; SQLITE_SCHEMA : Result := 'SQLITE_SCHEMA ';
SQLITE_TOOBIG : Result := 'SQLITE_TOOBIG '; SQLITE_TOOBIG : Result := 'SQLITE_TOOBIG ';
SQLITE_CONSTRAINT : Result := 'SQLITE_CONSTRAINT '; SQLITE_CONSTRAINT : Result := 'SQLITE_CONSTRAINT ';
SQLITE_MISMATCH : Result := 'SQLITE_MISMATCH '; SQLITE_MISMATCH : Result := 'SQLITE_MISMATCH ';
SQLITE_MISUSE : Result := 'SQLITE_MISUSE '; SQLITE_MISUSE : Result := 'SQLITE_MISUSE ';
SQLITE_NOLFS : Result := 'SQLITE_NOLFS '; SQLITE_NOLFS : Result := 'SQLITE_NOLFS ';
SQLITE_AUTH : Result := 'SQLITE_AUTH '; SQLITE_AUTH : Result := 'SQLITE_AUTH ';
SQLITE_FORMAT : Result := 'SQLITE_FORMAT '; SQLITE_FORMAT : Result := 'SQLITE_FORMAT ';
// SQLITE_RANGE : Result := 'SQLITE_RANGE '; // SQLITE_RANGE : Result := 'SQLITE_RANGE ';
SQLITE_ROW : Result := 'SQLITE_ROW '; SQLITE_ROW : Result := 'SQLITE_ROW ';
SQLITE_DONE : Result := 'SQLITE_DONE '; SQLITE_DONE : Result := 'SQLITE_DONE ';
else else
Result:='Unknow Return Value'; Result:='Unknow Return Value';
end; end;
end; end;
procedure Register; procedure Register;
begin begin
RegisterComponents('Data Access', [TSqliteDataset]); RegisterComponents('Data Access', [TSqliteDataset]);
end; end;
end. end.