{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2009 Ralf Junker, The Delphi Inspiration
 Internet: http://www.yunqa.de/delphi/
 E-Mail:   delphi@yunqa.de

-------------------------------------------------------------------------------}

unit DISQLite3DataSet;

{$I DI.inc}
{$I DISQLite3.inc}

interface

uses
  DISystemCompat, SysUtils, Classes, DB, DISQLite3Database;

type

  TDISQLite3Column = packed record
    ColumnName: UnicodeString;
    ColumnType: Integer;
    ColumnDeclaration: UnicodeString;
    ColumnOriginName: UnicodeString;
    ColumnTableName: UnicodeString;
    ColumnDatabaseName: UnicodeString;
    ColumnIsKey: Boolean;
    ColumnNotNull: Boolean;
  end;

  TDISQLite3Data = packed record
    Col: TDISQLite3Column;
    Data: TDISQLite3Cell16;
  end;

  TDISQLite3Row = array[0..(MaxInt - SizeOf(TDISQLite3Data)) div SizeOf(TDISQLite3Data) - 1] of TDISQLite3Data;

  PDISQLite3Row = ^TDISQLite3Row;

  TDISQLite3InitFieldDefEvent = procedure(
    const AColumn: TDISQLite3Column;
    const AFieldDef: TFieldDef) of object;

  {$UNDEF PS_WIDE}
  {$IFDEF COMPILER_10_UP}{$IFNDEF Unicode}
  {$DEFINE PS_WIDE}
  {$ENDIF !Unicode}{$ENDIF COMPILER_10_UP}

  TDISQLite3UniDirQuery = class({$IFDEF COMPILER_10_UP}TWideDataSet{$ELSE}TDataSet{$ENDIF})
  private

    FColumnCount: Integer;

    {$IFNDEF COMPILER_6_UP}
    FIsUniDirectional: Boolean;
    {$ENDIF COMPILER_6_UP}

    FParamCheck: Boolean;

    FParams: TParams;

    FRowBuffer: PDISQLite3Row;

    FSelectStatement: TDISQLite3Statement;

    FUpdateStatements: array[TUpdateKind] of TDISQLite3Statement;

    FOnInitFieldDef: TDISQLite3InitFieldDefEvent;

    function GetDatabase: TDISQLite3Database;

    function GetSelectSQL: UnicodeString;

    function GetUpdateSql(const AUpdateKind: TUpdateKind): UnicodeString;

    procedure SetDatabase(const AValue: TDISQLite3Database);

    procedure SelectStatementAfterClose(ASender: TObject);

    procedure SetParams(const AValue: TParams);

    procedure SetSelectSQL(const AValue: UnicodeString);

    procedure SetUpdateSql(const AUpdateKind: TUpdateKind; const AValue: UnicodeString);

    {$IFNDEF COMPILER_6_UP}
    procedure SetUniDirectional(const Value: Boolean);
    {$ENDIF !COMPILER_6_UP}

    procedure SqlChanged;

  protected

    {$IFNDEF COMPILER_6_UP}

    function AllocRecordBuffer: PChar; override;

    procedure CheckBiDirectional;

    procedure FreeRecordBuffer(var Buffer: PChar); override;

    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;

    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;

    function GetPriorRecord: Boolean; override;

    function GetPriorRecords: Integer; override;

    function GetRecordSize: Word; override;

    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;

    procedure InternalDelete; override;

    procedure InternalFirst; override;

    procedure InternalGotoBookmark(Bookmark: Pointer); override;

    procedure InternalInitRecord(Buffer: PChar); override;

    procedure InternalLast; override;

    procedure InternalPost; override;

    procedure InternalSetToRecord(Buffer: PChar); override;

    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;

    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;

    procedure SetFieldData(Field: TField; Buffer: Pointer); override;

    procedure SetFiltered(Value: Boolean); override;

    procedure SetFilterOptions(Value: TFilterOptions); override;

    procedure SetFilterText(const Value: AnsiString); override;

    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
    {$ENDIF !COMPILER_6_UP}

    procedure AllocRowBuffer(
      const AColumnCount: Integer);

    procedure DefineProperties(Filer: TFiler); override;

    procedure DoInitFieldDef(
      const AColumn: TDISQLite3Column;
      const AFieldDef: TFieldDef); virtual;

    procedure FreeRowBuffer;

    function GetCanModify: Boolean; override;

    function GetFieldClass(
      AFieldType: TFieldType): TFieldClass; override;

    function GetRecord(
      Buffer: {$IFDEF COMPILER_12_UP}TRecordBuffer{$ELSE}PAnsiChar{$ENDIF};
      GetMode: TGetMode;
      DoCheck: Boolean): TGetResult; override;

    procedure InternalClose; override;

    procedure InternalHandleException; override;

    procedure InternalInitFieldDefs; override;

    procedure InternalOpen; override;

    function IsCursorOpen: Boolean; override;

    {$IFDEF COMPILER_5_UP}

    procedure PSEndTransaction(
      Commit: Boolean); override;

    function PSExecuteStatement(
      const ASql: {$IFDEF COMPILER_10_UP}UnicodeString{$ELSE}AnsiString{$ENDIF};
      AParams: TParams;
      AResultSet: Pointer = nil): Integer; override;

    {$IFDEF PS_WIDE}

    function PSGetKeyFieldsW: WideString; override;
    {$ELSE PS_WIDE}

    function PSGetKeyFields: string; override;
    {$ENDIF PS_WIDE}

    function PSGetParams: TParams; override;

    {$IFDEF PS_WIDE}

    function PSGetQuoteCharW: WideString; override;
    {$ELSE PS_WIDE}

    function PSGetQuoteChar: string; override;
    {$ENDIF PS_WIDE}

    {$IFDEF PS_WIDE}

    function PSGetTableNameW: WideString; override;
    {$ELSE PS_WIDE}

    function PSGetTableName: string; override;
    {$ENDIF PS_WIDE}

    function PSInTransaction: Boolean; override;

    function PSIsSQLBased: Boolean; override;

    function PSIsSQLSupported: Boolean; override;

    procedure PSReset; override;

    procedure PSSetParams(AParams: TParams); override;

    procedure PSStartTransaction; override;

    function PSUpdateRecord(
      AUpdateKind: TUpdateKind;
      ADelta: TDataSet): Boolean; override;

    {$ENDIF COMPILER_5_UP}

    procedure ReadParamData(Reader: TReader);

    procedure WriteParamData(Writer: TWriter);

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    function CreateBlobStream(
      Field: TField;
      Mode: TBlobStreamMode): TStream; override;

    {$IFDEF COMPILER_5_UP}

    function GetFieldData(
      Field: TField;
      Buffer: Pointer): Boolean; overload; override;
    {$ENDIF COMPILER_5_UP}

    function GetFieldData(
      Field: TField;
      Buffer: Pointer
      {$IFDEF COMPILER_5_UP}; NativeFormat: Boolean{$ENDIF}): Boolean; overload; override;

    {$IFDEF COMPILER_6_UP}

    function IsSequenced: Boolean; override;
    {$ENDIF COMPILER_6_UP}

    {$IFNDEF COMPILER_6_UP}

    procedure Resync(Mode: TResyncMode); override;
    {$ENDIF !COMPILER_6_UP}

    {$IFNDEF COMPILER_6_UP}

    property IsUniDirectional: Boolean read FIsUniDirectional default True;
    {$ENDIF !COMPILER_6_UP}

  published

    property Database: TDISQLite3Database read GetDatabase write SetDatabase;

    property DeleteSQL: UnicodeString index ukDelete read GetUpdateSql write SetUpdateSql;

    property InsertSQL: UnicodeString index ukInsert read GetUpdateSql write SetUpdateSql;

    property ModifySQL: UnicodeString index ukModify read GetUpdateSql write SetUpdateSql;

    property ParamCheck: Boolean read FParamCheck write FParamCheck default True;

    property Params: TParams read FParams write SetParams stored False;

    property SelectSQL: UnicodeString read GetSelectSQL write SetSelectSQL;

    property OnInitFieldDef: TDISQLite3InitFieldDefEvent read FOnInitFieldDef write FOnInitFieldDef;

    property Active;

    property BeforeOpen;

    property AfterOpen;

    property BeforeClose;

    property AfterClose;

    property BeforeScroll;

    property AfterScroll;
    {$IFDEF COMPILER_5_UP}

    property BeforeRefresh;

    property AfterRefresh;
    {$ENDIF COMPILER_5_UP}
  end;

  TDISQLite3BlobStream = class(TCustomMemoryStream)
  public

    constructor Create(const Data: Pointer; const Size: Integer);

    function Write(const Buffer; Count: Integer): Integer; override;
  end;

  TDISQLite3MemoStream = class(TStringStream)
  public

    function Write(const Buffer; Count: Integer): Integer; override;
  end;

  TDISQLite3WideMemoStream = class(TDISQLite3BlobStream)
  end;

  {$IFNDEF COMPILER_10_UP}

  TDISQLite3BlobField = class(TBlobField)
  protected

    function GetAsWideString: UnicodeString;

    procedure SetAsWideString(const AValue: UnicodeString);
  end;
  {$ENDIF !COMPILER_10_UP}

  TDISQLite3MemoField = class({$IFDEF COMPILER_10_UP}TBlobField{$ELSE}TDISQLite3BlobField{$ENDIF})
  protected

    function GetAsString: string; override;

    procedure SetAsString(const AValue: string); override;
  public

    constructor Create(AOwner: TComponent); override;
  end;

  TDISQLite3WideMemoField = class({$IFDEF COMPILER_10_UP}TWideMemoField{$ELSE}TDISQLite3BlobField{$ENDIF})
    {$IFNDEF COMPILER_10_UP}
  protected

    function GetAsString: string; override;

    procedure SetAsString(const Value: string); override;
  public

    constructor Create(AOwner: TComponent); override;

    property Value: UnicodeString read GetAsWideString write SetAsWideString;
    {$ENDIF !COMPILER_10_UP}
  end;

  TDISQLite3WideStringField = class({$IFDEF COMPILER_5_UP}TWideStringField{$ELSE}TStringField{$ENDIF})
  protected

    {$UNDEF TDISQLite3WideStringField_CopyData}
    {$IFDEF COMPILER_5}{$DEFINE TDISQLite3WideStringField_CopyData}{$ENDIF}
    {$IFDEF COMPILER_10_UP}{$DEFINE TDISQLite3WideStringField_CopyData}{$ENDIF}
    {$IFDEF TDISQLite3WideStringField_CopyData}

    procedure CopyData(Source, Dest: Pointer); override;
    {$ENDIF TDISQLite3WideStringField_CopyData}

    function GetAsWideString: {$IFDEF COMPILER_12_UP}UnicodeString{$ELSE}WideString{$ENDIF}; {$IFDEF COMPILER_10_UP} override; {$ENDIF}

    {$IFNDEF COMPILER_5_UP}

    class procedure CheckTypeSize(Value: Integer); override;
    {$ENDIF !COMPILER_5_UP}

    {$UNDEF TDISQLite3WideStringField_GetAsString}
    {$IFNDEF COMPILER_5_UP}{$DEFINE TDISQLite3WideStringField_GetAsString}{$ENDIF}
    {$IFDEF COMPILER_12_UP}{$DEFINE TDISQLite3WideStringField_GetAsString}{$ENDIF}
    {$IFDEF TDISQLite3WideStringField_GetAsString}

    function GetAsString: string; override;
    {$ENDIF TDISQLite3WideStringField_GetAsString}

    {$UNDEF TDISQLite3WideStringField_GetAsVariant}
    {$IFNDEF COMPILER_5_UP}{$DEFINE TDISQLite3WideStringField_GetAsVariant}{$ENDIF}
    {$IFDEF COMPILER_10_UP}{$DEFINE TDISQLite3WideStringField_GetAsVariant}{$ENDIF}
    {$IFDEF TDISQLite3WideStringField_GetAsVariant}

    function GetAsVariant: Variant; override;
    {$ENDIF TDISQLite3WideStringField_GetAsVariant}

    {$UNDEF TDISQLite3WideStringField_GetDataSize}
    {$IFNDEF COMPILER_5_UP}{$DEFINE TDISQLite3WideStringField_GetDataSize}{$ENDIF}
    {$IFDEF COMPILER_10_UP}{$DEFINE TDISQLite3WideStringField_GetDataSize}{$ENDIF}
    {$IFDEF TDISQLite3WideStringField_GetDataSize}

    function GetDataSize: {$IFDEF COMPILER_5_UP}Integer{$ELSE}Word{$ENDIF}; override;
    {$ENDIF TDISQLite3WideStringField_GetDataSize}

    {$IFNDEF COMPILER_5_UP}

    procedure SetAsString(const Value: string); override;
    {$ENDIF !COMPILER_5_UP}

    {$IFNDEF COMPILER_5_UP}

    procedure SetVarValue(const Value: Variant); override;
    {$ENDIF !COMPILER_5_UP}

    procedure SetAsWideString(const AValue: {$IFDEF COMPILER_12_UP}UnicodeString{$ELSE}WideString{$ENDIF}); {$IFDEF COMPILER_10_UP} override; {$ENDIF}

  public

    {$IFNDEF COMPILER_5_UP}

    constructor Create(AOwner: TComponent); override;
    {$ENDIF !COMPILER_5_UP}

    {$IFNDEF COMPILER_5_UP}

    property Value: UnicodeString read GetAsWideString write SetAsWideString;
    {$ENDIF !COMPILER_5_UP}

  end;

  TDISQLite3DataSetImporter = class;

  TDISQLite3ImporterState = (isCreateTable, isInsert, isCreateIndex);

  TDISQLite3DatasetImporterProgressEvent = procedure(
    const ASender: TDISQLite3DataSetImporter;
    const APosition: Integer;
    const ATotal: Integer) of object;

  TDISQLite3DatasetImporterImportErrorEvent = procedure(
    const ASender: TDISQLite3DataSetImporter;
    const AException: Exception;
    var AContinueImport: Boolean) of object;

  TDISQLite3DatasetImporterStateChangeEvent = procedure(
    const ASender: TDISQLite3DataSetImporter;
    const AState: TDISQLite3ImporterState;
    const AMessage: UnicodeString) of object;

  TDISQLite3DataSetImporter = class(TComponent)
  private
    FDatabase: TDISQLite3Database;
    FDataSet: TDataSet;
    FOnProgress: TDISQLite3DatasetImporterProgressEvent;
    FOnImportError: TDISQLite3DatasetImporterImportErrorEvent;
    FOnStateChange: TDISQLite3DatasetImporterStateChangeEvent;
    FTableName: UnicodeString;
    procedure SetDatabase(const AValue: TDISQLite3Database);
    procedure SetDataSet(const AValue: TDataSet);
  protected
    procedure CreateTable; dynamic;
    procedure CreateIndexes; dynamic;
    procedure DoImportError(
      const AException: Exception;
      out AContinueImport: Boolean); virtual;
    procedure DoProgress(
      const APos, ATotal: Integer); virtual;
    procedure DoStatechange(
      const AState: TDISQLite3ImporterState;
      const AMessage: UnicodeString); virtual;
    procedure InsertData; dynamic;
    procedure Notification(
      AComponent: TComponent; Operation: TOperation); override;
  public

    procedure Execute;
  published

    property Database: TDISQLite3Database read FDatabase write SetDatabase;

    property DataSet: TDataSet read FDataSet write SetDataSet;

    property TableName: UnicodeString read FTableName write FTableName;

    property OnImportError: TDISQLite3DatasetImporterImportErrorEvent read FOnImportError write FOnImportError;

    property OnProgress: TDISQLite3DatasetImporterProgressEvent read FOnProgress write FOnProgress;

    property OnStateChange: TDISQLite3DatasetImporterStateChangeEvent read FOnStateChange write FOnStateChange;
  end;

