freepascal.compiler/fcl/db/sqlite/sqliteds.pas

unit sqliteds;

{
    This is SqliteDS/TSqliteDataset, a TDataset descendant class for use with fpc compiler
    Copyright (C) 2004  Luiz Américo Pereira Câmara
    Email: [email protected]

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
    the Free Software Foundation; either version 2.1 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

}

{$Mode ObjFpc}
{$H+}
{ $Define USE_SQLITEDS_INTERNALS}
{ $Define DEBUG}

interface

uses Classes, SysUtils, Db;

type
  PDataRecord = ^DataRecord;
  PPDataRecord = ^PDataRecord;
  DataRecord = record
    Row: PPchar;
    BookmarkData: Pointer;
    BookmarkFlag: TBookmarkFlag;
    Next: PDataRecord;
    Previous: PDataRecord;
  end;
 
  TSqliteDataset = class(TDataSet)
  private
    FFileName: String;
    FSql: String;
    FTableName: String;
    FIndexFieldName: String;
    FIndexFieldNo: Integer;
    FAutoIncFieldNo: Integer;
    FNextAutoInc:Integer;   
    FCurrentItem: PDataRecord;
    FBeginItem: PDataRecord;
    FEndItem: PDataRecord;
    FCacheItem: PDataRecord;
    FBufferSize: Integer;
    FRowBufferSize: Integer;
    FRowCount: Integer;
    FRecordCount: Integer;
    FExpectedAppends: Integer;
    FExpectedDeletes: Integer;
    FExpectedUpdates: Integer;
    FSqliteReturnId: Integer;
    FDataAllocated: Boolean;
    FSaveOnClose: Boolean;
    FSqliteHandle: Pointer;
    FDBError: PPChar;
    FUpdatedItems: TList;
    FAddedItems: TList;
    FDeletedItems: TList;
    FOrphanItems: TList;
    procedure BuildLinkedList;
    procedure DisposeLinkedList;
  protected
    function AllocRecordBuffer: PChar; override;
    procedure FreeRecordBuffer(var Buffer: PChar); override;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordCount: Integer; override;
    function GetRecNo: Integer; override;
    function GetRecordSize: Word; override; 
    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark(ABookmark: Pointer); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: PChar); override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalSetToRecord(Buffer: PChar); override;
    function IsCursorOpen: Boolean; override;    
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
    procedure SetExpectedAppends(AValue:Integer);
    procedure SetExpectedUpdates(AValue:Integer);
    procedure SetExpectedDeletes(AValue:Integer);
    procedure SetFieldData(Field: TField; Buffer: Pointer); override;  
    procedure SetRecNo(Value: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
    // Additional procedures
    function ApplyUpdates: Boolean;
    function CreateTable: Boolean;
    function ExecSQL:Integer;
    function ExecSQL(ASql:String):Integer;
    function SqliteReturnString: String;
    {$ifdef USE_SQLITEDS_INTERNALS}
    property BeginItem: PDataRecord read FBeginItem;
    property EndItem: PDataRecord read FEndItem;
    property UpdatedItems: TList read FUpdatedItems;
    property AddedItems: TList read FAddedItems;
    property DeletedItems: TList read FDeletedItems;
    {$endif}
    property ExpectedAppends: Integer read FExpectedAppends write SetExpectedAppends;
    property ExpectedUpdates: Integer read FExpectedUpdates write SetExpectedUpdates;
    property ExpectedDeletes: Integer read FExpectedDeletes write SetExpectedDeletes;
    property SqliteReturnId: Integer read FSqliteReturnId;
   published 
    property FileName: String read FFileName write FFileName;
    property IndexFieldName: String read FIndexFieldName write FIndexFieldName;
    property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose; 
    property SQL: String read FSql write FSql;
    property TableName: String read FTableName write FTableName;   
    //property Active;
    property FieldDefs;
 
    //Events
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;
    property OnDeleteError;
    property OnEditError;
  end;
  
  procedure Register;
  
implementation

uses SQLite;

function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
var
  CodeError, TempInt: Integer;
begin
  TempInt:=-1;
  if ColumnValues[0] <> nil then
  begin
    Val(StrPas(ColumnValues[0]),TempInt,CodeError);  
    if CodeError <> 0 then
      DatabaseError('SqliteDs - Error trying to get last autoinc value');
  end;  
  Integer(NextValue^):=Succ(TempInt);
  Result:=1;
end;  

function GetFieldDefs(TheDataset: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
var
  FieldSize:Word;
  Counter:Integer;
  AType:TFieldType;
  ColumnStr:String;
begin
 // Sqlite is typeless (allows any type in any field) 
 // regardless of what is in Create Table, but returns 
 // exactly what is in Create Table statement
 // here is a trick to get the datatype.
 // If the field contains another type, there will be problems  
 For Counter:= 0 to Columns - 1 do
 begin
   ColumnStr:= UpCase(StrPas(ColumnNames[Counter + Columns]));
   If (ColumnStr = 'INTEGER') then  
   begin  
     AType:= ftInteger;
     FieldSize:=SizeOf(Integer); 
   end else if (ColumnStr = 'BOOLEAN') then
   begin
     AType:= ftBoolean;
     FieldSize:=SizeOf(Boolean);
   end else if (ColumnStr = 'FLOAT') then
   begin
     AType:= ftFloat;
     FieldSize:=SizeOf(Double);
   end else if (ColumnStr = 'WORD') then
   begin
     AType:= ftWord;
     FieldSize:=SizeOf(Word);
   end else if (ColumnStr = 'DATETIME') then
   begin
     AType:= ftDateTime;
     FieldSize:=SizeOf(TDateTime);
   end else if (ColumnStr = 'DATE') then
   begin
     AType:= ftDate;
     FieldSize:=SizeOf(TDateTime);
   end else if (ColumnStr = 'TIME') then
   begin
     AType:= ftTime;
     FieldSize:=SizeOf(TDateTime);
   end else if (ColumnStr = 'AUTOINC') then
   begin
    //Todo: remove this check. do it in open
     if TSqliteDataset(TheDataset).Tablename = '' then
       DatabaseError('Sqliteds - AutoInc fields requires Tablename to be set');
     AType:= ftAutoInc;
     FieldSize:=SizeOf(Integer);
     if TSqliteDataset(TheDataset).FAutoIncFieldNo = -1 then
       TSqliteDataset(TheDataset).FAutoIncFieldNo:= Counter;
   end else 
   begin
     AType:= ftString;
     FieldSize:=10; //??
   end;   
   TDataset(TheDataset).FieldDefs.Add(StrPas(ColumnNames[Counter]), AType, FieldSize, False);    
 end;
 result:=-1;
end; 
 
// TSqliteDataset override methods

function TSqliteDataset.AllocRecordBuffer: PChar;
var
  APointer:Pointer;
begin
  APointer := AllocMem(FBufferSize);
  PDataRecord(APointer^):=FBeginItem;
  Result:=APointer;
end;

procedure TSqliteDataset.BuildLinkedList;
var
  TempItem:PDataRecord;
  vm:Pointer;
  ColumnNames,ColumnValues:PPChar;
  Counter:Integer;
begin
  //Get AutoInc Field initial value
  if FAutoIncFieldNo <> -1 then
    sqlite_exec(FSqliteHandle,PChar('Select Max('+Fields[FAutoIncFieldNo].FieldName+') from ' + FTableName),
      @GetAutoIncValue,@FNextAutoInc,nil);  
  
  FSqliteReturnId:=sqlite_compile(FSqliteHandle,Pchar(FSql),nil,@vm,nil);  
  if FSqliteReturnId <> SQLITE_OK then
  case FSqliteReturnId of
  SQLITE_ERROR:
    DatabaseError('Invalid Sql',Self);
  else
    DatabaseError('Unknow Error',Self);
  end;  
  
  FDataAllocated:=True;
  New(FBeginItem);
  FBeginItem^.Next:=nil;
  FBeginItem^.Previous:=nil;
  FBeginItem^.BookMarkFlag:=bfBOF;
  TempItem:=FBeginItem;
  FRecordCount:=0; 
  FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames);
  while FSqliteReturnId = SQLITE_ROW do
  begin
    Inc(FRecordCount);
    New(TempItem^.Next);
    TempItem^.Next^.Previous:=TempItem;
    TempItem:=TempItem^.Next;
    GetMem(TempItem^.Row,FRowBufferSize);
    For Counter := 0 to FRowCount - 1 do
      TempItem^.Row[Counter]:=StrNew(ColumnValues[Counter]);     
    FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames);  
  end;
  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;
   // Alloc item used in append/insert 
  New(FCacheItem);
  GetMem(FCacheItem^.Row,FRowBufferSize);
  For Counter := 0 to FRowCount - 1 do
    FCacheItem^.Row[Counter]:=nil;     
