asgsqlite3.pas

连接sqlite数据库控件

    FExecuteInlineSQL: boolean;
    FDatabase: string;
    FTransactionType: string;
    FSQLiteVersion: string;
    FDefaultExt: string;
    FDefaultDir: string;
    FDriverDll: string;
    FConnected: boolean;
    FMustExist: boolean;
    FVersion: string;
    FCharEnc: string;
    FUtf8: boolean;

    FASQLitePragma: TASQLite3Pragma;
    FASQLiteLog: TASQLite3Log;
    FLastError: string;
    SQLite3_Open: function(dbname: PAnsiChar; var db: pointer): integer; cdecl;
    SQLite3_Close: function(db: pointer): integer; cdecl;
    SQLite3_Key: function(db: pointer; Key : Pointer; nLen : integer): integer; cdecl;
    SQLite3_ReKey: function(db: pointer; Key : Pointer; nLen : integer): integer; cdecl;
    SQLite3_Exec: function(DB: Pointer; SQLStatement: PAnsiChar; Callback: TSQLite3_Callback;
                           UserDate: Pointer; var ErrMsg: PAnsiChar): Integer; cdecl;
    SQLite3_LibVersion: function(): PAnsiChar; cdecl;
    SQLite3_ThreadSafe: function(): Integer; cdecl;
    SQLite3_ErrorString: function(db: pointer): PAnsiChar; cdecl;
    SQLite3_GetTable: function(db: Pointer; SQLStatement: PAnsiChar; var ResultPtr: Pointer;
      var RowCount: cardinal; var ColCount: cardinal; var ErrMsg: PAnsiChar): integer; cdecl;
    SQLite3_FreeTable: procedure(Table: PAnsiChar); cdecl;
    SQLite3_FreeMem: procedure(P: PAnsiChar); cdecl;
    SQLite3_Complete: function(P: PAnsiChar): boolean; cdecl;
    SQLite3_LastInsertRow: function(db: Pointer): integer; cdecl;
    SQLite3_Cancel: procedure(db: Pointer); cdecl;
    SQLite3_BusyHandler: procedure(db: Pointer; CallbackPtr: Pointer; Sender: TObject); cdecl;
    SQLite3_BusyTimeout: procedure(db: Pointer; TimeOut: integer); cdecl;
    SQLite3_Changes: function(db: Pointer): integer; cdecl;
    SQLite3_Prepare: function(db: Pointer; SQLStatement: PAnsiChar; nBytes: integer;
      var hstatement: pointer; var Tail: PAnsiChar): integer; cdecl;
    SQLite3_Finalize: function(hstatement: pointer): integer; cdecl;
    SQLite3_Reset: function(hstatement: pointer): integer; cdecl;
    SQLite3_Step: function(hstatement: pointer): integer; cdecl;
    SQLite3_Column_blob: function(hstatement: pointer; iCol: integer): pointer; cdecl;
    SQLite3_Column_bytes: function(hstatement: pointer; iCol: integer): integer; cdecl;
    SQLite3_Column_count: function(hstatement: pointer): integer; cdecl;
    SQLite3_Column_decltype: function(hstatement: pointer; iCol: integer): PAnsiChar; cdecl;
    SQLite3_Column_double: function(hstatement: pointer; iCol: integer): double; cdecl;
    SQLite3_Column_int: function(hstatement: pointer; iCol: integer): integer; cdecl;
    SQLite3_Column_int64: function(hstatement: pointer; iCol: integer): int64; cdecl;
    SQLite3_Column_name: function(hstatement: pointer; iCol: integer): PAnsiChar; cdecl;
    SQLite3_Column_text: function(hstatement: pointer; iCol: integer): PAnsiChar; cdecl;
    SQLite3_Column_text16: function(hstatement: pointer; iCol: integer): PWideChar; cdecl;
    SQLite3_Column_type: function(hstatement: pointer; iCol: integer): integer; cdecl;
    SQLite3_Bind_Blob: function(hstatement: pointer; iCol: integer; buf: PAnsiChar; n: integer; DestroyPtr: Pointer): integer; cdecl;
    SQLite3_Bind_Text16: function(hstatement: pointer; iCol: integer; buf: pointer; n: integer; DestroyPtr: Pointer): integer; cdecl;//\\\
    SQLite3_Bind_Parameter_Count: function(hstatement: pointer): integer; cdecl;//\\\
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DBConnect(Connected: boolean);
    function SQLite3_PrepareResult(DB: Pointer; TheStatement: string; FParams: TParams; Sender: TObject) : pointer;
    function SQLite3_GetNextResult(DB: Pointer; TheStatement: pointer; FParams: TParams; Sender: TObject) : pointer;
    procedure SQLite3_CloseResult(TheStatement : pointer);
  public
    DLLHandle: THandle;
    DBHandle: Pointer;    
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function LoadLibs: boolean;
    procedure FSetDatabase(Database: string);
    procedure FSetDatabases(Databases: string);
    function RowsAffected: integer;
    function  TableExists(const ATableName: AnsiString): Boolean;
    procedure ExecStartTransaction(TransType: string);
    procedure StartTransaction;
    procedure StartDeferredTransaction;
    procedure StartImmediateTransaction;
    procedure StartExclusiveTransaction;
    procedure Open;
    procedure Close;
    procedure Commit;
    procedure RollBack;
    procedure ShowDatabases(List: TStrings);
    procedure GetTableNames(List: TStrings; SystemTables: boolean = false);
    procedure GetTableInfo(TableName: string; List: TList);
    procedure GetIndexNames(List: TStrings; SystemTables: boolean = false);
    procedure GetFieldNames(TableName: string; List: TStrings);
    procedure GetPrimaryKeys(TableName: string; List: TStrings);
    procedure GetTableIndexNames(TableName: string; List: TStrings);
    procedure ExecPragma;