resourcestring

  SUpdateFailed = 'Update failed';
  {$IFNDEF COMPILER_6_UP}

  SDataSetUnidirectional = 'Operation not allowed on a unidirectional dataset';
  {$ENDIF !COMPILER_6_UP}

implementation

uses
  Windows, {$IFDEF COMPILER_6_UP}RTLConsts, Variants{$ELSE}Consts, Forms{$ENDIF},
  DBConsts, DISQLite3Api;

function IsOld(const p: PAnsiChar): Boolean;
begin
  Result :=
    ((p[0] = 'O') or (p[0] = 'o')) and
    ((p[1] = 'L') or (p[1] = 'l')) and
    ((p[2] = 'D') or (p[2] = 'd')) and
    (p[3] = '_');
end;

procedure BindParams(
  const AStmt: sqlite3_stmt;
  const AParams: TParams;
  const ANumbered: Boolean = True);
var
  {$IFNDEF COMPILER_12_UP}
  BlobStr: AnsiString;
  {$ENDIF COMPILER_12_UP}
  i: Integer;
  p: PAnsiChar;
  Param: TParam;
begin
  for i := 1 to sqlite3_bind_parameter_count(AStmt) do
    begin
      Param := nil;
      p := sqlite3_bind_parameter_name(AStmt, i);
      if Assigned(p) then
        begin

          if p^ = ':' then
            begin
              Inc(p);
              Param := AParams.FindParam(sqlite3_decode_utf8(p));
            end;
        end
      else
        if ANumbered and (i <= AParams.Count) then
          Param := AParams[i - 1];

      if Assigned(Param) and Param.Bound then
        begin
          if Param.IsNull then
            sqlite3_check_stmt(sqlite3_bind_null(AStmt, i), AStmt)
          else
            case Param.DataType of
              ftBlob, ftGraphic{$IFDEF COMPILER_5_UP}, ftOraBlob{$ENDIF}:
                begin
                  {$IFDEF COMPILER_12_UP}
                  sqlite3_check_stmt(sqlite3_bind_blob(AStmt, i,
                    Param.AsBlob, Length(Param.AsBlob), SQLITE_TRANSIENT), AStmt);
                  {$ELSE COMPILER_12_UP}
                  BlobStr := Param.AsBlob;
                  sqlite3_check_stmt(sqlite3_bind_blob(AStmt, i,
                    Pointer(BlobStr), Length(BlobStr), SQLITE_TRANSIENT), AStmt);
                  {$ENDIF COMPILER_12_UP}
                end;
              ftDate:
                begin

                  sqlite3_check_stmt(sqlite3_bind_double(AStmt, i,
                    DateToJulianDate(Param.AsDate)), AStmt);
                end;
              ftDateTime:
                begin

                  sqlite3_check_stmt(sqlite3_bind_double(AStmt, i,
                    DateTimeToJulianDate(Param.AsDateTime)), AStmt);
                end;
              ftLargeInt:
                begin

                  sqlite3_check_stmt(sqlite3_bind_int64(AStmt, i,
                    {$IFDEF COMPILER_6_UP}Param.Value{$ELSE}Trunc(Param.AsCurrency){$ENDIF}
                    ), AStmt);
                end;
              ftTime:
                begin

                  sqlite3_check_stmt(sqlite3_bind_double(AStmt, i,
                    TimeToJulianDate(Param.AsTime)), AStmt);
                end;
              ftWideString:
                begin
                  {$IFDEF SQLITE_OMIT_UTF16}
                  sqlite3_check_stmt(sqlite3_bind_str(AStmt, i,
                    sqlite3_encode_utf8({$IFNDEF COMPILER_6_UP}WideString(Param.Value){$ELSE}Param.Value{$ENDIF})), AStmt);
                  {$ELSE SQLITE_OMIT_UTF16}
                  sqlite3_check_stmt(sqlite3_bind_str16(AStmt, i,
                    Param.Value), AStmt);
                  {$ENDIF SQLITE_OMIT_UTF16}
                end;
            else
              sqlite3_check_stmt(sqlite3_bind_variant(AStmt, i,
                Param.Value), AStmt);
            end;
        end;
    end;