end;

constructor TSqliteDataset.Create(AOwner: TComponent);
begin
  BookmarkSize := SizeOf(Pointer);
  FBufferSize := SizeOf(PPDataRecord);
  FUpdatedItems:= TList.Create;
  FUpdatedItems.Capacity:=20;
  FAddedItems:= TList.Create;
  FAddedItems.Capacity:=20;
  FOrphanItems:= TList.Create;
  FOrphanItems.Capacity:=20;
  FDeletedItems:= TList.Create;
  FDeletedItems.Capacity:=20;
  FSaveOnClose:=False;
  inherited Create(AOwner);
end;

destructor TSqliteDataset.Destroy;
begin
  inherited Destroy;
  FUpdatedItems.Destroy;
  FAddedItems.Destroy;
  FDeletedItems.Destroy;
  FOrphanItems.Destroy;
end;

procedure TSqliteDataset.DisposeLinkedList;
var
  TempItem:PDataRecord;
  Counter,I:Integer;
begin
  //Todo insert debug info
  FDataAllocated:=False;
  //Dispose cache item
  for Counter:= 0 to FRowCount - 1 do
    StrDispose(FCacheItem^.Row[Counter]);
  FreeMem(FCacheItem^.Row,FRowBufferSize);
  Dispose(FCacheItem);
  If FBeginItem^.Next = nil then //remove it??
    exit;
  TempItem:=FBeginItem^.Next;
  Dispose(FBeginItem);
  while TempItem^.Next <> nil do
  begin
    for Counter:= 0 to FRowCount - 1 do
      StrDispose(TempItem^.Row[Counter]);  
    FreeMem(TempItem^.Row,FRowBufferSize);
    TempItem:=TempItem^.Next;
    Dispose(TempItem^.Previous);
  end; 
  // Free last item
  Dispose(TempItem);  
  for Counter:= 0 to FOrphanItems.Count - 1 do
  begin
    TempItem:=PDataRecord(FOrphanItems[Counter]);
    for I:= 0 to FRowCount - 1 do
      StrDispose(TempItem^.Row[I]);  
    FreeMem(TempItem^.Row,FRowBufferSize);
    Dispose(TempItem);  
  end;     
