瀏覽代碼

* Patch from Luiz Americo:
- Implements master-detail relation using TDBF schema
- Several fixes/improvements

git-svn-id: trunk@402 -

michael 20 年之前
父節點
當前提交
a3ff4850f7
共有 1 個文件被更改,包括 160 次插入52 次删除
  1. 160 52
      fcl/db/sqlite/sqliteds.pas

+ 160 - 52
fcl/db/sqlite/sqliteds.pas

@@ -29,11 +29,7 @@ unit sqliteds;
 
 
 interface
 interface
 
 
-uses Classes, SysUtils, Db
-  {$ifdef DEBUG}
-  ,Crt
-  {$endif}
-  ;
+uses Classes, SysUtils, Db;
 
 
 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,17 +164,22 @@ 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
     property BeforeOpen;
     property BeforeOpen;
     property AfterOpen;
     property AfterOpen;
@@ -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 
-  begin
-    New(TempItem^.Next);
-    TempItem^.Next^.Previous:=TempItem;
-    FEndItem:=TempItem^.Next;    
-  end  
-  else
-  begin
-    New(FEndItem);
-    FEndItem^.Previous:=FBeginItem;    
-    FBeginItem^.Next:=FEndItem;
-  end;   
-  FEndItem^.Next:=nil;
+
+  // Attach EndItem
+  TempItem^.Next:=FEndItem;
+  FEndItem^.Previous:=TempItem;
+  
   // 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,19 +502,14 @@ 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
   begin
   begin
@@ -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 
@@ -640,8 +662,8 @@ end;
 procedure TSqliteDataset.InternalClose;
 procedure TSqliteDataset.InternalClose;
 begin
 begin
   if FSaveOnClose then
   if FSaveOnClose then
-    ApplyUpdates;  
-  //BindFields(False);  
+    ApplyUpdates;
+  //BindFields(False);
   if DefaultFields then
   if DefaultFields then
     DestroyFields;
     DestroyFields;
   if FDataAllocated then
   if FDataAllocated then
@@ -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  
@@ -763,7 +803,7 @@ begin
     FPrimaryKeyNo:=FAutoIncFieldNo; // -1 if there's no AutoIncField 
     FPrimaryKeyNo:=FAutoIncFieldNo; // -1 if there's no AutoIncField 
        
        
   BuildLinkedList;               
   BuildLinkedList;               
-  FCurrentItem:=FBeginItem;  
+  FCurrentItem:=FBeginItem;
 end;
 end;
 
 
 procedure TSqliteDataset.InternalPost;
 procedure TSqliteDataset.InternalPost;
@@ -774,9 +814,7 @@ 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;
 
 
 function TSqliteDataset.IsCursorOpen: Boolean;
 function TSqliteDataset.IsCursorOpen: Boolean;
@@ -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;
@@ -1170,11 +1283,6 @@ begin
   Result:= (FDeletedItems.Count > 0) or
   Result:= (FDeletedItems.Count > 0) or
     (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);