Browse Source

+ Patch from Luiz Américo

michael 20 years ago
parent
commit
7a4ced093f
1 changed files with 75 additions and 19 deletions
  1. 75 19
      fcl/db/sqlite/sqliteds.pas

+ 75 - 19
fcl/db/sqlite/sqliteds.pas

@@ -57,7 +57,6 @@ type
     function Write(const Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
     function Read(var Buffer; Count: Longint): Longint; override;
     function Read(var Buffer; Count: Longint): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
-//    function Seek(Offset: Int64; Origin: TSeekOrigin): Int64; override;
   end;
   end;
   
   
   { TSqliteDataset }
   { TSqliteDataset }
@@ -70,8 +69,12 @@ type
     FIndexFieldName: String;
     FIndexFieldName: String;
     FIndexFieldNo: Integer;
     FIndexFieldNo: Integer;
     FAutoIncFieldNo: Integer;
     FAutoIncFieldNo: Integer;
-    FNextAutoInc:Integer;   
+    FNextAutoInc:Integer;
+    {$ifdef Debug}
+    FFCurrentItem: PDataRecord;
+    {$else}
     FCurrentItem: PDataRecord;
     FCurrentItem: PDataRecord;
+    {$endif}
     FBeginItem: PDataRecord;
     FBeginItem: PDataRecord;
     FEndItem: PDataRecord;
     FEndItem: PDataRecord;
     FCacheItem: PDataRecord;
     FCacheItem: PDataRecord;
@@ -92,9 +95,10 @@ type
     FAddedItems: TList;
     FAddedItems: TList;
     FDeletedItems: TList;
     FDeletedItems: TList;
     FOrphanItems: TList;
     FOrphanItems: TList;
-    procedure BuildLinkedList;
-    procedure DisposeLinkedList;
   protected
   protected
+    procedure DisposeLinkedList;
+    procedure BuildLinkedList; virtual;
+    //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;
     procedure FreeRecordBuffer(var Buffer: PChar); override;
     procedure FreeRecordBuffer(var Buffer: PChar); override;
@@ -129,14 +133,18 @@ type
     destructor Destroy; override;
     destructor Destroy; override;
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
     // Additional procedures
     // Additional procedures
-    function ApplyUpdates: Boolean;
-    function CreateTable: Boolean;
+    function ApplyUpdates: Boolean; virtual;
+    function CreateTable: Boolean; virtual;
     function ExecSQL:Integer;
     function ExecSQL:Integer;
     function ExecSQL(ASql:String):Integer;
     function ExecSQL(ASql:String):Integer;
     function TableExists: Boolean;
     function TableExists: Boolean;
     procedure RefetchData;
     procedure RefetchData;
     function SqliteReturnString: String;
     function SqliteReturnString: String;
     function UpdatesPending: Boolean;
     function UpdatesPending: Boolean;
+    {$ifdef DEBUG}
+    procedure SetCurrentItem(Value:PDataRecord);
+    property FCurrentItem: PDataRecord read FFCurrentItem write SetCurrentItem;
+    {$endif}
     {$ifdef USE_SQLITEDS_INTERNALS}
     {$ifdef USE_SQLITEDS_INTERNALS}
     property BeginItem: PDataRecord read FBeginItem;
     property BeginItem: PDataRecord read FBeginItem;
     property EndItem: PDataRecord read FEndItem;
     property EndItem: PDataRecord read FEndItem;
@@ -278,17 +286,7 @@ begin
   else
   else
     FRowSize:=0;  
     FRowSize:=0;  
 end;  
 end;  
-{
-function TDSMemoryStream.Seek(Offset: Int64; Origin: TSeekOrigin): Int64;
-begin
-  Case Origin of
-    soBeginning : FPosition:=Offset;
-    soEnd       : FPosition:=FRowSize+Offset;
-    soCurrent   : FPosition:=FPosition+Offset;
-  end;
-  Result:=FPosition;
-end;
-}
+
 function TDSStream.Seek(Offset: Longint; Origin: Word): Longint;
 function TDSStream.Seek(Offset: Longint; Origin: Word): Longint;
 begin
 begin
   Case Origin of
   Case Origin of
@@ -428,7 +426,6 @@ end;
 
 
 constructor TSqliteDataset.Create(AOwner: TComponent);
 constructor TSqliteDataset.Create(AOwner: TComponent);
 begin
 begin
-  //FComplexSql:=False;
   BookmarkSize := SizeOf(Pointer);
   BookmarkSize := SizeOf(Pointer);
   FBufferSize := SizeOf(PPDataRecord);
   FBufferSize := SizeOf(PPDataRecord);
   FUpdatedItems:= TList.Create;
   FUpdatedItems:= TList.Create;
@@ -777,7 +774,9 @@ end;
 
 
 procedure TSqliteDataset.InternalSetToRecord(Buffer: PChar);
 procedure TSqliteDataset.InternalSetToRecord(Buffer: PChar);
 begin
 begin
-  FCurrentItem:=PPDataRecord(Buffer)^;
+  //Todo: see why only under linux InternalSetToRecord is called with FCacheItem as parameter
+  if PPDataRecord(Buffer)^ <> FCacheItem then
+    FCurrentItem:=PPDataRecord(Buffer)^;
 end;
 end;
 
 
 function TSqliteDataset.IsCursorOpen: Boolean;
 function TSqliteDataset.IsCursorOpen: Boolean;
@@ -1167,5 +1166,62 @@ procedure Register;
 begin
 begin
   RegisterComponents('Data Access', [TSqliteDataset]);
   RegisterComponents('Data Access', [TSqliteDataset]);
 end;
 end;
+
+{$ifdef DEBUG}
+procedure TSqliteDataset.SetCurrentItem(Value:PDataRecord);
+var
+ ANo:Integer;
+
+  function GetItemPos:Integer;
+  var
+    TempItem:PDataRecord;
+  begin
+    Result:= -1;
+    TempItem:=FBeginItem;
+    if Value = FCacheItem then
+       Result:=-2
+    else
+    while Value <> TempItem do
+    begin
+     if TempItem^.Next <> nil then
+     begin
+       inc(Result);
+       TempItem:=TempItem^.Next;
+     end
+     else
+     begin
+      Result:=-1;
+      break;
+     end;
+    end;
+  end;
+
+begin
+  if Value = FBeginItem then
+  begin
+    writeln('FCurrentItem set to FBeginItem: ',IntToHex(Integer(Value),0));
+    FFCurrentItem:=Value;
+  end
+  else
+    if Value = FEndItem then
+    begin
+      writeln('FCurrentItem set to FEndItem: ',IntToHex(Integer(Value),0));
+      FFCurrentItem:=Value;
+    end
+    else
+      if Value = FCacheItem then
+      begin
+        writeln('FCurrentItem set to FCacheItem: ',IntToHex(Integer(Value),0));
+        FFCurrentItem:=Value;
+      end
+      else
+      begin
+        writeln('FCurrentItem set from ',IntToHex(Integer(FFCurrentItem),0),' to ',IntToHex(Integer(Value),0));
+        Ano:=GetItemPos;
+        writeln('Item position is ',ANo);
+        FFCurrentItem:=Value;
+      end;
+end;
+{$endif}
  
  
 end. 
 end.