//    function SQLite_XExec(db: Pointer; SQLStatement: PAnsiChar;
//      CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PAnsiChar): integer; cdecl;
    function SQLite3_Execute(db: Pointer; TheStatement: string; FParams: TParams; Sender: TObject): integer;
    function SQLite3_ExecSQL(TheStatement: string; Blobs: TList=nil): integer;
    procedure ShowError;
    function GetUserVersion(database : string=''): integer;
    procedure SetUserVersion(Version : integer; Database : string='');
  published
    { Published declarations }
    property CharacterEncoding: string read FCharEnc write FCharEnc;
    property TransactionType: string read FTransactionType write FTransactionType;
    property Database: string read FDatabase write FSetDatabase;
    property ASQLitePragma: TASQLite3Pragma read FASQLitePragma write FASQLitePragma;
    property ASQLiteLog: TASQLite3Log read FASQLiteLog write FASQLiteLog;
    property Databases: string read FDatabases write FSetDatabases;
    property DefaultExt: string read FGetDefaultExt write FDefaultExt;
    property DefaultDir: string read FDefaultDir write FDefaultDir;
    property Version: string read FVersion write FVersion;
//  property CharacterEncoding: string Read FCharEncoding Write FCharEncoding;
    property DriverDLL: string read FGetDriverDLL write FDriverDLL;
    property Connected: boolean read FConnected write DBConnect;
    property MustExist: boolean read FMustExist write FMustExist;
    property ASQLiteInlineSQL: TASQLite3InlineSQL read FInlineSQL write FInlineSQL;
    property ExecuteInlineSQL: boolean read FExecuteInlineSQL write FExecuteInlineSQL;
    property AfterConnect: TASQLite3NotifyEvent read FAfterConnect write FAfterConnect;
    property BeforeConnect: TASQLite3NotifyEvent read FBeforeConnect write FBeforeConnect;
    property AfterDisconnect: TASQLite3NotifyEvent
      read FAfterDisconnect write FAfterDisconnect;
    property BeforeDisconnect: TASQLite3NotifyEvent
      read FBeforeDisconnect write FBeforeDisconnect;
  end;

  AsgError = class(Exception);

{ TRecInfo }

{   This structure is used to access additional information stored in
  each record buffer which follows the actual record data.

    Buffer: PAnsiChar;
   ||
   \/
    --------------------------------------------
    |  Record Data  | Bookmark | Bookmark Flag |
    --------------------------------------------
                    ^-- PRecInfo = Buffer + FRecInfoOfs

  Keep in mind that this is just an example of how the record buffer
  can be used to store additional information besides the actual record
  data.  There is no requirement that TDataSet implementations do it this
  way.

  For the purposes of this demo, the bookmark format used is just an integer
  value.  For an actual implementation the bookmark would most likely be
  a native bookmark type (as with BDE), or a fabricated bookmark for
  data providers which do not natively support bookmarks (this might be
  a variant array of key values for instance).

  The BookmarkFlag is used to determine if the record buffer contains a
  valid bookmark and has special values for when the dataset is positioned
  on the "cracks" at BOF and EOF. }

  PRecInfo = ^TRecInfo;

  TRecInfo = packed record
    Bookmark : integer;
    BookmarkFlag : TBookmarkFlag;