end;

procedure TSqliteDataset.FreeRecordBuffer(var Buffer: PChar);
begin
  FreeMem(Buffer);
end;

procedure TSqliteDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  Pointer(Data^) := PPDataRecord(Buffer)^^.BookmarkData;
end;

function TSqliteDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result := PPDataRecord(Buffer)^^.BookmarkFlag;
end;

function TSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
  ValError:Word;
  FieldRow:PChar;
  //FieldIndex:Integer;
begin
  if FRecordCount = 0 then // avoid exception in empty datasets -Todo: see if still applys
  begin
    Result:=False;
    Exit;
  end;
  //Small hack to allow reopening datasets with TDbEdit 
  //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
  begin
    case Field.Datatype of
    ftString:
      begin
        Move(FieldRow^,PChar(Buffer)^,StrLen(FieldRow)+1);
      end;
    ftInteger,ftBoolean,ftWord,ftAutoInc:
      begin
        Val(StrPas(FieldRow),LongInt(Buffer^),ValError);
        Result:= ValError = 0;  
      end;
    ftFloat,ftDateTime,ftTime,ftDate:
      begin
        Val(StrPas(FieldRow),Double(Buffer^),ValError);
        Result:= ValError = 0; 
      end;    
    end;
  end;        
end;

function TSqliteDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
begin
  Result := grOk;
  case GetMode of
    gmPrior:
      if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
      begin
        Result := grBOF;
        FCurrentItem := FBeginItem;
      end
      else
        FCurrentItem:=FCurrentItem^.Previous;
    gmCurrent:
      if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
         Result := grError;
    gmNext:
      if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
        Result := grEOF
      else
        FCurrentItem:=FCurrentItem^.Next;
  end; //case
  if Result = grOk then
  begin
    PDataRecord(Pointer(Buffer)^):=FCurrentItem;
    with FCurrentItem^ do
    begin
      BookmarkData := FCurrentItem;
      BookmarkFlag := bfCurrent;
    end;
  end
    else if (Result = grError) and DoCheck then
      DatabaseError('SqliteDs - No records',Self);
