* Patch from Luiz Americo:

- Implements master-detail relation using TDBF schema
  - Several fixes/improvements

git-svn-id: trunk@402 -
This commit is contained in:
michael 2005-06-14 07:35:04 +00:00
parent 58cdeb8184
commit a3ff4850f7

View File

@ -29,11 +29,7 @@ unit sqliteds;
interface interface
uses Classes, SysUtils, Db uses Classes, SysUtils, Db;
{$ifdef DEBUG}
,Crt
{$endif}
;
type type
PDataRecord = ^DataRecord; PDataRecord = ^DataRecord;
@ -96,9 +92,20 @@ type
FAddedItems: TList; FAddedItems: TList;
FDeletedItems: TList; FDeletedItems: TList;
FOrphanItems: TList; FOrphanItems: TList;
FMasterLink: TMasterDataLink;
FIndexFieldNames: String;
FIndexFieldList: TList;
function GetIndexFields(Value: Integer): TField;
procedure UpdateIndexFields;
protected protected
procedure DisposeLinkedList; procedure DisposeLinkedList;
procedure BuildLinkedList; virtual; procedure BuildLinkedList; virtual;
procedure MasterChanged(Sender: TObject);
procedure MasterDisabled(Sender: TObject);
procedure SetMasterFields(Value:String);
function GetMasterFields:String;
procedure SetMasterSource(Value: TDataSource);
function GetMasterSource:TDataSource;
//TDataSet overrides //TDataSet overrides
function AllocRecordBuffer: PChar; override; function AllocRecordBuffer: PChar; override;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
@ -137,7 +144,7 @@ type
function ApplyUpdates: Boolean; virtual; function ApplyUpdates: Boolean; virtual;
function CreateTable: Boolean; virtual; function CreateTable: Boolean; virtual;
function ExecSQL:Integer; function ExecSQL:Integer;
function ExecSQL(ASql:String):Integer; function ExecSQL(const ASql:String):Integer;
function TableExists: Boolean; function TableExists: Boolean;
procedure RefetchData; procedure RefetchData;
function SqliteReturnString: String; function SqliteReturnString: String;
@ -157,15 +164,20 @@ type
property ExpectedAppends: Integer read FExpectedAppends write SetExpectedAppends; property ExpectedAppends: Integer read FExpectedAppends write SetExpectedAppends;
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 IndexFields[Value: Integer]: TField read GetIndexFields;
property SqliteReturnId: Integer read FSqliteReturnId; property SqliteReturnId: Integer read FSqliteReturnId;
published published
property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames;
property FileName: String read FFileName write FFileName; property FileName: String read FFileName write FFileName;
property PrimaryKey: String read FPrimaryKey write FPrimaryKey; property PrimaryKey: String read FPrimaryKey write FPrimaryKey;
property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose; property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose;
property SaveOnRefetch: Boolean read FSaveOnRefetch write FSaveOnRefetch; property SaveOnRefetch: Boolean read FSaveOnRefetch write FSaveOnRefetch;
property SQL: String read FSql write FSql; property SQL: String read FSql write FSql;
property TableName: String read FTableName write FTableName; property TableName: String read FTableName write FTableName;
//property Active; property MasterSource: TDataSource read GetMasterSource write SetMasterSource;
property MasterFields: string read GetMasterFields write SetMasterFields;
property Active;
property FieldDefs; property FieldDefs;
//Events //Events
@ -189,8 +201,6 @@ type
property OnEditError; property OnEditError;
end; end;
procedure Register;
implementation implementation
uses SQLite,strutils; uses SQLite,strutils;
@ -224,7 +234,7 @@ begin
// 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:= UpperCase(StrPas(ColumnNames[Counter + Columns]));
If (ColumnStr = 'INTEGER') then If (ColumnStr = 'INTEGER') then
begin begin
AType:= ftInteger; AType:= ftInteger;
@ -385,10 +395,7 @@ begin
end; end;
FDataAllocated:=True; FDataAllocated:=True;
New(FBeginItem);
FBeginItem^.Next:=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);
@ -404,22 +411,12 @@ begin
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
if FRecordCount <> 0 then // Attach EndItem
begin TempItem^.Next:=FEndItem;
New(TempItem^.Next); FEndItem^.Previous:=TempItem;
TempItem^.Next^.Previous:=TempItem;
FEndItem:=TempItem^.Next;
end
else
begin
New(FEndItem);
FEndItem^.Previous:=FBeginItem;
FBeginItem^.Next:=FEndItem;
end;
FEndItem^.Next:=nil;
// Alloc item used in append/insert // Alloc item used in append/insert
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;
@ -431,6 +428,22 @@ end;
constructor TSqliteDataset.Create(AOwner: TComponent); constructor TSqliteDataset.Create(AOwner: TComponent);
begin begin
// setup special items
New(FBeginItem);
New(FCacheItem);
New(FEndItem);
FBeginItem^.Previous:=nil;
FEndItem^.Next:=nil;
FBeginItem^.BookMarkFlag:=bfBOF;
FCacheItem^.BookMarkFlag:=bfEOF;
FEndItem^.BookMarkFlag:=bfEOF;
FMasterLink:=TMasterDataLink.Create(Self);
FMasterLink.OnMasterChange:=@MasterChanged;
FMasterLink.OnMasterDisable:=@MasterDisabled;
FIndexFieldList:=TList.Create;
BookmarkSize := SizeOf(Pointer); BookmarkSize := SizeOf(Pointer);
FBufferSize := SizeOf(PPDataRecord); FBufferSize := SizeOf(PPDataRecord);
FUpdatedItems:= TList.Create; FUpdatedItems:= TList.Create;
@ -456,6 +469,19 @@ begin
FAddedItems.Destroy; FAddedItems.Destroy;
FDeletedItems.Destroy; FDeletedItems.Destroy;
FOrphanItems.Destroy; FOrphanItems.Destroy;
FMasterLink.Destroy;
FIndexFieldList.Destroy;
// dispose special items
Dispose(FBeginItem);
Dispose(FCacheItem);
Dispose(FEndItem);
end;
function TSqliteDataset.GetIndexFields(Value: Integer): TField;
begin
if (Value < 0) or (Value > FIndexFieldList.Count - 1) then
DatabaseError('Error acessing IndexFields: Index out of bonds');
Result:= TField(FIndexFieldList[Value]);
end; end;
procedure TSqliteDataset.DisposeLinkedList; procedure TSqliteDataset.DisposeLinkedList;
@ -476,18 +502,13 @@ begin
Dispose(TempItem^.Previous); Dispose(TempItem^.Previous);
end; end;
//Dispose FBeginItem //Dispose FBeginItem.Row
FreeMem(FBeginItem^.Row,FRowBufferSize); FreeMem(FBeginItem^.Row,FRowBufferSize);
Dispose(FBeginItem);
//Dispose cache item //Dispose cache item
for Counter:= 0 to FRowCount - 1 do for Counter:= 0 to FRowCount - 1 do
StrDispose(FCacheItem^.Row[Counter]); StrDispose(FCacheItem^.Row[Counter]);
FreeMem(FCacheItem^.Row,FRowBufferSize); FreeMem(FCacheItem^.Row,FRowBufferSize);
Dispose(FCacheItem);
// Free last item (FEndItem)
Dispose(TempItem);
//Dispose OrphanItems //Dispose OrphanItems
for Counter:= 0 to FOrphanItems.Count - 1 do for Counter:= 0 to FOrphanItems.Count - 1 do
@ -620,9 +641,10 @@ var
NewItem: PDataRecord; NewItem: PDataRecord;
Counter:Integer; Counter:Integer;
begin begin
//Todo: implement insert ?? {$ifdef DEBUG}
if PPDataRecord(Buffer)^ <> FCacheItem then if PPDataRecord(Buffer)^ <> FCacheItem then
DatabaseError('PPDataRecord(Buffer) <> FCacheItem - Problem',Self); DatabaseError('PPDataRecord(Buffer) <> FCacheItem - Problem',Self);
{$endif}
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
@ -749,13 +771,31 @@ begin
DatabaseError('TSqliteDataset - File '+FFileName+' not found'); DatabaseError('TSqliteDataset - File '+FFileName+' not found');
if (FTablename = '') and not (FComplexSql) then if (FTablename = '') and not (FComplexSql) then
DatabaseError('TSqliteDataset - Tablename not set'); DatabaseError('TSqliteDataset - Tablename not set');
if MasterSource <> nil then
begin
FSql := 'Select * from '+FTableName+';'; // forced to obtain all fields
FMasterLink.FieldNames:=MasterFields; //this should fill MasterLinks.Fields
//todo: ignore if Fields.Count = 0 (OnMasterChanged will not be called) or
// raise a error?
//if (FMasterLink.Fields.Count = 0) and (MasterSource.DataSet.Active) then
// DatabaseError('Master Fields are not defined correctly');
end;
FSqliteHandle:=sqlite_open(PChar(FFileName),0,nil); FSqliteHandle:=sqlite_open(PChar(FFileName),0,nil);
if FSql = '' then if FSql = '' then
FSql := 'Select * from '+FTableName+';'; FSql := 'Select * from '+FTableName+';';
InternalInitFieldDefs; InternalInitFieldDefs;
if DefaultFields then if DefaultFields then
CreateFields; CreateFields;
BindFields(True); BindFields(True);
UpdateIndexFields;
if FMasterLink.Active and (FIndexFieldList.Count <> FMasterLink.Fields.Count) then
DatabaseError('MasterFields count doesnt match IndexFields count');
// Get PrimaryKeyNo if available // Get PrimaryKeyNo if available
if Fields.FindField(FPrimaryKey) <> nil then if Fields.FindField(FPrimaryKey) <> nil then
FPrimaryKeyNo:=Fields.FindField(FPrimaryKey).FieldNo - 1 FPrimaryKeyNo:=Fields.FindField(FPrimaryKey).FieldNo - 1
@ -774,8 +814,6 @@ end;
procedure TSqliteDataset.InternalSetToRecord(Buffer: PChar); procedure TSqliteDataset.InternalSetToRecord(Buffer: PChar);
begin begin
//Todo: see why only under linux InternalSetToRecord is called with FCacheItem as parameter
if PPDataRecord(Buffer)^ <> FCacheItem then
FCurrentItem:=PPDataRecord(Buffer)^; FCurrentItem:=PPDataRecord(Buffer)^;
end; end;
@ -861,7 +899,82 @@ end;
// Specific functions // Specific functions
function TSqliteDataset.ExecSQL(ASql:String):Integer; procedure TSqliteDataset.MasterChanged(Sender: TObject);
function GetSqlStr(AField:TField):String;
begin
case AField.DataType of
ftString,ftMemo: Result:='"'+AField.AsString+'"';//todo: handle " caracter properly
ftDateTime,ftDate,ftTime:Str(AField.AsDateTime,Result);
else
Result:=AField.AsString;
end;//case
end;//function
var
AFilter:String;
i:Integer;
begin
AFilter:=' where ';
for i:= 0 to FMasterLink.Fields.Count - 1 do
begin
AFilter:=AFilter + IndexFields[i].FieldName +' = '+ GetSqlStr(TField(FMasterLink.Fields[i]));
if i <> FMasterLink.Fields.Count - 1 then
AFilter:= AFilter + ' and ';
end;
FSql:='Select * from '+FTableName+AFilter;
{$ifdef DEBUG}
writeln('Sql used to filter detail dataset:');
writeln(FSql);
{$endif}
RefetchData;
end;
procedure TSqliteDataset.MasterDisabled(Sender: TObject);
begin
FSql:='Select * from '+FTableName+';';
RefetchData;
end;
procedure TSqliteDataset.SetMasterFields(Value: String);
begin
if Active then
DatabaseError('It''s not allowed to set MasterFields property in a open dataset');
FMasterLink.FieldNames:=Value;
end;
function TSqliteDataset.GetMasterFields: String;
begin
Result:=FMasterLink.FieldNames;
end;
procedure TSqliteDataset.UpdateIndexFields;
begin
if FIndexFieldNames <> '' then
begin
FIndexFieldList.Clear;
try
GetFieldList(FIndexFieldList, FIndexFieldNames);
except
FIndexFieldList.Clear;
raise;
end;
end;
end;
function TSqliteDataset.GetMasterSource: TDataSource;
begin
Result := FMasterLink.DataSource;
end;
procedure TSqliteDataset.SetMasterSource(Value: TDataSource);
begin
FMasterLink.DataSource := Value;
end;
function TSqliteDataset.ExecSQL(const ASql:String):Integer;
var var
AHandle: Pointer; AHandle: Pointer;
begin begin
@ -1063,6 +1176,7 @@ begin
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);
FSqliteHandle:=nil;
end end
else else
Result:=False; Result:=False;
@ -1122,7 +1236,6 @@ begin
FUpdatedItems.Clear; FUpdatedItems.Clear;
FDeletedItems.Clear; FDeletedItems.Clear;
FOrphanItems.Clear; FOrphanItems.Clear;
FRecordCount:=0;
//Reopen //Reopen
BuildLinkedList; BuildLinkedList;
FCurrentItem:=FBeginItem; FCurrentItem:=FBeginItem;
@ -1171,11 +1284,6 @@ begin
(FAddedItems.Count > 0) or (FUpdatedItems.Count > 0); (FAddedItems.Count > 0) or (FUpdatedItems.Count > 0);
end; end;
procedure Register;
begin
RegisterComponents('Data Access', [TSqliteDataset]);
end;
{$ifdef DEBUGACTIVEBUFFER} {$ifdef DEBUGACTIVEBUFFER}
procedure TSqliteDataset.SetCurrentItem(Value:PDataRecord); procedure TSqliteDataset.SetCurrentItem(Value:PDataRecord);
var var