end;

constructor TDISQLite3UniDirQuery.Create;
begin
  inherited;
  SetUniDirectional(True);
  FParamCheck := True;
  FParams := TParams.Create(Self);
  FSelectStatement := TDISQLite3Statement.Create;
  FSelectStatement.AfterClose := SelectStatementAfterClose;
end;

destructor TDISQLite3UniDirQuery.Destroy;
var
  uk: TUpdateKind;
begin

  Active := False;
  for uk := Low(uk) to High(uk) do
    FUpdateStatements[uk].Free;
  FSelectStatement.Free;
  FParams.Free;
  inherited;
end;

procedure TDISQLite3UniDirQuery.AllocRowBuffer(const AColumnCount: Integer);
begin
  FRowBuffer := AllocMem(AColumnCount * SizeOf(FRowBuffer[0]));
  FColumnCount := AColumnCount;
end;

{$IFNDEF COMPILER_6_UP}
procedure TDISQLite3UniDirQuery.CheckBiDirectional;
begin
  if IsUniDirectional then DatabaseError(PResStringRec(@SDataSetUnidirectional), Self);
end;
{$ENDIF !COMPILER_6_UP}

function TDISQLite3UniDirQuery.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
var
  l: Integer;
  s: AnsiString;
begin
  if Assigned(FRowBuffer) then
    with FRowBuffer^[Field.FieldNo - 1] do
      case Field.DataType of
        ftMemo:

          if Data.CellType = SQLITE_TEXT then
            begin

              l := WideCharToMultiByte(CP_ACP, 0, Data.CellText.p, Data.CellText.l, nil, 0, nil, nil);
              SetLength(s, l);
              WideCharToMultiByte(CP_ACP, 0, Data.CellText.p, Data.CellText.l, PAnsiChar(s), l, nil, nil);
              Result := TDISQLite3MemoStream.Create(s);
              Exit;
            end;

        {$IFDEF COMPILER_10_UP}
        ftWideMemo:
          if Data.CellType = SQLITE_TEXT then
            begin
              Result := TDISQLite3WideMemoStream.Create(Data.CellBlob.p, Data.CellBlob.l * 2);
              Exit;
            end;
        {$ENDIF COMPILER_10_UP}

      else
        if Data.CellType = SQLITE_BLOB then
          begin
            Result := TDISQLite3BlobStream.Create(Data.CellBlob.p, Data.CellBlob.l);
            Exit;
          end;
      end;

  Result := TDISQLite3BlobStream.Create(nil, 0);
end;

procedure TDISQLite3UniDirQuery.DefineProperties(Filer: TFiler);

  function WriteData: Boolean;
  begin
    if Filer.Ancestor <> nil then
      Result := not FParams.IsEqual(TDISQLite3UniDirQuery(Filer.Ancestor).FParams)
    else
      Result := FParams.Count > 0;
  end;

begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData);
end;

procedure TDISQLite3UniDirQuery.DoInitFieldDef(
  const AColumn: TDISQLite3Column;
  const AFieldDef: TFieldDef);
begin
  if Assigned(FOnInitFieldDef) then
    FOnInitFieldDef(AColumn, AFieldDef);
end;

procedure TDISQLite3UniDirQuery.FreeRowBuffer;
var
  i: Integer;
begin
  for i := 0 to FColumnCount - 1 do
    with FRowBuffer^[i] do
      begin
        Col.ColumnName := '';
        Col.ColumnDeclaration := '';
        Col.ColumnOriginName := '';
        Col.ColumnTableName := '';
        Col.ColumnDatabaseName := '';

        sqlite3_finalize_cell16(Data);
      end;

  FreeMem(FRowBuffer);
  FRowBuffer := nil;
  FColumnCount := 0;
end;

function TDISQLite3UniDirQuery.GetSelectSQL: UnicodeString;
begin
  Result := FSelectStatement.SQL16;
end;

function TDISQLite3UniDirQuery.GetUpdateSql(const AUpdateKind: TUpdateKind): UnicodeString;
var
  Stmt: TDISQLite3Statement;
begin
  Stmt := FUpdateStatements[AUpdateKind];
  if Assigned(Stmt) then
    Result := Stmt.SQL16
  else
    Result := '';
end;

procedure TDISQLite3UniDirQuery.SetSelectSQL(const AValue: UnicodeString);
begin
  FSelectStatement.SQL16 := AValue;
  SqlChanged;
end;

procedure TDISQLite3UniDirQuery.SetUpdateSql(const AUpdateKind: TUpdateKind; const AValue: UnicodeString);
var
  Stmt: TDISQLite3Statement;
begin
  Stmt := FUpdateStatements[AUpdateKind];
  if Assigned(Stmt) then
    if AValue <> '' then
      begin
        Stmt.Active := False;
        Stmt.SQL16 := AValue;
      end
    else
      begin
        FUpdateStatements[AUpdateKind] := nil;
        Stmt.Free;
      end
  else
    if AValue <> '' then
      begin
        Stmt := TDISQLite3Statement.Create;
        Stmt.SQL16 := AValue;
        Stmt.Database := Database;
        FUpdateStatements[AUpdateKind] := Stmt;
      end;
  SqlChanged;
end;

procedure TDISQLite3UniDirQuery.InternalOpen;
begin
  FSelectStatement.Active := True;
  InternalInitFieldDefs;
  if DefaultFields then
    CreateFields;
  BindFields(True);
  BindParams(FSelectStatement.Handle, FParams);
end;

procedure TDISQLite3UniDirQuery.InternalClose;
var
  uk: TUpdateKind;
  Stmt: TDISQLite3Statement;