end;

function TSqliteDataset.GetRecordCount: Integer;
begin
  Result := FRecordCount;
end;

function TSqliteDataset.GetRecNo: Integer;
var
  TempItem,TempActive:PDataRecord;
begin
  Result:= -1;
  if FRecordCount = 0 then
    Exit;  
  TempItem:=FBeginItem;
  TempActive:=PPDataRecord(ActiveBuffer)^;
  if TempActive = FCacheItem then // Record not posted yet
    Result:=FRecordCount 
  else
    while TempActive <> TempItem do
    begin
      if TempItem^.Next <> nil then
      begin
        inc(Result);
        TempItem:=TempItem^.Next;
      end  
      else
      begin
        Result:=-1;
        DatabaseError('Sqliteds.GetRecNo - ActiveItem Not Found',Self);
        break;    
      end;      
    end;  
end;

function TSqliteDataset.GetRecordSize: Word;
begin
  Result := FBufferSize; //??
end;

procedure TSqliteDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
var
  NewItem: PDataRecord;
  Counter:Integer;
begin
  //Todo: implement insert ??
  if PPDataRecord(Buffer)^ <> FCacheItem then
    DatabaseError('PPDataRecord(Buffer) <> FCacheItem - Problem',Self);
  New(NewItem);
  GetMem(NewItem^.Row,FRowBufferSize);
  for Counter := 0 to FRowCount - 1 do 
    NewItem^.Row[Counter]:=StrNew(FCacheItem^.Row[Counter]);   
  FEndItem^.Previous^.Next:=NewItem;
  NewItem^.Previous:=FEndItem^.Previous;
  NewItem^.Next:=FEndItem;
  FEndItem^.Previous:=NewItem;
  Inc(FRecordCount);
  if FAutoIncFieldNo <> - 1 then
    Inc(FNextAutoInc);
  FAddedItems.Add(NewItem);
end;

procedure TSqliteDataset.InternalClose;
begin
  if FSaveOnClose then
    ApplyUpdates;  
  //BindFields(False);  
  if DefaultFields then
    DestroyFields;
  if FDataAllocated then
    DisposeLinkedList;  
  if FSqliteHandle <> nil then
  begin
    sqlite_close(FSqliteHandle);
    FSqliteHandle := nil;
  end;
  FAddedItems.Clear;
  FUpdatedItems.Clear;
  FDeletedItems.Clear;
  FOrphanItems.Clear;
  FRecordCount:=0;
