mysqldataset.pas

MYSQL 连接控件 MYSQL 连接控件

  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;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    procedure Truncate;
  end;
  TMySQLLocateOptions = set of (loFirst,loNext,loPrior,loLast,loTextSearch,loMatchAll);
  TMySQLResultOptions = (rtLocal,rtIncremental,rtUnidirectional);
  TMySQLDatasetOptions = set of (doShareConnection,doTransactions,doRecursiveUpdates,doCachedUpdates,doThreadedUpdate,doAutoCreate,doCreateTemp,doDropIfExists,doFieldsAsString,doRetrieveFieldValues,doRetrieveIndexDefs,doMacrosEnabled,doMacroCheck,do2KStrToMemo,doSmallMemoToStr,doEnumToBool,doTinyIntToBool,doSetToWord,doEditCalcFields,doUseCursor,doSingleSQL);
  TMySQLDatasetBase = class(TDataSet)
  private
     FConnection   : pointer;
     FResult		  : pointer;
     FMasterFields: TStrings;
    	FMasterLink: TMasterDataLink;
     FInTransaction,
     FResultChanged,
     FResultComplete,
     FReadOnly     : boolean;
     FDBInfo,
     FTableInfo,
     FFieldInfo    : TStringList;
     FRecInfo		  : TList;
     FRawBufSize   : Integer;
     FRecBufSize   : Integer;
     FRecInfoOfs   : Integer;
     FMemoToStrLimit: Integer;
     FServer       : TMySQLServer;
     FDatabaseName,
     FTableName,
     FResultSQL,
     FRealSQL: string;
     FSQL,
     FSQLUpdate,
     FSQLInsert,
     FSQLDelete,
     FSQLBatch,
     FSQLCached    : TStrings;
     FTempRec		  : PChar;
     FCurRec       : int64;
     FMacroStringStart,
     FMacroStringEnd: string;
     FMacros: TParams;
     FOnMacro: TMySQLMacroEvent;
     FOnExecSQL: TMySQLEvent;
     FOnCustomValue,
     FOnDefaultValue: TMySQLFieldValue;
     FOnThreadOpened,
     FOnThreadPosted: TNotifyEvent;
     FOnAfterAdd: TDataSetNotifyEvent;
     FPrimFields,
     FUniqFields,
     FMultFields,
     FAffectedRows,
     FQueryInfo,
     FLastInsertID: string;
     FResultType: TMySQLResultOptions;
	   {$IFNDEF CONSOLEAPP}
     FCursor: TCursor;
     {$ENDIF}
     FOptions: TMySQLDatasetOptions;
     FConstraints: TCheckConstraints;
     FCustomFieldDefs: TFieldDefs;
     FIndexDefs: TIndexDefs;
     procedure   ReadAllFieldValues(Reader: TReader);
     procedure   ReadMacrosEnabled(Reader: TReader);
     procedure 	SQLChanging(Sender: TObject);
     procedure 	SQLChange(Sender: TObject);
     function    SQLPopulate(const SQL: string; ParseMacro: boolean=True; PopulateOnly: boolean=False; const ADB: string=''; const ATable: string=''): string;
     procedure 	ApplyUpdates;
		procedure	ResyncResult;
		procedure  	TableInfoClear;
		procedure  	FieldInfoClear;
		procedure  	RecInfoClear;
		procedure 	GetNextRow;
     procedure	InternalOpenResultBlock;
     function    GetIndexRecord(Index: Integer): PRecInfo;
		function  	CheckChanged: boolean;
     procedure	MakeChanged;
		procedure  	GetRest;
		procedure  	ClearRest;
     function    GetOptions: TMySQLDatasetOptions;
     procedure	SetOptions(const Value: TMySQLDatasetOptions);
     procedure   ParseMacros(SQL: String; const AMacroStart,AMacroEnd: string; DoCreate: Boolean);
  protected
     FFieldName: string;
    	procedure 	Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure 	ActivateConnection;
     procedure 	DeactivateConnection;
		function	 	GetSelectFields: string;
  	function   	GetMasterAndFilter: string;
    	procedure 	MasterChanged(Sender: TObject);
    	procedure 	MasterDisabled(Sender: TObject);
     procedure 	SetMacros(Value: TParams);
     function  	GetMacroCount: Word;
     function	 	GetMacroString: string;
     procedure 	SetMacroString(Value: string);
     procedure	SetFiltered(Value: boolean); override;
     procedure	SetFilterText(const Value: string); override;

     procedure 	InternalOpenResult;
     procedure 	InternalOpen; override;
     procedure	InternalRefresh; override;
		procedure 	InternalEdit; override;
     procedure	InternalCancel; override;
     procedure 	InternalInitFieldDefs; override;
     procedure 	InternalClose; override;
     function  	IsCursorOpen: Boolean; override;
     function    GetCanModify: Boolean; override;


     procedure 	GetBookmarkData(Buffer: PChar; Data: Pointer); override;
     procedure 	SetBookmarkData(Buffer: PChar; Data: Pointer); override;
     function  	GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
     procedure 	SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
     procedure 	InternalSetToRecord(Buffer: PChar); override;
     procedure 	InternalGotoBookmark(Bookmark: Pointer); override;
     function  	GetRecordCount: Integer; override;
     function  	AllocRecordBuffer: PChar; override;
     procedure 	ClearRecordBuffer(var Buffer: PChar); virtual;
     procedure 	FreeRecordBuffer(var Buffer: PChar); override;
     function  	GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
     function  	GetRecordSize: Word; override;
     procedure 	InternalInitRecord(Buffer: PChar); override;
     procedure   InternalInsert; override;
     procedure   StartTransaction;
     procedure   CommitTransaction;
     procedure   RollbackTransaction;
  	procedure 	InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
     procedure 	InternalPost; override;
     procedure 	InternalDelete; override;
     procedure 	SetFieldData(Field: TField; Buffer: Pointer); override;
     procedure 	InternalFirst; override;
     procedure 	InternalLast; override;
     function    GetRecNo: Integer; override;
     procedure   SetRecNo(Value: Integer); override;
     procedure 	InternalHandleException; override;
     procedure 	SetReadOnly(Value : boolean);
     function  	GetParamCheck: boolean;
     procedure 	SetParamCheck(Value : boolean);
     function  	GetUseCursor: boolean;
     procedure 	SetUseCursor(Value : boolean);
     function  	GetCachedUpdates: boolean;
     procedure 	SetCachedUpdates(Value : boolean);
     function  	GetShareConnection: boolean;
     procedure 	SetShareConnection(Value : boolean);
     procedure 	SetServer(Value : TMySQLServer);
		procedure 	SetDatabaseName(Value : string);
     function		GetRawData: boolean;
		procedure 	SetRawData(Value : boolean);
     procedure 	SetFieldName(Value : string);
     procedure 	SetSQL(Value : TStrings);
     procedure 	SetSQLUpdate(Value : TStrings);
     procedure 	SetSQLInsert(Value : TStrings);
     procedure 	SetSQLDelete(Value : TStrings);
     procedure 	SetSQLBatch(Value : TStrings);
     procedure 	SetSQLCached(Value : TStrings);
     procedure	SetResultType(Value: TMySQLResultOptions);
     procedure 	ParseAllSQL;
     function    GetActiveRecBuf(var RecBuf: PChar): Boolean; virtual;
     function    GetBlobData(Field: TField; Buffer: PChar): TBlobData;
     procedure   SetBlobData(Field: TField; Buffer: PChar; Value: TBlobData);
     procedure   CloseBlob(Field: TField); override;
     procedure   ClearCalcFields(Buffer: PChar); override;
     function    GetIsIndexField(Field: TField): Boolean; override;
     function    GetFieldClass(FieldType: TFieldType): TFieldClass; override;
     function    GetStringType(Sender: TField): TMySQLStringTypes;
     function    GetStringValues(Sender: TField): string;
     function    StoreContraints: boolean;
     function    StoreCustomFieldDefs: boolean;
     function    StoreFieldDefs: boolean;
     function    StoreIndexDefs: boolean;
     function    StoreMacroDel: boolean;
     function    StoreMacros: boolean;
     function    StoreSQL: boolean;
     function    StoreSQLBatch: boolean;
     function    StoreSQLDelete: boolean;
     function    StoreSQLInsert: boolean;
     function    StoreSQLUpdate: boolean;
     procedure   DefineProperties(Filer: TFiler); override;
    { IProviderSupport }
     procedure   PSEndTransaction(Commit: Boolean); override;
     procedure   PSExecute; override;
     function    PSExecuteStatement(const ASQL: string; AParams: TParams; ResultSet: Pointer = nil): Integer; override;
     procedure   PSGetAttributes(List: TList); override;
     function    PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; override;
     function    PSGetDefaultOrder: TIndexDef; override;
     function    PSGetKeyFields: string; override;
     function    PSGetParams: TParams; override;
     function    PSGetQuoteChar: string; 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   PSSetParams(AParams: TParams); override;
     procedure   PSSetCommandText(const CommandText: string); override;
     procedure   PSStartTransaction; override;
     function    PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; override;
  public
     constructor Create(AOwner: TComponent); override;
     destructor 	Destroy; override;
     procedure	Execute(const WaitFor: boolean=False);
     function    CreateTable(const AExecSQL: boolean=False): string;
    	function 	GetDataSource: TDataSource; override;
    	procedure 	SetDataSource(Value: TDataSource);
  	function		GetMasterFields: string;
    	procedure 	SetMasterFields(const Value: string);
     procedure 	SetTableName(Value : string);
     function   	GetRawFieldData(Field: TField; Buffer: Pointer): Boolean;
     function  	GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
     procedure   ConnectEvent(Sender: TObject; Connecting: Boolean);
     function 	ExecSQL(SQL: string=''; EnableMacros: boolean=False;Cached: boolean=False; const ADB: string=''; const ATable: string=''): boolean;
     function 	ExecSQLBatch(SQL: TStrings; const EnableMacros: boolean=False; const Cached: boolean=False;const AutoRefresh: boolean=False; const ADB: string=''; const ATable: string=''): boolean;
     function    ExecSQLBatchPerColumn(SQL: TStrings; const EnableMacros: boolean=False; const Cached: boolean=False;const AutoRefresh: boolean=False;const AChanged: boolean=False): boolean;
     function 	ExecBatch: boolean;
     function    EscStr(const S: string): string;
     function    QuoteStr(const S: string): string;
     function    QEscStr(const S: string): string;
     function    QEscFieldValue(Field: TField=nil; RecBuf: PChar=nil): string;
     function    FormatIdentifier(const S: string): string;
     function    HexStr(S: PChar; L: longint=0): string;
     function 	MacroByName(const Value: string): TParam;
     function 	ParamByName(const Value: string): TParam;
     procedure   ClearMacros;
     procedure  	ParseSQL(SQL: string);
		function 	GetMacroValue(Name: string; const ADB: string=''; const ATable: string=''): string;
		function 	BookmarkValid(Bookmark: TBookmark): Boolean; override;
     function    CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
     function    CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     function    LocateRecord(const KeyFields: string;  const KeyValues: Variant; Options: TLocateOptions=[loCaseInsensitive];  SyncCursor: Boolean=True): Boolean;
     function    LocateRecordOption(const KeyFields: string;  const KeyValues: Variant; Options: TLocateOptions;  SyncCursor: Boolean; MySQLOptions: TMySQLLocateOptions; var MatchedField: TField): Boolean;
     function    Locate(const KeyFields: string;  const KeyValues: Variant; Options: TLocateOptions): Boolean; override;
     function    Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
     property    Connection: pointer read FConnection;
     property 	MacroCount: Word read GetMacroCount;
     property    InTransaction: boolean read FInTransaction write FInTransaction default False;
     property    Records[Index: Integer]: PRecInfo read GetIndexRecord;
     property    MySQLDatabases: TStringList read FDBInfo;
     property    MySQLTables: TStringList read FTableInfo;
     property    MySQLFields: TStringList read FFieldInfo;
     property    MySQLRecords: TList read FRecInfo;
     property    PrimaryKeyFields: string read FPrimFields;
     property    UniqueKeyFields: string read FUniqFields;
     property    MultiKeyFields: string read FMultFields;
     property    LastInsertID: string read FLastInsertID;
     property    AffectedRows: string read FAffectedRows;
     property    QueryInfo: string read FQueryInfo;
     property    RealSQL: string read FRealSQL;
     property    ResultSQL: string read FResultSQL;
     property    Buffers;
     property    BufferCount;
     property    ActiveRecord;
     property    CurrentRecord;
     property    CurrentBuffer: PChar read FTempRec;
     // Properties for publication
     property    CachedUpdates: boolean read GetCachedUpdates write SetCachedUpdates default False;
     property    Constraints: TCheckConstraints read FConstraints write FConstraints stored StoreContraints;
	   {$IFNDEF CONSOLEAPP}
     property    Cursor: TCursor read FCursor write FCursor default crSQLWait;
     {$ENDIF}
     property    CustomFieldDefs: TFieldDefs read FCustomFieldDefs write FCustomFieldDefs stored StoreCustomFieldDefs;
     property    IndexDefs: TIndexDefs read FIndexDefs write FIndexDefs stored StoreIndexDefs;
     property    IndexFieldNames: string read FFieldName write SetFieldName;
     property    MacroDel: string read GetMacroString write SetMacroString stored StoreMacroDel;
     property    Macros: TParams read FMacros write SetMacros stored StoreMacros;
    	property    MasterFields: string read GetMasterFields write SetMasterFields;
    	property    MasterSource: TDataSource read GetDataSource write SetDataSource;
     property    Options: TMySQLDatasetOptions read GetOptions write SetOptions default [doShareConnection,doMacrosEnabled,doMacroCheck,do2KStrToMemo,doUseCursor];
     property    ParamCheck: boolean read GetParamCheck write SetParamCheck default True;
     property    Params: TParams read FMacros write SetMacros stored StoreMacros;
     property    RawData: boolean read GetRawData write SetRawData default False;
     property    ReadOnly: boolean read FReadOnly write SetReadOnly default False;
     property    ResultType: TMySQLResultOptions read FResultType write SetResultType default rtLocal;
     property    ShareConnection: boolean read GetShareConnection write SetShareConnection default True;
     property    SQL: TStrings read FSQL write SetSQL stored StoreSQL;
     property    SQLBatch: TStrings read FSQLBatch write SetSQLBatch stored StoreSQLBatch;
     property    SQLCached: TStrings read FSQLCached write SetSQLCached;
     property    SQLDelete: TStrings read FSQLDelete write SetSQLDelete stored StoreSQLDelete;
     property    SQLInsert: TStrings read FSQLInsert write SetSQLInsert stored StoreSQLInsert;
     property    SQLUpdate: TStrings read FSQLUpdate write SetSQLUpdate stored StoreSQLUpdate;
     property    TableName: string read FTableName write SetTableName;
     property    UseCursor: boolean read GetUseCursor write SetUseCursor default True;
     property    MemoToStrLimit: integer read FMemoToStrLimit write FMemoToStrLimit; 
     property    OnExecSQL: TMySQLEvent read FOnExecSQL write FOnExecSQL;
     property    OnMacro: TMySQLMacroEvent read FOnMacro write FOnMacro;
     property    OnCustomValue: TMySQLFieldValue read FOnCustomValue write FOnCustomValue;
     property    OnDefaultValue: TMySQLFieldValue read FOnDefaultValue write FOnDefaultValue;
     property    OnThreadOpened: TNotifyEvent read FOnThreadOpened write FOnThreadOpened;
     property    OnThreadPosted: TNotifyEvent read FOnThreadPosted write FOnThreadPosted;
     property    OnAfterAdd: TDataSetNotifyEvent read FOnAfterAdd write FOnAfterAdd;
  published
     property	   DatabaseName: string	read FDatabaseName write SetDatabaseName;
     property    Server: TMySQLServer read FServer write SetServer;
  end;
  TMySQLDataset = class(TMySQLDatasetBase)
  published
     property Active;
     property CachedUpdates;
     property Constraints;
	   {$IFNDEF CONSOLEAPP}
     property Cursor;
     {$ENDIF}
     property CustomFieldDefs stored StoreCustomFieldDefs;
     property FieldDefs stored StoreFieldDefs;
     property Filter;