datastore.pas

内存数据库,用于与数据库操作上进行缓冲

unit UTbcDbDataPub;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,Math,
  db,dbtables,contnrs,HashTrie,SDEngine,StConst, StBase, StSort,
  ExPars, Vars, ExLink,parstype,ExFuncs,ExtCtrls,ExClass;

const
   MaxTbcDwColumn=256;

type

  PBookmarkRec = ^TBookmarkRec;
  TBookmarkRec = packed record		{ Bookmark structure }
    iPos   : Integer;               { Position in given order - position in the cache(FRecCache) }
{    iState : Integer;               { State of cursor }
//    iRecNo : Integer;               { Physical Record number }
{    iSeqNo : Integer;               { Version number of order }
{    iOrderID : Integer;             { Defines Order }
  end;

  ETbcError=class(Exception);
  ETbcDwError=class(Exception);

  ETbcDwRowNotExisted=class(ETbcDwError);
  ETbcDwColNotExisted=class(ETbcDwError);
  ETbcDwBufNotExisted=class(ETbcDwError);
  ETbcDwTypeError=class(ETbcDwError);

  ETbcDwNilField=class(ETbcDwError);
  ETbcDwInvalidSQL=class(ETbcDwError);
  ETbcDwInvalidDatabase=class(ETbcDwError);


  ETbcOutOfBound=class(Exception);

  ETbcArgExisted=class(Exception);


  TTbcDwRowStatus=(rsUnknown,rsNotModified,rsDataModified,rsNewRow,rsNewModified);

  TTbcDwBuffer=(dwPrimary,dwDelete,dwFilter);

  TTbcDwRowType=(rtNormal,rtGroup,rtSum);
  TTbcDataStoreType=(dstDB,dstExternal);

  TTbcDwItemStatus=(isUnknown,isDataModified,isNew,isNewModified,isNotModified);

  TTbcDwArgType=(daInteger,daFloat,daString,daDate,daTime,daDateTime,
                 daIntegerArray,daFloatArray,daStringArray,daDateArray,daTimeArray,daDateTimeArray);

  TTbcDwSaveAsType=(asTxt,asHtml,asXls,asXml);

  TTbcDwUpdateMode=(dwuWhereKeyOnly,dwuWhereKeyAndUpdatable);

  TTbcDwExprElemType=(dweElemString,dweElemColumn);

  TTbcSetOfFieldType=set of TFieldType;

  TTbcDataStore=class;
  TTbcCheckSrv = class(TObject)
   private

   protected

   public
    constructor Create;
    destructor Destroy;override;
    procedure ChkNullStr(const s:string;const ErrMsg: string);
    procedure ChkNilObject(Obj: TObject; const ErrMsg: string);
  published

  end;


  TTbcStringSrv = class(TObject)
    private

    protected

    public
     constructor Create;
     destructor Destroy; override;
     function GetChineseCharFlag(const s:string):string;
     function ChineseLowerCase(const s:string):string;
     function ChnCharPos(const s:string;c:char):integer;

     function GetQuotedString(const s:string;const QuoteChar:char):string;

     function SplitField(const s:string;TargetList:TStringList;Separator:char=','):integer;
     function TrimSplitField(const s:string;TargetList:TStringList;Separator:char=','):integer; //endstart 2007-6-13 以 Separator 为分割符，将拆分的 str 顺序插入以空的 TargetList(TStringList) 中

     function SqueezeAllSpace(const s:string):string;

     function GetPrefixBeforeChar(const s:string;C:Char):string;
     function IsValidIdentifier(const Identifier:string):boolean;
     function IsValidNumber(const Identifier: string): boolean;

     function BooleanToStr(const Val:boolean):string;
     function StrToBoolean(const Val:string):boolean;

     function BooleanToOneZero(const Val:boolean):string;
     function OneZeroToBoolean(const Val:string):boolean;

     function TAlignmentToStr(const Alignment:TAlignment):string;
     function StrToTAlignment(const Val:string):TAlignment;

     function SortIntStrList(StrList:TStringList;const IsAscending:boolean=true):integer;
     function SortInt64StrList(StrList:TStringList;const IsAscending:boolean=true):integer;

     function SortExtendedStrList(StrList:TStringList;const IsAscending:boolean=true):integer;

    published

    end;
  TTbcExprEval = class(TObject)
    private

    FExprList:TStringList;

    FParser:TExParser;
    FEPVars: TEPVars;
    FEPVar: TVariable;
    FEPVCLClasses: TEPVCLClasses;
    FEPRegFuncs: TEPRegFuncs;
    FDebug:boolean;
    protected

    public
      property Debug:boolean read FDebug write FDebug;
      constructor Create;
      destructor Destroy; override;

      procedure ResetExpr;
      procedure AddExpr(const Expr:string);
      procedure AddExprList(ExprList:TStrings);
      function  Eval:Extended;
    published

  end;

  TTbcSQLSrv=class(TObject)
  private
    FSQL:string;
    FSelectList:TStringList;
    FTableList:TStringList;
    FSelect:string;
    FFrom:string;
    FWhere:string;
    FGroupBy:string;
    FHaving:string;
    FOrderBy:string;

    FStringSrv:TTbcStringSrv;
  protected
    function InternalParseSQL(const SQL:string):integer;
  public
    constructor Create;
    destructor Destroy; override;
    property SQL:string read FSQL write FSQL;
    property SelectList:TStringList read FSelectList;
    property TableList:TStringList read FTableList;

    property select:string read FSelect;
    property from:string read  FFrom;
    property Where:string read FWhere;
    property GroupBy:string read  FGroupBy;
    property Having:string read  FHaving;
    property OrderBy:string read  FOrderBy;


    function ParseSQL:integer;overload;
    function ParseSQL(const SQL:string):integer;overload;
    procedure Reset;
  published

  end;

  TTbcCodeTable=class(TObject)
  private
    FCodes:TStringList;
    FValues:TStringList;
    FTmpStrList,FTmpStrList2:TStringList;
    FStringSrv:TTbcStringSrv;
  protected
    function InternalDealCodes(const Codes,Values:string):integer;
    function InternalDealExistCodes:integer;
    procedure InternalDealSingleCode(const code,value:string);
  public

    constructor Create;

    destructor Destroy;override;

    function Assign(const ACodeTable:TTbcCodeTable):integer;

    function InsertFirst(const Code,Value:string):integer;
    function InsertFirsts(const Codes,Values:string):integer;

    function InsertLast(const Code,Value:string):integer;
    function InsertLasts(const Codes,Values:string):integer;

    function InsertBefore(const row:integer;const Code,Value:string):integer;
    function InsertBefores(const row:integer;const Codes,Values:string):integer;

    function InsertAfter(const row:integer;const Code,Value:string):integer;
    function InsertAfters(const row:integer;const Codes,Values:string):integer;

    function RemoveCode(const Code:string):integer;overload;
    function RemoveCode(const CodeNum:integer):integer;overload;

    function RemoveCodes(const Codes:string):integer;
    function RemoveCodeNums(const CodeNums:string):integer;

    function Clear:integer;

    function SetValue(const Code,Value:string):integer;overload;
    function SetValue(const CodeNum:integer;Value:string):integer;overload;

    function CodeCount:integer;

    function FindCodePos(const Code:string;var Pos:integer):integer;
    function FindValue(const Code:string;var Value:string):integer;overload;
    function FindValue(const CodeNum:integer;var Value:string):integer;overload;

    function FindCode(const Value:string;var Code:string;const StartPos:integer=1):integer;overload;
    function FindCode(const CodeNum:integer;var Code:string):integer;overload;

  published

 end;

  TTbcRetrieveArg=class(TObject)
  private
    FArgType:TTbcDwArgType;
    FArgName:string;
    FValues:TStringList;
    FIsSingleValue:boolean;
    FDateFormat:String;
    FStrQuoteChar:char;
    FStringSrv:TTbcStringSrv;
  protected
    function GetValue(i:integer):string;
    procedure SetValue(i:integer;val:string);
    function InternalGetArgStr(const ArgVal:string):string;
  public

    constructor Create(AargType:TTbcDwArgType;AargName:string);overload;
    constructor Create(AargType:TTbcDwArgType;AargName:string;Val:string);overload;
    constructor Create(AargType:TTbcDwArgType;AargName:string;Vals:TStrings);overload;

    destructor Destroy;override;

    function ClearValues:integer;

    function AddValue(Val:string):integer;overload;
    function AddValue(Vals:TStrings):integer;overload;

    function RemoveValue(Val:string):integer;overload;
    function RemoveValue(ValNum:integer):integer;overload;

    function ValueCount:integer;

    function GetArgStr:string;

    property Values[i: integer]: string read GetValue write SetValue;
    property ArgName: string read FArgName write FArgName;
    property DateFormat:string read FDateFormat write FDateFormat;
    property StrQuoteChar:char read FStrQuoteChar write  FStrQuoteChar;
  published

 end;

 TTbcRetrieveArgs=class(TObject)
  private
    FArgs:TObjectList;
    FOwnsArgs:boolean;
    FStringSrv:TTbcStringSrv;
    FDateFormat:String;
    FStrQuoteChar:char;

  protected
    procedure ChkArgName(const ArgName:string);
    function ArgByNumber(index:integer):TTbcRetrieveArg;
    function InternalAddArg(const ArgName:string;const ArgType:TTbcDwArgType):TTbcRetrieveArg;
    procedure SetDateFormat(const ADateFormat:string);
    procedure SetStrQuoteChar(const AStrQuoteChar:char);
  public

    property Args[index:integer]:TTbcRetrieveArg read ArgByNumber;
    property DateFormat:string read FDateFormat write SetDateFormat;
    property StrQuoteChar:char read FStrQuoteChar write  SetStrQuoteChar;

    constructor Create;
    destructor Destroy; override;

    function AddArg(const ArgName:string;const ArgType:TTbcDwArgType):TTbcRetrieveArg;overload;
    function AddArg(const ArgName:string;const ArgType:TTbcDwArgType;const Val:String):TTbcRetrieveArg;overload;
    function AddArg(const ArgName:string;const ArgType:TTbcDwArgType;const Vals:TStrings):TTbcRetrieveArg;overload;

    function ArgByName(const ArgName:string):TTbcRetrieveArg;


    function RemoveArg(const ArgName:string):integer;overload;
    function RemoveArg(const ArgNumber:integer):integer;overload;

    function Clear:integer;

    function ArgCount:integer;

    function  BuildRetrieveSQL(const ASQL:string):string;

  published

  end;

  
  TTbcDwItemData = class(TObject)
  private
    FStringSrv:TTbcStringSrv;
  protected
   function InternalDateTimeCompare(const cmpItem:TTbcDwItemData):integer;
  public

   DInteger:integer;
   DFloat:extended;
   DLargeInt:LargeInt;

   DBoolean:boolean;

   DDate:TDate;
   DTime:TTime;
   DDateTime:TDateTime;

   DString:string;

   DFieldType:TFieldType;
   DDataType:TFieldType;

   DEnableTime:boolean;
   DIsNull:boolean;

   constructor Create;
   destructor Destroy; override;

   function Compare(const cmpItem:TTbcDwItemData):integer;
   function GetEPExpr(var IsNull:boolean):string;
  published

  end;

  TTbcTFieldSrv=class(TObject)
  private
    //TFieldType Set

    FFtUnSupported:TTbcSetOfFieldType;
    FFtString:TTbcSetOfFieldType;

    FFtInteger:TTbcSetOfFieldType;
    FFtLargeInt:TTbcSetOfFieldType;

    FFtBoolean:TTbcSetOfFieldType;
    FFtExtended:TTbcSetOfFieldType;

    FFtDate:TTbcSetOfFieldType;
    FFtTime:TTbcSetOfFieldType;
    FFtDateTime:TTbcSetOfFieldType;

    FFtBinary:TTbcSetOfFieldType;
    FFtBlob:TTbcSetOfFieldType;


    FFtText:TTbcSetOfFieldType;

    FFtVariant:TTbcSetOfFieldType;

    FFtCanGetString:TTbcSetOfFieldType;

    FFtCanGetInteger:TTbcSetOfFieldType;
    FFtCanGetFloat:TTbcSetOfFieldType;

    FFtCanGetBoolean:TTbcSetOfFieldType;

    FFtCanGetDate:TTbcSetOfFieldType;
    FFtCanGetTime:TTbcSetOfFieldType;
    FFtCanGetDateTime:TTbcSetOfFieldType;

    FFtCanGetLargeInt:TTbcSetOfFieldType;

    FFtIsBlob:TTbcSetOfFieldType;