end;

procedure TSqliteDataset.InternalDelete;
var
  TempItem:PDataRecord;
begin
  If FRecordCount = 0 then
    Exit;
  Dec(FRecordCount);
  TempItem:=PPDataRecord(ActiveBuffer)^;
  // Remove from changed list
  FUpdatedItems.Remove(TempItem);
  if FAddedItems.Remove(TempItem) = -1 then
    FDeletedItems.Add(TempItem);
  FOrphanItems.Add(TempItem);
  TempItem^.Next^.Previous:=TempItem^.Previous;
  TempItem^.Previous^.Next:=TempItem^.Next;
  if FCurrentItem = TempItem then
  begin
    if FCurrentItem^.Previous <> FBeginItem then
      FCurrentItem:= FCurrentItem^.Previous
    else
      FCurrentItem:= FCurrentItem^.Next;  
  end; 
  // Dec FNextAutoInc   
  if FAutoIncFieldNo <> -1 then
    if StrToInt(StrPas(TempItem^.Row[FAutoIncFieldNo])) = (FNextAutoInc - 1) then
      Dec(FNextAutoInc);
end;

procedure TSqliteDataset.InternalFirst;
begin
  FCurrentItem := FBeginItem;
end;

procedure TSqliteDataset.InternalGotoBookmark(ABookmark: Pointer);
begin
  FCurrentItem := PDataRecord(ABookmark^);
end;

procedure TSqliteDataset.InternalHandleException;
begin
  //??
end;

procedure TSqliteDataset.InternalInitFieldDefs;
begin
  FieldDefs.Clear;
  sqlite_exec(FSqliteHandle,PChar('PRAGMA empty_result_callbacks = ON;PRAGMA show_datatypes = ON;'),nil,nil,nil);
  FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(FSql),@GetFieldDefs,Self,nil);
  {
  if FSqliteReturnId <> SQLITE_ABORT then
     DatabaseError(SqliteReturnString,Self);
  }
  FRowBufferSize:=(SizeOf(PPChar)*FieldDefs.Count);
end;


procedure TSqliteDataset.InternalInitRecord(Buffer: PChar);
var
  Counter:Integer;
  TempStr:String;  
begin
  for Counter:= 0 to FRowCount - 1 do
  begin
    StrDispose(FCacheItem^.Row[Counter]);
    FCacheItem^.Row[Counter]:=nil;
  end;
  if FAutoIncFieldNo <> - 1 then
  begin
    Str(FNextAutoInc,TempStr);
    FCacheItem^.Row[FAutoIncFieldNo]:=StrAlloc(Length(TempStr)+1);
    StrPCopy(FCacheItem^.Row[FAutoIncFieldNo],TempStr);
  end;  
  PPDataRecord(Buffer)^:=FCacheItem;    
end;

procedure TSqliteDataset.InternalLast;
begin
  FCurrentItem := FEndItem;
end;

procedure TSqliteDataset.InternalOpen;
begin
  FAutoIncFieldNo:=-1;
  if not FileExists(FFileName) then
    DatabaseError('File '+FFileName+' not found',Self);
  FSqliteHandle:=sqlite_open(PChar(FFileName),0,nil);
  InternalInitFieldDefs;
  if DefaultFields then 
    CreateFields;
  BindFields(True);
  // Get indexfieldno if available
  if FIndexFieldName <> '' then
    FIndexFieldNo:=FieldByName(FIndexFieldName).FieldNo - 1
  else
    FIndexFieldNo:=FAutoIncFieldNo;
       
  BuildLinkedList;               
  FCurrentItem:=FBeginItem;  
end;

procedure TSqliteDataset.InternalPost;
begin
  if (State<>dsEdit) then 
    InternalAddRecord(ActiveBuffer,True);
end;

procedure TSqliteDataset.InternalSetToRecord(Buffer: PChar);
begin
  FCurrentItem:=PPDataRecord(Buffer)^;