begin
  FSelectStatement.Active := False;
  for uk := Low(uk) to High(uk) do
    begin
      Stmt := FUpdateStatements[uk];
      if Assigned(Stmt) then
        Stmt.Active := False;
    end;

  FreeRowBuffer;

  if DefaultFields then
    DestroyFields;
end;

function TDISQLite3UniDirQuery.IsCursorOpen: Boolean;
begin
  Result := FSelectStatement.Active;
end;

procedure TDISQLite3UniDirQuery.InternalInitFieldDefs;

  procedure FillColumnMeta(
    const ADatabaseName: Utf8String;
    const ATableName: Utf8String;
    const AOriginName: Utf8String;
    var ACol: TDISQLite3Column);
  var
    iNotNull, iPrimaryKey: Integer;
    SQL: Utf8String;
    Stmt, Stmt2: TDISQLite3Statement;
  begin

    ACol.ColumnDatabaseName := Utf8ToString(ADatabaseName);
    ACol.ColumnTableName := Utf8ToString(ATableName);
    ACol.ColumnOriginName := Utf8ToString(AOriginName);

    if sqlite3_table_column_metadata(
      Database.Handle,
      PAnsiChar(ADatabaseName),
      PAnsiChar(ATableName),
      PAnsiChar(AOriginName),
      nil,
      nil,
      @iNotNull,
      @iPrimaryKey,
      nil
      ) <> SQLITE_OK then Exit;

    ACol.ColumnIsKey := iPrimaryKey <> 0;

    if ACol.ColumnIsKey then
      Exit;

    ACol.ColumnNotNull := iNotNull <> 0;

    Stmt := TDISQLite3Statement.Create;
    try
      Stmt.Database := Database;
      SQL :=
        sqlite3_pragma_database(ADatabaseName) +
        '"index_list"(' + DISQLite3Api.QuotedStr(ATableName) + ')';
      Stmt.SQL8 := SQL;
      Stmt.Active := True;

      Stmt2 := TDISQLite3Statement.Create;
      try
        Stmt2.Database := Database;
        while Stmt.Step = SQLITE_ROW do
          if Stmt.Column_Int(2) = 1 then
            begin
              SQL :=
                sqlite3_pragma_database(ADatabaseName) +
                '"index_info"(' + DISQLite3Api.QuotedStr(Stmt.Column_Str(1)) + ')';
              Stmt2.Close;
              Stmt2.SQL8 := SQL;
              Stmt2.Open;
              while Stmt2.Step = SQLITE_ROW do
                begin
                  ACol.ColumnIsKey := Stmt2.Column_Str(2) = AOriginName;
                  if ACol.ColumnIsKey then Break;
                end;
              if ACol.ColumnIsKey then Break;
            end;
      finally
        Stmt2.Free;
      end;
    finally
      Stmt.Free;
    end;
  end;

var
  ColumnIdx, i, t: Integer;
  f: TField;
  FDataType: TFieldType;
  FSize: Integer;
  Con8, Ctn8, Cdn8: Utf8String;
  ColumnDeclaration, FieldName, UniqueFieldName: UnicodeString;
  NewFieldDef: TFieldDef;
  Stepped, StepResult: Boolean;
  Stmt: TDISQLite3Statement;
begin
  FieldDefs.Clear;

  if not Assigned(FRowBuffer) then
    begin
      Stmt := TDISQLite3Statement.Create;
      try
        Stmt.Assign(FSelectStatement);
        Stmt.Active := True;

        Stepped := False; StepResult := False;

        AllocRowBuffer(Stmt.Column_Count);

        for ColumnIdx := 0 to FColumnCount - 1 do
          begin

            ColumnDeclaration := Stmt.Column_DeclType16(ColumnIdx);
            if ColumnDeclaration <> '' then
              begin
                t := SQLITE3_AFFINITY_TO_TYPE[sqlite3_affinity16(ColumnDeclaration)];
              end
            else
              begin
                if not Stepped then
                  begin
                    Stepped := True;
                    try
                      StepResult := Stmt.Step = SQLITE_ROW;
                    except
                      StepResult := False;
                    end;
                  end;
                if StepResult then
                  begin
                    t := Stmt.Column_Type(ColumnIdx);

                    if t = SQLITE_NULL then
                      t := SQLITE_TEXT;
                  end
                else
                  t := SQLITE_TEXT;
              end;

            with FRowBuffer^[ColumnIdx] do
              begin
                Col.ColumnName := Stmt.Column_Name16(ColumnIdx);
                Col.ColumnType := t;
                Col.ColumnDeclaration := ColumnDeclaration;

                Cdn8 := Stmt.Column_Database_Name(ColumnIdx);
                Ctn8 := Stmt.Column_Table_Name(ColumnIdx);
                Con8 := Stmt.Column_Origin_Name(ColumnIdx);

                FillColumnMeta(Cdn8, Ctn8, Con8, Col);
              end;
          end;

      finally
        Stmt.Free;
      end;
    end;

  for ColumnIdx := 0 to FColumnCount - 1 do
    with FRowBuffer^[ColumnIdx] do
      begin

        i := 0;
        FieldName := Col.ColumnName;
        UniqueFieldName := FieldName;
        while FieldDefs.IndexOf(UniqueFieldName) >= 0 do
          begin
            Inc(i);
            UniqueFieldName := Format('%s_%d', [FieldName, i]);
          end;

        f := FindField(UniqueFieldName);
        if Assigned(f) then
          begin
            FDataType := f.DataType;
            FSize := f.Size;
          end
        else
          begin
            FSize := 0;
            case Col.ColumnType of
              SQLITE_INTEGER:
                begin
                  FDataType := ftLargeInt;
                end;
              SQLITE_FLOAT:
                begin
                  FDataType := ftFloat;
                end;
              SQLITE_BLOB:
                begin
                  FDataType := ftBlob;
                end;
              SQLITE_TEXT:
                begin
                  FDataType := ftWideString;
                  FSize := 20;
                end;
            else
              Assert(False, 'Invalid ColumnType');
              FDataType := ftUnknown;
            end;
          end;

        NewFieldDef := FieldDefs.AddFieldDef;
        try
          NewFieldDef.Name := UniqueFieldName;
          NewFieldDef.DataType := FDataType;
          NewFieldDef.Required := Col.ColumnNotNull;

          if FSize <> 0 then
            NewFieldDef.Size := FSize;
          DoInitFieldDef(Col, NewFieldDef);
        except
          NewFieldDef.Free;
          raise;
        end;
      end;
end;

procedure TDISQLite3UniDirQuery.InternalHandleException;
begin
  {$IFDEF COMPILER_6_UP}
  if Assigned(Classes.ApplicationHandleException) then
    Classes.ApplicationHandleException(Self);
  {$ELSE COMPILER_6_UP}
  Application.HandleException(Self);
  {$ENDIF COMPILER_6_UP}
end;

{$IFDEF COMPILER_6_UP}
function TDISQLite3UniDirQuery.IsSequenced: Boolean;
begin
  Result := False;
end;
{$ENDIF COMPILER_6_UP}

function TDISQLite3UniDirQuery.GetCanModify: Boolean;
begin
  Result := False;
end;

function TDISQLite3UniDirQuery.GetFieldClass(AFieldType: TFieldType): TFieldClass;
begin
  Result := inherited GetFieldClass(AFieldType);
  {$IFDEF COMPILER_5_UP}
  if Result = TWideStringField then
    Result := TDISQLite3WideStringField;
  {$ELSE COMPILER_5_UP}
  if not Assigned(Result) and (AFieldType = ftWideString) then
    Result := TDISQLite3WideStringField;
  {$ENDIF !COMPILER_5_UP}
end;

function TDISQLite3UniDirQuery.GetDatabase: TDISQLite3Database;
begin
  Result := FSelectStatement.Database;
end;

