asgsqlite3.pas

定时器for timer for ic chip

  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 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 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
  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;
    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;
    FOrderBy: String;
    FPrimaryAutoInc: boolean;
  Protected
    Procedure Notification(AComponent: TComponent; Operation: TOperation); Override;
    Procedure InternalOpen; Override;
    Procedure InternalPost; Override;
    Procedure InternalDelete; Override;
    Procedure SetFTableName(TableName: String);
    Procedure SetFOrderBy(OrderBy: String);
  Public
    Procedure SQLiteMasterChanged; Override;
  Published
    Property TableName: String Read FTableName Write SetFTableName;
    Property PrimaryAutoInc: boolean Read FPrimaryAutoInc Write FPrimaryAutoInc;
    Property OrderBy: String Read FOrderBy Write SetFOrderBy;
  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

Uses
  Math
  {$IFDEF ASQLITE_D6PLUS}
  , StrUtils
  {$ENDIF}
  ;

// GPA - Static Link Start
{$IFDEF SQLite_Static}
{$I Sqlite3Obj.inc}
{$ENDIF}
// GPA - Static Link End

{$IFDEF DEBUG_ENABLED}
Var
  DebugSpaces: integer = 0;
  {$ENDIF}

  {$IFNDEF ASQLITE_D6PLUS}              //Art Register - Function sign not provided in Delphi 5
Function Sign(I: integer): integer;
Begin
  If (I > 0) Then
    Result := 1
  Else
  Begin
    If (I < 0) Then
      Result := -1
    Else
      Result := 0;
  End;
End;
{$ENDIF}

Procedure Debug(Const S: String);
Begin
  {$IFDEF DEBUG_ENABLED}
  OutputDebugString(PAnsiChar(StringOfChar(' ', DebugSpaces) + S));
  {$ENDIF}
End;

Procedure DebugEnter(Const S: String);
Begin
  {$IFDEF DEBUG_ENABLED}
  OutputDebugString(PAnsiChar(StringOfChar(' ', DebugSpaces) + 'Enter ' + S));
  inc(DebugSpaces);
  {$ENDIF}
End;

Procedure DebugLeave(Const S: String);
Begin
  {$IFDEF DEBUG_ENABLED}
  dec(DebugSpaces);
  OutputDebugString(PAnsiChar(StringOfChar(' ', DebugSpaces) + 'Leave ' + S));
  {$ENDIF}
End;

//==============================================================================
// SyntaxCheck. This routine is used to check if words match the sql syntax
//              It is called where sql statements are parsed and generated
//==============================================================================

Function SyntaxCheck(LWord, RWord: String): boolean;
Begin
  DebugEnter('SyntaxCheck');
  Try
    If CompareText(LWord, RWord) <> 0 Then
    Begin
      SyntaxCheck := false;
      Raise AsgError.Create('SQL macro syntax error on sql, expected ' + RWord)
    End Else
      SyntaxCheck := true;
  Finally
    DebugLeave('SyntaxCheck');
  End;
End;

//==============================================================================
// Parse the SQL fielddescription and return the Delphi Field types, length etc.
//==============================================================================

Procedure GetFieldInfo(FieldInfo: String; Var FieldType: TFieldType;
  Var FieldLen, FieldDec: integer);
Var
  p1, p2, pn: integer;
  vt: String;
Begin
  DebugEnter('GetFieldInfo');
  FieldType := ftString;                // just a default;
  FieldLen := 255;
  FieldDec := 0;

  p1 := pos('(', FieldInfo);
  If p1 <> 0 Then