mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 19:11:03 +02:00
* Patch from Luiz Americo:
- Implements master-detail relation using TDBF schema - Several fixes/improvements git-svn-id: trunk@402 -
This commit is contained in:
parent
58cdeb8184
commit
a3ff4850f7
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user