function TDISQLite3UniDirQuery.GetRecord(
  Buffer: {$IFDEF COMPILER_12_UP}TRecordBuffer{$ELSE}PAnsiChar{$ENDIF};
  GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
var
  i: Integer;
begin
  case GetMode of
    gmNext:
      case FSelectStatement.Step of
        SQLITE_ROW:
          begin
            for i := 0 to FColumnCount - 1 do
              with FRowBuffer^[i] do
                begin
                  sqlite3_finalize_cell16(Data);
                  FSelectStatement.Column_Cell16(i, Data);
                end;

            Result := grOK;
            Exit;
          end;
        SQLITE_DONE:
          begin
            Result := grEOF;
            Exit;
          end;
      end;
    gmCurrent:
      begin
        Result := grOK;
        Exit;
      end;
    {$IFNDEF COMPILER_6_UP}

    gmPrior:
      begin
        DatabaseError(PResStringRec(@SDataSetUnidirectional), Self);
      end;
    {$ENDIF !COMPILER_6_UP}
  end;
  Result := grError;
end;

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
begin
  Result := GetFieldData(Field, Buffer, True);
end;
{$ENDIF COMPILER_5_UP}

function TDISQLite3UniDirQuery.GetFieldData(Field: TField; Buffer: Pointer{$IFDEF COMPILER_5_UP}; NativeFormat: Boolean{$ENDIF}): Boolean;
var
  ColumnIdx: Integer;
  l: Integer;
  s: AnsiString;
  {$IFDEF COMPILER_10_UP}
  w: UnicodeString;
  {$ENDIF COMPILER_10_UP}
begin
  Result := Assigned(FRowBuffer);
  if not Result then Exit;

  ColumnIdx := Field.FieldNo - 1;
  Result := ColumnIdx >= 0;
  if not Result then Exit;

  with FRowBuffer^[ColumnIdx] do
    begin

      Result := Data.CellType <> SQLITE_NULL;
      if not Result then Exit;

      if Assigned(Buffer) then
        case Field.DataType of

          ftBlob, ftMemo, ftGraphic, ftFmtMemo:
            begin

            end;

          ftBoolean:
            begin
              PWordBool(Buffer)^ := sqlite3_cell16_as_integer(Data) <> 0;
            end;

          ftDate:
            begin
              {$IFDEF COMPILER_5_UP}
              if NativeFormat then
                PInteger(Buffer)^ := DateTimeToTimeStamp(sqlite3_cell16_as_date(Data)).Date
              else
                PDateTime(Buffer)^ := sqlite3_cell16_as_date(Data);
              {$ELSE COMPILER_5_UP}
              PInteger(Buffer)^ := DateTimeToTimeStamp(sqlite3_cell16_as_date(Data)).Date;
              {$ENDIF COMPILER_5_UP}
            end;

          ftDateTime
            {$IFDEF COMPILER_6_UP}, ftTimeStamp{$ENDIF}
          {$IFDEF COMPILER_10_UP}, ftOraTimeStamp{$ENDIF}:
            begin
              {$IFDEF COMPILER_5_UP}
              if NativeFormat then
                PDouble(Buffer)^ := TimeStampToMSecs(DateTimeToTimeStamp(sqlite3_cell16_as_datetime(Data)))
              else
                PDateTime(Buffer)^ := sqlite3_cell16_as_datetime(Data);
              {$ELSE COMPILER_5_UP}
              PDouble(Buffer)^ := TimeStampToMSecs(DateTimeToTimeStamp(sqlite3_cell16_as_datetime(Data)));
              {$ENDIF COMPILER_5_UP}
            end;

          ftInteger:
            begin
              PInteger(Buffer)^ := sqlite3_cell16_as_integer(Data);
            end;

          ftLargeInt:
            begin
              PInt64(Buffer)^ := sqlite3_cell16_as_int64(Data);
            end;

          ftFloat, ftCurrency:
            begin
              PDouble(Buffer)^ := sqlite3_cell16_as_float(Data);
            end;

          ftString:
            begin
              s := sqlite3_cell16_as_ansistring(Data);
              l := Length(s);
              if l > Field.Size then
                l := Field.Size;
              Move(Pointer(s)^, Buffer^, l);
              PAnsiChar(Buffer)[l] := #0;
            end;

          ftTime:
            begin
              {$IFDEF COMPILER_5_UP}
              if NativeFormat then
                PInteger(Buffer)^ := DateTimeToTimeStamp(sqlite3_cell16_as_time(Data)).Time
              else
                PDateTime(Buffer)^ := sqlite3_cell16_as_time(Data);
              {$ELSE COMPILER_5_UP}
              PInteger(Buffer)^ := DateTimeToTimeStamp(sqlite3_cell16_as_time(Data)).Time;
              {$ENDIF COMPILER_5_UP}
            end;

          ftWideString:
            begin
              {$IFDEF COMPILER_10_UP}
              if not NativeFormat and (Field is TDISQLite3WideStringField) then
                begin
                  Pointer(Buffer^) := nil;
                  {$IFDEF COMPILER_12_UP}PUnicodeString{$ELSE}PWideString{$ENDIF}(Buffer)^ :=
                  sqlite3_cell16_as_widestring(Data);
                end
              else
                begin
                  w := sqlite3_cell16_as_widestring(Data);
                  l := Length(w);
                  if l > Field.Size then
                    l := Field.Size;
                  Move(Pointer(w)^, Buffer^, l * 2);
                  PWideChar(Buffer)[l] := #0;
                end;
              {$ELSE COMPILER_10_UP}
              Pointer(Buffer^) := nil;
              PWideString(Buffer)^ := sqlite3_cell16_as_widestring(Data);
              {$ENDIF COMPILER_10_UP}
            end;

          ftWord:
            begin
              PWord(Buffer)^ := sqlite3_cell16_as_integer(Data);
            end;

        else
          raise Exception.Create('Unsupported DataType');
        end;
    end;
end;

procedure BindDataSet(const AStmt: sqlite3_stmt; const ADataSet: TDataSet);
var
  f: TField;
  i: Integer;
  Old: Boolean;
  p: PAnsiChar;
  Value: Variant;
begin
  for i := 1 to sqlite3_bind_parameter_count(AStmt) do
    begin
      p := sqlite3_bind_parameter_name(AStmt, i);

      if Assigned(p) and (p^ = ':') then
        begin
          Inc(p);
          Old := IsOld(p);
          if Old then
            Inc(p, 4);
          f := ADataSet.FindField(sqlite3_decode_utf8(p));
          if Assigned(f) then
            begin
              if Old then
                Value := f.OldValue
              else
                begin
                  Value := f.NewValue;
                  if VarIsEmpty(Value) then
                    Value := f.OldValue;
                end;

              if not VarIsEmpty(Value) then
                begin

                  if f.IsBlob then
                    begin
                      sqlite3_check_stmt(sqlite3_bind_str(AStmt, i, Utf8String(Value)), AStmt);
                    end
                  else
                    sqlite3_check_stmt(sqlite3_bind_variant(AStmt, i, Value), AStmt);
                end;
            end;
        end;
    end;
end;

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.PSExecuteStatement(
  const ASql: {$IFDEF COMPILER_10_UP}UnicodeString{$ELSE}AnsiString{$ENDIF};
  AParams: TParams;
  AResultSet: Pointer = nil): Integer;
var
  Stmt: TDISQLite3Statement;
  Query: TDISQLite3UniDirQuery;
begin
  if Assigned(AResultSet) then
    begin
      Query := TDISQLite3UniDirQuery.Create(nil);
      Query.OnInitFieldDef := Self.OnInitFieldDef;
      Query.Database := Database;
      Query.SelectSQL := ASql;
      Query.Params.Assign(AParams);
      Query.Active := True;
      TDataSet(AResultSet^) := Query;
      Result := 0;
    end
  else
    begin
      Stmt := TDISQLite3Statement.Create;
      try
        Stmt.Database := Database;
        Stmt.SQL16 := ASql;
        Stmt.Active := True;
        BindParams(Stmt.Handle, AParams);
        Stmt.Step;
        Result := Database.Changes;
      finally
        Stmt.Free;
      end;
    end;
end;
{$ENDIF COMIPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.{$IFDEF PS_WIDE}PSGetKeyFieldsW: WideString{$ELSE}PSGetKeyFields: string{$ENDIF};
var
  i: Integer;
begin
  Result := '';
  for i := 0 to FColumnCount - 1 do
    with FRowBuffer[i].Col do
      if ColumnIsKey then
        begin
          if Result <> '' then
            Result := Result + ';';
          Result := Result + ColumnName;
        end;
end;
{$ENDIF COMIPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.PSGetParams: TParams;
begin
  Result := FParams;
end;
{$ENDIF COMIPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.{$IFDEF PS_WIDE}PSGetQuoteCharW: WideString{$ELSE}PSGetQuoteChar: string{$ENDIF};
begin
  Result := SQLITE3_IDENTIFIER_QUOTE_CHAR;
end;
{$ENDIF COMIPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.{$IFDEF PS_WIDE}PSGetTableNameW: WideString{$ELSE}PSGetTableName: string{$ENDIF};
var
  OldActive: Boolean;
begin
  with FSelectStatement do
    begin
      OldActive := Active;
      Active := True;
      try
        Result := TableName16(SQLITE3_IDENTIFIER_QUOTE_CHAR);
      finally
        Active := OldActive;
      end;
    end;
end;
{$ENDIF COMIPILER_5_UP}

{$IFDEF COMPILER_5_UP}
procedure TDISQLite3UniDirQuery.PSEndTransaction(Commit: Boolean);
begin
  if Commit then
    Database.Commit
  else
    Database.Rollback;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.PSInTransaction: Boolean;
begin
  Result := Database.InTransaction;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.PSIsSQLBased: Boolean;
begin
  Result := True;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.PSIsSQLSupported: Boolean;
begin
  Result := True;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
procedure TDISQLite3UniDirQuery.PSReset;
begin
  if Active then
    FSelectStatement.Reset;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
procedure TDISQLite3UniDirQuery.PSSetParams(AParams: TParams);
begin
  if AParams.Count > 0 then
    FParams.Assign(AParams);
  Close;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
procedure TDISQLite3UniDirQuery.PSStartTransaction;
begin
  Database.StartTransaction;
end;
{$ENDIF COMPILER_5_UP}

{$IFDEF COMPILER_5_UP}
function TDISQLite3UniDirQuery.PSUpdateRecord(AUpdateKind: TUpdateKind; ADelta: TDataSet): Boolean;
var
  Stmt: TDISQLite3Statement;
begin
  Stmt := FUpdateStatements[AUpdateKind];
  Result := Assigned(Stmt);
  if Result then
    try
      Stmt.Active := True;

      BindParams(Stmt.Handle, FParams);
      BindDataSet(Stmt.Handle, ADelta);
      Result := (Stmt.StepAndReset = SQLITE_DONE) and
        (Stmt.Database.Changes = 1);
    except
      Result := False;
    end;
end;
{$ENDIF COMPILER_5_UP}

procedure TDISQLite3UniDirQuery.ReadParamData(Reader: TReader);
begin
  Reader.ReadValue;
  Reader.ReadCollection(FParams);
end;

procedure TDISQLite3UniDirQuery.SelectStatementAfterClose(ASender: TObject);
begin
  Active := False;
end;

procedure TDISQLite3UniDirQuery.SetDatabase(const AValue: TDISQLite3Database);
var
  uk: TUpdateKind;
  Stmt: TDISQLite3Statement;
begin
  CheckInactive;
  FSelectStatement.Database := AValue;
  for uk := Low(TUpdateKind) to High(TUpdateKind) do
    begin
      Stmt := FUpdateStatements[uk];
      if Assigned(Stmt) then
        Stmt.Database := AValue;
    end;
end;

procedure TDISQLite3UniDirQuery.SetParams(const AValue: TParams);
begin
  FParams.AssignValues(AValue);
end;

procedure TDISQLite3UniDirQuery.SqlChanged;

  procedure AddParams(const AStmt: TDISQLite3Statement);
  var
    i: Integer;
    p: PAnsiChar;
    ParamName: string;
    Stmt: TDISQLite3Statement;
  begin
    Stmt := TDISQLite3Statement.Create;
    try
      Stmt.Assign(AStmt);
      Stmt.Active := True;
      for i := 1 to Stmt.Bind_Parameter_Count do
        begin
          p := sqlite3_bind_parameter_name(Stmt.Handle, i);
          if Assigned(p) and (p^ = ':') then
            begin
              Inc(p);

              if not IsOld(p) then
                begin
                  ParamName := sqlite3_decode_utf8(p);

                  if FParams.FindParam(ParamName) = nil then
                    begin
                      (FParams.Add as TParam).Name := ParamName;
                    end;
                end;
            end;
        end;
    finally
      Stmt.Free;
    end;
  end;

var
  OldParams: TParams;
  Stmt: TDISQLite3Statement;
  uk: TUpdateKind;
begin
  if not (csReading in ComponentState) then
    begin
      Active := False;
      if FParamCheck or (csDesigning in ComponentState) then
        begin
          OldParams := TParams.Create(Self);
          try
            OldParams.Assign(FParams);
            FParams.Clear;
            AddParams(FSelectStatement);
            for uk := Low(uk) to High(uk) do
              begin
                Stmt := FUpdateStatements[uk];
                if Assigned(Stmt) then
                  AddParams(Stmt);
              end;
            FParams.AssignValues(OldParams);
          finally
            OldParams.Free;
          end;
        end;
    end;
end;

procedure TDISQLite3UniDirQuery.WriteParamData(Writer: TWriter);
begin
  Writer.WriteCollection(Params);
end;

{$IFNDEF COMPILER_6_UP}

function TDISQLite3UniDirQuery.AllocRecordBuffer: PChar;
begin
  Result := nil;
end;

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

procedure TDISQLite3UniDirQuery.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
end;

function TDISQLite3UniDirQuery.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
  Result := bfCurrent;
end;

function TDISQLite3UniDirQuery.GetPriorRecord: Boolean;
begin
  CheckBiDirectional;
  Result := inherited GetPriorRecord;
end;

function TDISQLite3UniDirQuery.GetPriorRecords: Integer;
begin
  if not IsUniDirectional then
    Result := inherited GetPriorRecords
  else
    Result := 0;
end;

function TDISQLite3UniDirQuery.GetRecordSize: Word;
begin

  Result := 1024;
end;

procedure TDISQLite3UniDirQuery.InternalAddRecord(Buffer: Pointer; Append: Boolean);
begin
end;

procedure TDISQLite3UniDirQuery.InternalDelete;
begin
end;

procedure TDISQLite3UniDirQuery.InternalFirst;
begin
  FSelectStatement.Reset;
end;

procedure TDISQLite3UniDirQuery.InternalGotoBookmark(Bookmark: Pointer);
begin
end;

procedure TDISQLite3UniDirQuery.InternalInitRecord(Buffer: PChar);
begin
end;

procedure TDISQLite3UniDirQuery.InternalLast;
begin
end;

procedure TDISQLite3UniDirQuery.InternalPost;
begin
end;

procedure TDISQLite3UniDirQuery.InternalSetToRecord(Buffer: PChar);
begin
end;

procedure TDISQLite3UniDirQuery.Resync(Mode: TResyncMode);
begin
  if not IsUniDirectional then
    inherited;
end;

procedure TDISQLite3UniDirQuery.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
end;

procedure TDISQLite3UniDirQuery.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
end;

procedure TDISQLite3UniDirQuery.SetFieldData(Field: TField; Buffer: Pointer);
begin
end;

procedure TDISQLite3UniDirQuery.SetFiltered(Value: Boolean);
begin
  if Value = True then CheckBiDirectional;
  inherited;
end;

procedure TDISQLite3UniDirQuery.SetFilterOptions(Value: TFilterOptions);
begin
  CheckBiDirectional;
  inherited;
end;

procedure TDISQLite3UniDirQuery.SetFilterText(const Value: string);
begin
  CheckBiDirectional;
  inherited;
end;

procedure TDISQLite3UniDirQuery.SetOnFilterRecord(const Value: TFilterRecordEvent);
begin
  CheckBiDirectional;
  inherited;
end;

procedure TDISQLite3UniDirQuery.SetUniDirectional(const Value: Boolean);
begin
  FIsUniDirectional := Value;
end;

{$ENDIF !COMPILER_6_UP}

constructor TDISQLite3BlobStream.Create(const Data: Pointer; const Size: Integer);
begin
  inherited Create;
  SetPointer(Data, Size);
end;

function TDISQLite3BlobStream.Write(const Buffer; Count: LongInt): LongInt;
begin
  {$IFDEF COMPILER_5_UP}
  raise EStreamError.CreateRes(PResStringRec(@SCannotWriteStreamError));
  {$ELSE COMPILER_5_UP}
  raise EStreamError.Create(SCannotWriteStreamError);
  {$ENDIF COMPILER_5_UP}
end;

{$IFNDEF COMPILER_10_UP}
function TDISQLite3BlobField.GetAsWideString: UnicodeString;
var
  l: Integer;
begin
  with DataSet.CreateBlobStream(Self, bmRead) do
    try
      l := Size div 2;
      SetString(Result, nil, l);
      ReadBuffer(Pointer(Result)^, l * 2);
    finally
      Free;
    end;
end;
{$ENDIF COMPILER_10_UP}

{$IFNDEF COMPILER_10_UP}
procedure TDISQLite3BlobField.SetAsWideString(const AValue: WideString);
begin
  with DataSet.CreateBlobStream(Self, bmWrite) do
    try
      WriteBuffer(Pointer(AValue)^, Length(AValue) * 2);
    finally
      Free;
    end;
end;
{$ENDIF COMPILER_10_UP}

constructor TDISQLite3MemoField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetDataType(ftMemo);
end;

function TDISQLite3MemoField.GetAsString: string;
begin
  Result := GetAsWideString;
end;

procedure TDISQLite3MemoField.SetAsString(const AValue: string);
begin
  SetAsWideString(AValue);
end;

function TDISQLite3MemoStream.Write(const Buffer; Count: Integer): Integer;
begin
  {$IFDEF COMPILER_5_UP}
  raise EStreamError.CreateRes(PResStringRec(@SCannotWriteStreamError));
  {$ELSE COMPILER_5_UP}
  raise EStreamError.Create(SCannotWriteStreamError);
  {$ENDIF COMPILER_5_UP}
end;

{$IFNDEF COMPILER_5_UP}
constructor TDISQLite3WideStringField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetDataType(ftWideString);
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_5_UP}
class procedure TDISQLite3WideStringField.CheckTypeSize(Value: Integer);
begin
  if (Value < 0) then
    DatabaseError(PResStringRec(@SInvalidFieldSize));
end;
{$ENDIF !COMPILER_5_UP}

{$IFDEF TDISQLite3WideStringField_CopyData}
procedure TDISQLite3WideStringField.CopyData(Source, Dest: Pointer);
begin
  WideString(Dest^) := WideString(Source^);
end;
{$ENDIF TDISQLite3WideStringField_CopyData}

{$IFDEF TDISQLite3WideStringField_GetAsString}

function TDISQLite3WideStringField.GetAsString: string;
begin
  Result := GetAsWideString;
end;
{$ENDIF TDISQLite3WideStringField_GetAsString}

{$IFDEF TDISQLite3WideStringField_GetAsVariant}
function TDISQLite3WideStringField.GetAsVariant: Variant;
{$IFNDEF COMPILER_5_UP}

var
  s: PWideChar;
begin
  s := nil;
  if GetData(@s) then
    begin
      TVarData(Result).VOleStr := PWideChar(s);
      TVarData(Result).vType := varOleStr;
    end
  else
    Result := NULL;
  {$ELSE !COMPILER_5_UP}
{$IFDEF COMPILER_10_UP}

var
  s: UnicodeString;
begin
  if GetData(@s, False) then
    Result := s
  else
    Result := NULL;
  {$ENDIF COMPILER_10_UP}
  {$ENDIF COMPILER_5_UP}
end;
{$ENDIF TDISQLite3WideStringField_GetAsVariant}

function TDISQLite3WideStringField.GetAsWideString: {$IFDEF COMPILER_12_UP}UnicodeString{$ELSE}WideString{$ENDIF};
begin
  if not GetData(@Result{$IFDEF COMPILER_5_UP}, False{$ENDIF}) then
    Result := '';
end;

{$IFDEF TDISQLite3WideStringField_GetDataSize}
function TDISQLite3WideStringField.GetDataSize: {$IFDEF COMPILER_5_UP}Integer{$ELSE}Word{$ENDIF};
begin
  Result := SizeOf(WideString);
end;
{$ENDIF TDISQLite3WideStringField_GetDataSize}

{$IFNDEF COMPILER_5_UP}
procedure TDISQLite3WideStringField.SetAsString(const Value: string);
begin
  SetAsWideString(Value);
end;
{$ENDIF !COMPILER_5_UP}

procedure TDISQLite3WideStringField.SetAsWideString(const AValue: {$IFDEF COMPILER_12_UP}UnicodeString{$ELSE}WideString{$ENDIF});
var
  TruncValue: WideString;
begin

  if (Size > 0) and (Length(Value) > Size) then
    begin
      SetString(TruncValue, PWideChar(AValue), Size);

      SetData(@TruncValue)
    end
  else
    SetData(@AValue);
end;

{$IFNDEF COMPILER_5_UP}
procedure TDISQLite3WideStringField.SetVarValue(const Value: Variant);
begin
  SetAsWideString(Value);
end;
{$ENDIF !COMPILER_5_UP}

{$IFNDEF COMPILER_10_UP}
constructor TDISQLite3WideMemoField.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetDataType(ftMemo);
end;
{$ENDIF !COMPILER_10_UP}

{$IFNDEF COMPILER_10_UP}
function TDISQLite3WideMemoField.GetAsString: string;
begin
  Result := GetAsWideString;
end;
{$ENDIF !COMPILER_10_UP}

{$IFNDEF COMPILER_10_UP}
procedure TDISQLite3WideMemoField.SetAsString(const Value: string);
begin
  SetAsWideString(Value);
end;
{$ENDIF !COMPILER_10_UP}

procedure TDISQLite3DataSetImporter.CreateTable;
label
  AddCreate;
var
  addSep: Boolean;
  f: TField;
  i: Integer;
  s, SQL: UnicodeString;
begin
  DoStatechange(isCreateTable, FTableName);

  addSep := False;

  FDatabase.Execute16('DROP TABLE IF EXISTS ' + QuotedStr16(FTableName) + ';');

  SQL := 'CREATE TABLE ' + DISQLite3Api.QuotedStr16(FTableName) + '(';
  for i := 0 to FDataSet.FieldCount - 1 do
    begin
      f := FDataSet.Fields[i];
      case f.DataType of

        ftUnknown:
          begin
          end;

        ftString, ftMemo, ftFmtMemo, ftFixedChar, ftWideString
          {$IFDEF COMPILER_5_UP}, ftVariant, ftGuid{$ENDIF}
        {$IFDEF COMPILER_10_UP}, ftFixedWideChar, ftWideMemo,
        ftOraInterval{$ENDIF}:
          begin
            s := 'TEXT';
            goto AddCreate;
          end;

        ftSmallint, ftInteger, ftWord, ftBoolean, ftLargeInt:
          begin
            s := 'INTEGER';
            goto AddCreate;
          end;

        ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime
          {$IFDEF COMPILER_6_UP}, ftTimeStamp{$ENDIF}
        {$IFDEF COMPILER_10_UP}, ftOraTimeStamp{$ENDIF}:
          begin
            s := 'REAL';
            goto AddCreate;
          end;

        ftBytes, ftVarBytes, ftBlob, ftGraphic, ftParadoxOle, ftDBaseOle,
          ftTypedBinary, ftCursor, ftADT, ftArray, ftReference, ftDataSet
          {$IFDEF COMPILER_5_UP}, ftOraBlob, ftOraClob, ftInterface,
        ftIDispatch{$ENDIF}
        {$IFDEF COMPILER_6_UP}, ftFMTBcd{$ENDIF}:
          begin
            s := 'BLOB';
            goto AddCreate;
          end;

        ftAutoInc:
          begin
            s := 'INTEGER PRIMARY KEY';
            AddCreate:
            if addSep then SQL := SQL + ', ' else addSep := True;
            SQL := SQL + QuotedStr16(f.FieldName) + ' ' + s;
          end;

      else
        Assert(False, 'Error');
      end;

      if f.Required then
        SQL := SQL + ' NOT NULL';
      if f.ImportedConstraint <> '' then
        SQL := SQL + ' CHECK(' + f.ImportedConstraint + ')';

    end;
  SQL := SQL + ');';

  FDatabase.Execute16(SQL);
end;

procedure TDISQLite3DataSetImporter.CreateIndexes;
begin

end;

procedure TDISQLite3DataSetImporter.DoImportError(
  const AException: Exception;
  out AContinueImport: Boolean);
begin
  AContinueImport := False;
  if Assigned(FOnImportError) then
    FOnImportError(Self, AException, AContinueImport);
end;

procedure TDISQLite3DataSetImporter.DoProgress(
  const APos, ATotal: Integer);
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self, APos, ATotal);
end;

procedure TDISQLite3DataSetImporter.DoStatechange(
  const AState: TDISQLite3ImporterState;
  const AMessage: UnicodeString);
begin
  if Assigned(FOnStateChange) then
    FOnStateChange(Self, AState, AMessage);
end;

procedure TDISQLite3DataSetImporter.Execute;
var
  BM: TBookmark;
  DatabaseConnected, DataSetActive: Boolean;
begin
  if not Assigned(FDatabase) then
    DISQLite3Database.DatabaseError(PResStringRec(@SMissingDatabase));
  if not Assigned(FDataSet) then
    DISQLite3Database.DatabaseError(PResStringRec(@SMissingDataSet));

  DatabaseConnected := FDatabase.Connected;
  DataSetActive := FDataSet.Active;
  try
    FDataSet.DisableControls;
    if not DataSetActive then
      FDataSet.Active := True;

    try BM := FDataSet.GetBookmark; except BM := nil; end;
    try
      FDataSet.CheckBrowseMode;

      try FDataSet.UpdateCursorPos; except end;

      FDatabase.StartTransaction;
      try
        CreateTable;
        InsertData;
        CreateIndexes;
        FDatabase.Commit;
      except
        FDatabase.Rollback;
        raise;
      end;

    finally
      if Assigned(BM) then
        begin

          try FDataSet.GotoBookmark(BM); except end;
          try FDataSet.FreeBookmark(BM); except end;
        end;
    end;
  finally
    if not DataSetActive then
      FDataSet.Active := DataSetActive;
    FDataSet.EnableControls;
    if not DatabaseConnected then
      FDatabase.Connected := DatabaseConnected;
  end;
end;

procedure TDISQLite3DataSetImporter.InsertData;
type

  TGraphicHeader = record
    Count: Word;
    HType: Word;
    Size: Integer;
  end;
var
  addSep: Boolean;
  BlobStream: TStream;
  BlobMem: Pointer;
  BlobSize: Integer;
  ContinueOnImportException: Boolean;
  f: TField;
  GraphicHeader: TGraphicHeader;
  i: Integer;
  RecCnt, DataSet_RecCnt: Integer;
  s, SQL: UnicodeString;
  Stmt: TDISQLite3Statement;
begin
  DoStatechange(isInsert, FTableName);

  addSep := False;
  SQL := 'INSERT INTO ' + QuotedStr16(FTableName) + ' VALUES (';
  for i := 0 to FDataSet.FieldCount - 1 do
    begin
      f := FDataSet.Fields[i];

      case f.DataType of

        ftUnknown:
          begin

          end;

        ftString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
          ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, ftBytes, ftVarBytes,
          ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
          ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
          ftLargeInt, ftADT, ftArray, ftReference, ftDataSet
          {$IFDEF COMPILER_5_UP}, ftOraBlob, ftOraClob, ftVariant,
        ftInterface, ftIDispatch, ftGuid{$ENDIF}
        {$IFDEF COMPILER_6_UP}, ftTimeStamp, ftFMTBcd{$ENDIF}
        {$IFDEF COMPILER_10_UP}, ftFixedWideChar, ftWideMemo,
        ftOraTimeStamp, ftOraInterval{$ENDIF}:
          begin
            if addSep then
              SQL := SQL + ','
            else
              addSep := True;
            SQL := SQL + '?';
          end;
      else
        Assert(False, 'Error');
      end;

    end;
  SQL := SQL + ');';

  Stmt := FDatabase.Prepare16(SQL);
  try

    RecCnt := 0;
    DataSet_RecCnt := FDataSet.RecordCount;
    FDataSet.First;
    while not FDataSet.EOF do
      begin
        try

          for i := 0 to FDataSet.FieldCount - 1 do
            begin
              f := FDataSet.Fields[i];

              if f.IsNull then
                Stmt.Bind_Null(i + 1)
              else
                case f.DataType of

                  ftUnknown:
                    begin

                    end;

                  ftString, ftMemo, ftFmtMemo, ftFixedChar, ftWideString
                    {$IFDEF COMPILER_5_UP}, ftVariant, ftGuid{$ENDIF}
                  {$IFDEF COMPILER_10_UP}, ftFixedWideChar, ftWideMemo, ftOraInterval{$ENDIF}:
                    begin
                      {$IFDEF COMPILER_10_UP}
                      s := f.AsWideString;
                      {$ELSE COMPILER_10_UP}
                      if f.IsNull then

                        s := ''
                      else
                        if f is TMemoField then
                          s := f.AsVariant
                        else
                          s := f.AsString;
                      {$ENDIF COMPILER_10_UP}

                      if f.IsBlob then
                        s := WideAdjustLineBreaks(s);

                      Stmt.Bind_Str16(i + 1, s);
                    end;

                  ftBoolean:
                    begin
                      if f.Value then
                        Stmt.Bind_Int(i + 1, 1)
                      else
                        Stmt.Bind_Int(i + 1, 0);
                    end;

                  ftAutoInc, ftSmallint, ftInteger, ftWord:
                    begin
                      Stmt.Bind_Int(i + 1, f.Value);
                    end;

                  ftLargeInt:
                    begin
                      {$IFDEF COMPILER_6_UP}
                      Stmt.Bind_Int64(i + 1, f.Value);
                      {$ELSE}

                      if f is TLargeIntField then
                        Stmt.Bind_Int64(i + 1, (f as TLargeIntField).Value)
                      else
                        Stmt.Bind_Int(i + 1, f.Value);
                      {$ENDIF}

                    end;

                  ftFloat, ftCurrency, ftBCD:
                    begin
                      Stmt.Bind_Double(i + 1, f.Value);
                    end;

                  ftDateTime
                    {$IFDEF COMPILER_6_UP}, ftTimeStamp{$ENDIF}
                  {$IFDEF COMPILER_10_UP}, ftOraTimeStamp{$ENDIF}:
                    begin
                      Stmt.Bind_Double(i + 1, DISQLite3Api.DateTimeToJulianDate(f.Value));
                    end;

                  ftDate:
                    begin
                      Stmt.Bind_Double(i + 1, DISQLite3Api.DateToJulianDate(f.Value));
                    end;

                  ftTime:
                    begin
                      Stmt.Bind_Double(i + 1, DISQLite3Api.TimeToJulianDate(f.Value));
                    end;

                  ftBytes, ftVarBytes, ftBlob, ftParadoxOle, ftDBaseOle,
                    ftCursor, ftADT, ftArray, ftReference, ftDataSet
                    {$IFDEF COMPILER_5_UP}, ftOraBlob, ftOraClob, ftInterface, ftIDispatch{$ENDIF}
                  {$IFDEF COMPILER_6_UP}, ftFMTBcd{$ENDIF}:
                    begin
                      BlobStream := FDataSet.CreateBlobStream(f, bmRead);
                      try
                        BlobSize := BlobStream.Size;
                        GetMem(BlobMem, BlobSize);
                        BlobStream.Read(BlobMem^, BlobSize);
                        Stmt.Bind_Blob(i + 1, BlobMem, BlobSize, sqlite3_Destroy_Mem);
                      finally
                        BlobStream.Free;
                      end;
                    end;

                  ftGraphic, ftTypedBinary:
                    begin
                      BlobStream := FDataSet.CreateBlobStream(f, bmRead);
                      try
                        BlobSize := BlobStream.Size;

                        BlobStream.Read(GraphicHeader, SizeOf(GraphicHeader));
                        if (GraphicHeader.Count <> 1) or
                          (GraphicHeader.HType <> $0100) or
                          (GraphicHeader.Size <> BlobSize - SizeOf(GraphicHeader)) then
                          BlobStream.Position := 0
                        else
                          Dec(BlobSize, SizeOf(GraphicHeader));

                        GetMem(BlobMem, BlobSize);
                        BlobStream.Read(BlobMem^, BlobSize);
                        Stmt.Bind_Blob(i + 1, BlobMem, BlobSize, sqlite3_Destroy_Mem);
                      finally
                        BlobStream.Free;
                      end;
                    end;

                else
                  Assert(False, 'Error');
                end;

            end;

          Stmt.StepAndReset;

          Inc(RecCnt);
          DoProgress(RecCnt, DataSet_RecCnt);

        except
          on ImportException: Exception do
            begin
              DoImportError(ImportException, ContinueOnImportException);
              if not ContinueOnImportException then
                raise ImportException;
            end;
        end;

        FDataSet.Next;
      end;

  finally
    Stmt.Free;
  end;
end;

procedure TDISQLite3DataSetImporter.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) then
    begin
      if AComponent = FDatabase then
        FDatabase := nil;
      if AComponent = FDataSet then
        FDataSet := nil;
    end;
  inherited;
end;

procedure TDISQLite3DataSetImporter.SetDatabase(const AValue: TDISQLite3Database);
begin
  if FDatabase <> AValue then
    begin
      {$IFDEF COMPILER_5_UP}
      if Assigned(FDatabase) then
        FDatabase.RemoveFreeNotification(Self);
      {$ENDIF COMPILER_5_UP}
      FDatabase := AValue;
      if Assigned(FDatabase) then
        FDatabase.FreeNotification(Self);
    end;
end;

procedure TDISQLite3DataSetImporter.SetDataSet(const AValue: TDataSet);
begin
  if FDataSet <> AValue then
    begin
      {$IFDEF COMPILER_5_UP}
      if Assigned(FDataSet) then
        FDataSet.RemoveFreeNotification(Self);
      {$ENDIF COMPILER_5_UP}
      FDataSet := AValue;
      if Assigned(FDataSet) then
        FDataSet.FreeNotification(Self);
    end;
end;

end.

