asgsqlite3.pas

定时器for timer for ic chip

{.$DEFINE DEBUG_ENABLED }// Enables Debug information
{.$DEFINE DEBUG_VERY_LOUD}
{.$DEFINE DEBUG_LOUD}

// Disable this for ignoring IProvider interface (for D4)
{$DEFINE IPROVIDER}

{$I Sqlite.inc}
{$I asqlite_def.inc}

Unit ASGSQLite3;

Interface

Uses
  DB,
  DBCommon,
  Dialogs,
  Classes,
  Windows,
  SysUtils,
  {$IFDEF ASQLITE_D6PLUS}
  Variants,
  {$ENDIF}
  ASGRout3,
  SQLite3Types;

Const
  SQLiteVersion = 'ASGSQLite V2008.11.23 by SkyGz.Com Updated';
  MaxBuf = 30000;                       // max stringbuffer for record (length) (excluding blob's)
  Crlf: String = #13#10;
  Q = '''';

Type
  pInteger = ^integer;
  pPointer = ^Pointer;
  pSmallInt = ^smallint;
  pFloat = ^extended;
  pBoolean = ^boolean;

  TConvertBuffer = Array[1..255] Of char;

  TSQLite3_Callback = Function(UserData: Pointer; ColumnCount: integer; ColumnValues, ColumnNames: pPointer): integer; cdecl;
  //  TSQLiteExecCallback = function(Sender: TObject; Columns: integer; ColumnValues: Pointer; ColumnNames: Pointer): integer of object; cdecl;
  TOnData = Procedure(Sender: TObject; Columns: integer; ColumnNames, ColumnValues: String) Of Object;
  TOnBusy = Procedure(Sender: TObject; ObjectName: String; BusyCount: integer; Var Cancel: boolean) Of Object;
  TOnQueryComplete = Procedure(Sender: TObject) Of Object;
  TASQLite3NotifyEvent = Procedure(Sender: TObject) Of Object;

  // structure for holding field information. It is used by GetTableInfo

  TASQLite3Field = Class
  Public
    FieldNumber: integer;
    FieldName: String;
    FieldType: String;
    FieldNN: integer;                   // 1 if notnull
    FieldDefault: String;
    FieldPK: integer;                   // 1 if primary key
  End;

  // object to 'play' with SQLite's default settings

  TASQLite3Pragma = Class(TComponent)
  Private
    FTempCacheSize: integer;
    FDefaultCacheSize: integer;
    FDefaultSynchronous: String;
    FDefaultTempStore: String;
    FTempStore: String;
    FSynchronous: String;
  Protected
    Function GetTempCacheSize: String;
    Function GetDefaultCacheSize: String;
    Function GetDefaultSynchronous: String;
    Function GetDefaultTempStore: String;
    Function GetTempStore: String;
    Function GetSynchronous: String;
  Published
    { Published declarations }
    Property TempCacheSize: integer Read FTempCacheSize Write FTempCacheSize;
    Property DefaultCacheSize: integer Read FDefaultCacheSize Write FDefaultCacheSize;
    Property DefaultSynchronous: String Read FDefaultSynchronous
      Write FDefaultSynchronous;
    Property DefaultTempStore: String Read FDefaultTempStore Write FDefaultTempStore;
    Property TempStore: String Read FTempStore Write FTempStore;
    Property Synchronous: String Read FSynchronous Write FSynchronous;
  End;

  // component to log messages
  // it's for debugging purpose and may be obsolete due
  // to the event implementation. not sure yet...

  TASQLite3Log = Class(TComponent)
  Private
    FLogFile: String;
    FLogDebugOut: boolean;
    FAppend: boolean;
    FLogSQL: boolean;
    FLogInt: boolean;
  Protected
  Public
    Procedure Display(Msg: String);
  Published
    { Published declarations }
    Property LogFile: String Read FLogFile Write FLogFile;
    Property LogDebugOut: boolean Read FLogDebugOut Write FLogDebugOut; // 20040225
    Property Append: boolean Read FAppend Write FAppend;
    Property LogSQL: boolean Read FLogSQL Write FLogSQL;
    Property LogInternals: boolean Read FLogInt Write FLogInt;
  End;

  // This component can be used to store sql outside the pascal source.
  // It is useful for automatically creating tables on open of a temporary database
  // (i.e. in-memory database)

  TASQLite3InlineSQL = Class(TComponent)
  Private
    FSQL: TStrings;
    Procedure SetSQL(Const Value: TStrings);
    Function GetSQL: TStrings;
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
  Published
    Property SQL: TStrings Read GetSQL Write SetSQL;
  End;

  { Basic Database component }

  TASQLite3DB = Class(TComponent)
  Private
    fPassWord, fOldPassWord: AnsiString;
    { Private declarations }
    FAfterConnect: TASQLite3NotifyEvent;
    FBeforeConnect: TASQLite3NotifyEvent;
    FAfterDisconnect: TASQLite3NotifyEvent;
    FBeforeDisconnect: TASQLite3NotifyEvent;
    Function FGetDefaultExt: String;
    Function FGetDriverDLL: String;
  Protected
    { Protected declarations }
    FInlineSQL: TASQLite3InlineSQL;
    FExecuteInlineSQL: boolean;
    FDatabase: String;
    FTransactionType: String;
    FSQLiteVersion: String;
    FDefaultExt: String;
    FDefaultDir: String;
    FDriverDll: String;
    FConnected: boolean;
    FMustExist: boolean;
    FVersion: String;
    FCharEnc: String;
    FUtf8: boolean;
    DBHandle: TSQLiteDB;
    FASQLitePragma: TASQLite3Pragma;
    FASQLiteLog: TASQLite3Log;
    FLastError: String;

    SQLite3_Key: Function(DB: TSQLiteDB; Key: PChar; KeyLen: integer): integer; Cdecl;
    SQLite3_Rekey: Function(DB: TSQLiteDB; Key: PChar; KeyLen: integer): integer; Cdecl;

    SQLite3_Open: Function(dbname: PAnsiChar; Var DB: TSQLiteDB): integer; Cdecl;
    SQLite3_Close: Function(DB: TSQLiteDB): integer; Cdecl;
    SQLite3_Exec: Function(DB: TSQLiteDB; SQLStatement: PAnsiChar; Callback: TSQLite3_Callback;
      UserDate: Pointer; Var ErrMsg: PAnsiChar): integer; Cdecl;
    SQLite3_LibVersion: Function(): PAnsiChar; Cdecl;
    SQLite3_ErrorString: Function(DB: TSQLiteDB): PAnsiChar; Cdecl;
    SQLite3_GetTable: Function(DB: TSQLiteDB; 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: TSQLiteDB): integer; Cdecl;
    SQLite3_Cancel: Procedure(DB: TSQLiteDB); Cdecl;
    SQLite3_BusyHandler: Procedure(DB: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); Cdecl;
    SQLite3_BusyTimeout: Procedure(DB: TSQLiteDB; TimeOut: integer); Cdecl;
    SQLite3_Changes: Function(DB: TSQLiteDB): integer; Cdecl;
    SQLite3_Prepare: Function(DB: TSQLiteDB; 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: TSQLiteDB; TheStatement: String; FParams: TParams; Sender: TObject): Pointer;
    Function SQLite3_GetNextResult(DB: TSQLiteDB; TheStatement: Pointer; FParams: TParams; Sender: TObject): Pointer;
    Procedure SQLite3_CloseResult(TheStatement: Pointer);
  Public
    DLLHandle: THandle;
    { Public declarations }
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Function LoadLibs: boolean;
    Procedure FSetDatabase(Database: 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 GetIndexFieldNames(IndexName: String; List: TStrings);
    Procedure GetFieldNames(TableName: String; List: TStrings);
    Procedure GetPrimaryKeys(TableName: String; List: TStrings);
    Procedure GetTableIndexNames(TableName: String; List: TStrings);
    Procedure ExecPragma;
    //    function SQLite_XExec(DB: TSQLiteDB; SQLStatement: PAnsiChar;
    //      CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PAnsiChar): integer; cdecl;
    Function SQLite3_Execute(DB: TSQLiteDB; 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 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;
    Property PassWord: AnsiString Read fPassWord Write fPassWord;
  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;