//    Nulls :
  end;

 //============================================================================== TFResult
 // The TFResult class is used to maintain the resultlist in memory. This
 // will only be the case for 'normal' data. Blobs and Clobs will be treated
 // differently, but they are not supported yet.
 //==============================================================================
  TASQLite3BaseQuery = class;

  TFResult = class
  protected
    Data: TList;
    BookMark: TList;
    RowId: TList;
    FLastBookmark: integer;
    FBufSize: integer;
    FDataSet: TASQLite3BaseQuery;
  public
    constructor Create(TheDataSet: TASQLite3BaseQuery);
    destructor Destroy; override;
    procedure FreeBlobs;
    procedure SetBufSize(TheSize: integer);
    procedure Add(TheBuffer: PAnsiChar; TheRowId: integer);
    procedure Insert(Index: integer; TheBuffer: Pointer; TheRowId: integer);
    procedure Delete(Index: integer);
    function GetData(Index: integer): Pointer;
    function Count: integer;
    function IndexOf(TheBookMark: pointer): integer;
    function GetBookmark(Index: integer): integer;
    function GetRowId(Index: integer): integer;
  end;

//============================================================================== TASQLite3UpdateSQL
  TASQLite3UpdateSQL = class(TComponent)
  private
    FInsertSQL: TStrings;
    FUpdateSQL: TStrings;
    FDeleteSQL: TStrings;
    procedure SetInsertSQL(const Value: TStrings);
    procedure SetUpdateSQL(const Value: TStrings);
    procedure SetDeleteSQL(const Value: TStrings);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property InsertSQL: TStrings read FInsertSQL write SetInsertSQL;
    property UpdateSQL: TStrings read FUpdateSQL write SetUpdateSQL;
    property DeleteSQL: TStrings read FDeleteSQL write SetDeleteSQL;
  end;

//============================================================================== TASQLite3Output

  TASQLite3Output = class(TComponent)
  private
    FActive: boolean;
    FOutputType: string;
    FTableClass: string;
    FHeaderClass: string;
    FCellClass: string;
    FOutput: TStrings;
    FSeparator: string;
    FDataSource: TDataSource;
    procedure SetOutput(const Value: TStrings);
    procedure SetFActive(Active: boolean);
    function GetOutput: TStrings;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Execute(MyDataSet: TDataSet);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  published
    property Active: boolean read FActive write SetFActive;
    property DataSource: TDataSource read FDataSource write FDataSource;
    property OutputType: string read FOutputType write FOutputType;
    property TableClass: string read FTableClass write FTableClass;
    property HeaderClass: string read FHeaderClass write FHeaderClass;
    property CellClass: string read FCellClass write FCellClass;
    property Output: TStrings read GetOutput write SetOutput;
    property FieldSeparator: string read FSeparator write FSeparator;
  end;

//============================================================================== TASQLite3BaseQuery
  TASQLite3BaseQuery = class(TDataSet)
  private
    FParams: TParams;
    FTypeLess: boolean;
    FNoResults: boolean;                // suppresses the creation of a result list
    FAutoCommit: boolean;
    FTransactionType: string;
    FTableDateFormat: string;
    FSQLiteDateFormat: boolean;
    FResult: TFResult;
    FSQL: TStrings;
    FSQLCursor: boolean;
    FPrepared: string;
    FRecBufSize: integer;
    FRecInfoOfs: integer;
    FCurRec: integer;
    FMasterFields: string;
    FMasterSource: TDataSource;
    FSaveChanges: boolean;
    MaxStrLen: integer;
    FConnection: TASQLite3DB;
    FReadOnly: boolean;
    FMaxResults: integer;
    FStartResult: integer;
    FUniDir : boolean;
    FStatement : pointer;
    CurrentRowId: integer;
    SQLStr: string;
    ResultStr: PAnsiChar;
    RowId : integer;
    RowIdCol : integer;
    DetailList: TList;
    procedure SetSQL(const Value: TStrings);
    function UnpackBuffer(Buffer: PAnsiChar; FieldType: TFieldType): TConvertBuffer;
    procedure SetDataSource(Value: TDataSource);
  protected