asgsqlite3.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 1,276 行 · 第 1/5 页

    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
    function BuildFilter : string;
    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;
    function GetFieldValue(const AField: TField; const Blobs: TList = nil): string; // added by Donnie

    { 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 isNullSrc(SrcBuffer: pAnsiChar; fieldNo : integer) : boolean;
    procedure setNullSrc(SrcBuffer: pAnsiChar; fieldNo : integer; aNull : boolean);
    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 CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; //MS
    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
    function GetFieldBufferIndex(Field: TField): integer; // Sean

  published
    property AutoCommit: boolean read FAutoCommit write FAutoCommit default true;
    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;