end;

function TSqliteDataset.IsCursorOpen: Boolean;
begin
   Result := FDataAllocated;
end;

procedure TSqliteDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
  PPDataRecord(Buffer)^^.BookmarkData := Pointer(Data^);
end;

procedure TSqliteDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
  PPDataRecord(Buffer)^^.BookmarkFlag := Value;
end;

procedure TSqliteDataset.SetExpectedAppends(AValue:Integer);
begin
  if Assigned(FAddedItems) then
    FAddedItems.Capacity:=AValue;
end;  

procedure TSqliteDataset.SetExpectedUpdates(AValue:Integer);
begin
  if Assigned(FUpdatedItems) then
    FUpdatedItems.Capacity:=AValue;
end;  

procedure TSqliteDataset.SetExpectedDeletes(AValue:Integer);
begin
  if Assigned(FDeletedItems) then
    FDeletedItems.Capacity:=AValue;
end;  

procedure TSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer);
var
  TempStr:String;
  ActiveItem:PDataRecord;
begin
  ActiveItem:=PPDataRecord(ActiveBuffer)^;
  if (ActiveItem <> FCacheItem) and (FUpdatedItems.IndexOf(ActiveItem) = -1) and (FAddedItems.IndexOf(ActiveItem) = -1) then
    FUpdatedItems.Add(ActiveItem);
  if Buffer = nil then
    ActiveItem^.Row[Pred(Field.FieldNo)]:=nil
  else
    begin
      StrDispose(ActiveItem^.Row[Pred(Field.FieldNo)]);
      case Field.Datatype of
      ftString:
        begin            
          ActiveItem^.Row[Pred(Field.FieldNo)]:=StrNew(PChar(Buffer));
        end;
      ftInteger,ftBoolean,ftWord:
        begin          
          Str(LongInt(Buffer^),TempStr);  
          ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
          StrPCopy(ActiveItem^.Row[Pred(Field.FieldNo)],TempStr);
        end;
      ftFloat,ftDateTime,ftDate,ftTime:
        begin
          Str(Double(Buffer^),TempStr);  
          ActiveItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
          StrPCopy(ActiveItem^.Row[Pred(Field.FieldNo)],TempStr);
        end;    
      end;// case
    end;//if        
end;

procedure TSqliteDataset.SetRecNo(Value: Integer);
var
  Counter:Integer;
  TempItem:PDataRecord;
begin
  if (Value >= FRecordCount) or (Value < 0) then
    DatabaseError('SqliteDs - Record Number Out Of Range');
  TempItem:=FBeginItem;
  for Counter := 0 to Value do
    TempItem:=TempItem^.Next;
  PPDataRecord(ActiveBuffer)^:=TempItem;   
end;

// Specific functions 

function TSqliteDataset.ExecSQL(ASql:String):Integer;
begin
  Result:=0;
  if FSqliteHandle <> nil then
  begin
    FSqliteReturnId:= sqlite_exec(FSqliteHandle,PChar(ASql),nil,nil,nil);
    Result:=sqlite_changes(FSqliteHandle);
  end;      
end;    

function TSqliteDataset.ExecSQL:Integer;
begin
  Result:=ExecSQL(FSql);  
end;

function TSqliteDataset.ApplyUpdates:Boolean;
var
  CounterFields,CounterItems:Integer;
  SqlTemp,KeyName:String;
  Quote:Char;
