asgsqlite3.pas

连接sqlite数据库控件

    function SetQueryParams(InStr: string): string; //***
    procedure SetParamsList(Value: TParams);
    function GetParamsCount: word;
    procedure RegisterDetailDataset(DetailDataSet: TASQLite3BaseQuery);
    procedure LoadQueryData;
    function GetActiveBuffer(var Buffer: PAnsiChar): boolean;
    function GetDataSource: TDataSource; override;
    procedure NotifySQLiteMasterChanged;

    { Overriden abstract methods (required) }
    function AllocRecordBuffer: PAnsiChar; override;
    procedure FreeRecordBuffer(var Buffer: PAnsiChar); override;
    procedure GetBookmarkData(Buffer: PAnsiChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PAnsiChar): TBookmarkFlag; override;
    function GetRecord(Buffer: PAnsiChar; GetMode: TGetMode;
      DoCheck: boolean): TGetResult; override;
    function GetRecordSize: word; override;
    procedure InternalAddRecord(Buffer: Pointer; Append: boolean); override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark(Bookmark: Pointer); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: PAnsiChar); override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalSetToRecord(Buffer: PAnsiChar); override;
    procedure OpenCursor(InfoQuery: Boolean); override; // GPA
    function IsCursorOpen: boolean; override;
    procedure SetBookmarkFlag(Buffer: PAnsiChar; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: PAnsiChar; Data: Pointer); override;
    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
    function GetFieldSize(FieldNo: integer): integer; overload;
    function GetFieldSize(Field: TField): integer; overload;
    function GetNativeFieldSize(FieldNo: integer): integer;
    function GetFieldOffset(FieldNo: integer): integer;
    function GetCalcFieldOffset(Field: TField): integer;
    function GetMasterFields: string;
    procedure SetMasterFields(const Value: string);
    { Additional overrides (optional) }
    function GetRecordCount: integer; override;
    function GetRecNo: integer; override;
    procedure SetRecNo(Value: integer); override;
    property BaseSQL: TStrings read FSQL write SetSQL;
    procedure SetSQLiteDateFormat(const Value: boolean);
    procedure SetFilterText(const Value: string); override;
    procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean); override;//\\\
    function CalcFieldInList(const List: string): Boolean;                      // John Lito

   {$IFDEF IPROVIDER}
   {***** IProviderSupport - Begin *****}
    //-----| These are not necessary until the moment!
    // procedure PSGetAttributes(List: TList); virtual;
    // function PSGetDefaultOrder: TIndexDef; virtual;
    // function PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; virtual;
    //-----| These are necessary to support IProvider
    procedure PSEndTransaction(Commit: Boolean); override;
    procedure PSExecute; override;
    function PSExecuteStatement(const ASQL: string; AParams: TParams; ResultSet: Pointer = nil): Integer; override;
    function PSGetParams: TParams; override;
    function PSGetTableName: string; override;
    function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
    function PSInTransaction: Boolean; override;
    function PSIsSQLBased: Boolean; override;
    function PSIsSQLSupported: Boolean; override;
    procedure PSReset; override;
    procedure PSSetCommandText(const CommandText: string); override;
    procedure PSSetParams(AParams: TParams); override;
    procedure PSStartTransaction; override;
    function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
    function PSGetQuoteChar: string; override;
    function PSGetKeyFields: string; override;
   {***** IProviderSupport - End *****}
   {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExecSQL;
    procedure StartTransaction;
    procedure StartDeferredTransaction;
    procedure StartImmediateTransaction;
    procedure StartExclusiveTransaction;
    procedure Commit;
    procedure RollBack;
    procedure SetFiltered(Value: Boolean); override;
    procedure SQLiteMasterChanged; virtual;
    function GetFieldData(Field: TField; Buffer: Pointer): boolean; override;
    function GetFieldData(FieldNo: integer; Buffer: Pointer): boolean; override; // 20040225
    function GetLastInsertRow: integer;
{$IFDEF ASQLITE_D6PLUS}
//    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: boolean): boolean; override;
{$ENDIF}
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
    function Locate(const KeyFields: string; const KeyValues: variant; Options: TLocateOptions): boolean; override;
    function BookmarkValid(Bookmark: Pointer): boolean; override;
//    function    LocateNearest(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean;
    property Params: TParams read FParams write SetParamsList stored false;
    function Lookup(const KeyFields: string; const KeyValues: Variant;          // John Lito
                    const ResultFields: string): Variant; override;             // John Lito
  published
    property AutoCommit: boolean read FAutoCommit write FAutoCommit default false;
    property TransactionType: string read FTransactionType write FTransactionType;
    property SQLiteDateFormat: boolean read FSQLiteDateFormat write SetSQLiteDateFormat;
    property TableDateFormat: string read FTableDateFormat write FTableDateFormat;
    property Connection: TASQLite3DB read FConnection write FConnection;
    property MaxResults: integer read FMaxResults write FMaxResults;
    property StartResult: integer read FStartResult write FStartResult;
    property TypeLess: boolean read FTypeLess write FTypeLess;
    property MasterFields: string read GetMasterFields write SetMasterFields;
    property MasterSource: TDataSource read GetDataSource write SetDataSource;
    property SQLCursor: boolean read FSQLCursor write FSQLCursor;
    property ReadOnly: boolean read FreadOnly write FReadOnly;
    property UniDirectional : boolean read FUniDir write FUniDir;
    property AutoCalcFields;
    property Filter;
    property Filtered;
    property Active;
    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;
{$IFDEF ASQLITE_D6PLUS}
    property BeforeRefresh;
    property AfterRefresh;
{$ENDIF}
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnNewRecord;
    property OnPostError;
  end;
//============================================================================== TASQLite3Query

  TASQLite3Query = class(TASQLite3BaseQuery)
  private
    FUpdateSQL: TASQLite3UpdateSQL;
    FRawSQL: boolean;
    procedure SetSQL(const Value: TStrings);
    function GetSQL: TStrings;
    procedure QueryChanged(Sender: TObject);
  protected
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalDelete; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure InternalClose; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
//    property Params: TParams Read FParams Write SetParamsList Stored false;
    procedure SQLiteMasterChanged; override;
  published
    property RawSQL: boolean read FRawSQL write FRawSQL;
    property SQL: TStrings read GetSQL write SetSQL;
    property UpdateSQL: TASQLite3UpdateSQL read FUpdateSQL write FUpdateSQL;
  end;

//============================================================================== TASQLite3Table

  TASQLite3Table = class(TASQLite3BaseQuery)
  private
    FTableName: string;
    FPrimaryAutoInc: boolean;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalDelete; override;
    procedure SetFTableName(TableName : string);
  public
    procedure SQLiteMasterChanged; override;
  published
    property TableName: string read FTableName write SetFTableName;
    property PrimaryAutoInc: boolean read FPrimaryAutoInc write FPrimaryAutoInc;
  end;

 //============================================================================== TASQLite3BlobStream

  TASQLite3BlobStream = class(TMemoryStream)
  private
    FField: TBlobField;
    FDataSet: TASQLite3BaseQuery;
    FMode: TBlobStreamMode;
    FModified: Boolean;
    FOpened: Boolean;
    procedure LoadBlobData;
    procedure SaveBlobData;
  public
    constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
  end;


implementation

// GPA - Static Link Start
{$IFDEF SQLite_Static}
Var
  __HandlerPtr:Pointer;
  //使用3.6.3 的obj
  {$L 'OBJ\sqlite3_6_3.obj'}
  {$L 'OBJ\_ftoul.obj'}
  {$L 'OBJ\streams.obj'}

  //{$L 'OBJ\sqlite3.obj'}
  {$L 'OBJ\files.obj'}
  {$L 'OBJ\strlen.obj'}
  {$L 'OBJ\assert.obj'}
  {$L 'OBJ\memcmp.obj'}
  {$L 'OBJ\memcpy.obj'}
  {$L 'OBJ\memset.obj'}
  {$L 'OBJ\strcmp.obj'}
  {$L 'OBJ\strcpy.obj'}
  {$L 'OBJ\strcat.obj'}
  {$L 'OBJ\strncmp.obj'}
  {$L 'OBJ\strncpy.obj'}
  {$L 'OBJ\strncat.obj'}
  {$L 'OBJ\sprintf.obj'}
  {$L 'OBJ\fprintf.obj'}
  {$L 'OBJ\_ll.obj'}
  {$L 'OBJ\ltoupper.obj'}
  {$L 'OBJ\ltolower.obj'}
  {$L 'OBJ\atol.obj'}
  {$L 'OBJ\ftol.obj'}
  {$L 'OBJ\longtoa.obj'}
  {$L 'OBJ\hrdir_r.obj'}
  {$L 'OBJ\gmtime.obj'}
  {$L 'OBJ\tzdata.obj'}
  {$L 'OBJ\initcvt.obj'}
  {$L 'OBJ\streams.obj'}
  {$L 'OBJ\scantod.obj'}
  {$L 'OBJ\scanwtod.obj'}
  {$L 'OBJ\allocbuf.obj'}
  {$L 'OBJ\bigctype.obj'}
  {$L 'OBJ\clocale.obj'}
  {$L 'OBJ\clower.obj'}
  {$L 'OBJ\cupper.obj'}
  {$L 'OBJ\fflush.obj'}
  {$L 'OBJ\fputn.obj'}
  {$L 'OBJ\hrdir_s.obj'}
  {$L 'OBJ\mbisspc.obj'}
  {$L 'OBJ\mbsrchr.obj'}
  {$L 'OBJ\realcvt.obj'}
  {$L 'OBJ\realcvtw.obj'}
  {$L 'OBJ\timefunc.obj'}
  {$L 'OBJ\vprinter.obj'}
  {$L 'OBJ\hugeval.obj'}
  {$L 'OBJ\cvtfak.obj'}
  {$L 'OBJ\getinfo.obj'}
  {$L 'OBJ\qmul10.obj'}
  {$L 'OBJ\fuildq.obj'}
  {$L 'OBJ\_pow10.obj'}
  {$L 'OBJ\ldtrunc.obj'}
  {$L 'OBJ\cvtfakw.obj'}
  {$L 'OBJ\wis.obj'}
  {$L 'OBJ\xfflush.obj'}
  {$L 'OBJ\flushout.obj'}
  {$L 'OBJ\lputc.obj'}