begin
  Result:=False;
  if (FTableName <> '') and (FIndexFieldNo <> -1)  then
  begin
    KeyName:=Fields[FIndexFieldNo].FieldName;
    {$ifdef DEBUG}
    if FIndexFieldNo = FAutoIncFieldNo then
      WriteLn('Using an AutoInc field as primary key');
    WriteLn('IndexFieldName: ',KeyName);
    WriteLn('IndexFieldNo: ',FIndexFieldNo);
    {$endif}
    SqlTemp:='BEGIN TRANSACTION; ';
    // Update changed records
    For CounterItems:= 0 to FUpdatedItems.Count - 1 do  
    begin
      SqlTemp:=SqlTemp+'UPDATE '+FTableName+' SET ';
      for CounterFields:= 0 to Fields.Count - 1 do
      begin
        if PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields] <> nil then
        begin
          if Fields[CounterFields].DataType = ftString then
            Quote:='"'
          else
            Quote:=' ';  
          SqlTemp:=SqlTemp + Fields[CounterFields].FieldName +' = '+Quote+
          StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields])+Quote+' , ';
        end
        else
          SqlTemp:=SqlTemp + Fields[CounterFields].FieldName +' = NULL , ';  
      end;
      system.delete(SqlTemp,Length(SqlTemp)-2,2);
      SqlTemp:=SqlTemp+'WHERE '+KeyName+' = '+StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[FIndexFieldNo])+';';
    end;
    // Add new records
    For CounterItems:= 0 to FAddedItems.Count - 1 do  
    begin
      SqlTemp:=SqlTemp+'INSERT INTO '+FTableName+ ' ( ';
      for CounterFields:= 0 to Fields.Count - 1 do
      begin
        SqlTemp:=SqlTemp + Fields[CounterFields].FieldName; 
        if CounterFields <> Fields.Count - 1 then
          SqlTemp:=SqlTemp+' , ';
      end; 
      SqlTemp:=SqlTemp+') VALUES ( ';
      for CounterFields:= 0 to Fields.Count - 1 do
      begin
        if PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields] <> nil then
        begin
          if Fields[CounterFields].DataType = ftString then
            Quote:='"'
          else
            Quote:=' ';  
          SqlTemp:=SqlTemp + Quote+ StrPas(PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields])+Quote;
        end
        else
          SqlTemp:=SqlTemp + 'NULL';
        if CounterFields <> Fields.Count - 1 then
          SqlTemp:=SqlTemp+' , ';
      end;
      SqlTemp:=SqlTemp+') ;';    
    end;  
    // Delete Items
    For CounterItems:= 0 to FDeletedItems.Count - 1 do  
    begin
      SqlTemp:=SqlTemp+'DELETE FROM '+FTableName+ ' WHERE '+KeyName+' = '+
        StrPas(PDataRecord(FDeletedItems[CounterItems])^.Row[FIndexFieldNo])+';';    
    end;
    SqlTemp:=SqlTemp+'END TRANSACTION; ';
    {$ifdef DEBUG}
    writeln('ApplyUpdates Sql: ',SqlTemp);
    {$endif}  
   FAddedItems.Clear;
   FUpdatedItems.Clear;
   FDeletedItems.Clear;   
   FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(SqlTemp),nil,nil,nil);
   Result:= FSqliteReturnId = SQLITE_OK;
  end;  
  {$ifdef DEBUG}
    writeln('ApplyUpdates Result: ',Result);
  {$endif}   
end;    

function TSqliteDataset.CreateTable: Boolean;
var
  SqlTemp:String;
  Counter:Integer;
begin
  {$ifdef DEBUG}
  if FTableName = '' then
    WriteLn('CreateTable : TableName Not Set');
  if FieldDefs.Count = 0 then 
    WriteLn('CreateTable : FieldDefs Not Initialized');
  {$endif}
  if (FTableName <> '') and (FieldDefs.Count > 0) then
  begin
    FSqliteHandle:= sqlite_open(PChar(FFileName),0,FDBError);
    SqlTemp:='CREATE TABLE '+FTableName+' (';
    for Counter := 0 to FieldDefs.Count-1 do
    begin
      SqlTemp:=SqlTemp + FieldDefs[Counter].Name;
      case FieldDefs[Counter].DataType of
        ftInteger:
          SqlTemp:=SqlTemp + ' INTEGER';
        ftString:
          SqlTemp:=SqlTemp + ' VARCHAR';
        ftBoolean:
          SqlTemp:=SqlTemp + ' BOOLEAN';
        ftFloat:
          SqlTemp:=SqlTemp + ' FLOAT';  
        ftWord:
          SqlTemp:=SqlTemp + ' WORD';
        ftDateTime:
          SqlTemp:=SqlTemp + ' DATETIME';
        ftDate:
          SqlTemp:=SqlTemp + ' DATE';
        ftTime:
          SqlTemp:=SqlTemp + ' TIME';                
        ftAutoInc:
          SqlTemp:=SqlTemp + ' AUTOINC'; 
      else
        SqlTemp:=SqlTemp + ' VARCHAR';    
      end;
      if Counter <>  FieldDefs.Count - 1 then
        SqlTemp:=SqlTemp+ ' , ';   
    end;
    SqlTemp:=SqlTemp+');';
    {$ifdef DEBUG}
    writeln('CreateTable Sql: ',SqlTemp);
    {$endif}  
    FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(SqlTemp),nil,nil,nil);   
    Result:= FSqliteReturnId = SQLITE_OK;
    sqlite_close(FSqliteHandle);
  end
  else
    Result:=False;  
end; 

function TSqliteDataset.SqliteReturnString: String;
begin
 case FSqliteReturnId of
      SQLITE_OK           : Result := 'SQLITE_OK          '; 
      SQLITE_ERROR        : Result := 'SQLITE_ERROR       ';
      SQLITE_INTERNAL     : Result := 'SQLITE_INTERNAL    '; 
      SQLITE_PERM         : Result := 'SQLITE_PERM        '; 
      SQLITE_ABORT        : Result := 'SQLITE_ABORT       '; 
      SQLITE_BUSY         : Result := 'SQLITE_BUSY        '; 
      SQLITE_LOCKED       : Result := 'SQLITE_LOCKED      '; 
      SQLITE_NOMEM        : Result := 'SQLITE_NOMEM       '; 
      SQLITE_READONLY     : Result := 'SQLITE_READONLY    '; 
      SQLITE_INTERRUPT    : Result := 'SQLITE_INTERRUPT   '; 
      SQLITE_IOERR        : Result := 'SQLITE_IOERR       '; 
      SQLITE_CORRUPT      : Result := 'SQLITE_CORRUPT     '; 
      SQLITE_NOTFOUND     : Result := 'SQLITE_NOTFOUND    '; 
      SQLITE_FULL         : Result := 'SQLITE_FULL        '; 
      SQLITE_CANTOPEN     : Result := 'SQLITE_CANTOPEN    '; 
      SQLITE_PROTOCOL     : Result := 'SQLITE_PROTOCOL    '; 
      SQLITE_EMPTY        : Result := 'SQLITE_EMPTY       '; 
      SQLITE_SCHEMA       : Result := 'SQLITE_SCHEMA      '; 
      SQLITE_TOOBIG       : Result := 'SQLITE_TOOBIG      '; 
      SQLITE_CONSTRAINT   : Result := 'SQLITE_CONSTRAINT  '; 
      SQLITE_MISMATCH     : Result := 'SQLITE_MISMATCH    '; 
      SQLITE_MISUSE       : Result := 'SQLITE_MISUSE      '; 
      SQLITE_NOLFS        : Result := 'SQLITE_NOLFS       '; 
      SQLITE_AUTH         : Result := 'SQLITE_AUTH        '; 
      SQLITE_FORMAT       : Result := 'SQLITE_FORMAT      '; 
     // SQLITE_RANGE        : Result := 'SQLITE_RANGE       '; 
      SQLITE_ROW          : Result := 'SQLITE_ROW         '; 
      SQLITE_DONE         : Result := 'SQLITE_DONE        '; 
  else
    Result:='Unknow Return Value';    
 end;
end;  
 
procedure Register;
begin
  RegisterComponents('Data Access', [TSqliteDataset]);
end;
 
end.