adodb.pas

多数代码可以直接在Delphi6和Delphi7环境下运行。部分涉及.NET技术内容的代码

    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;
  protected
    procedure ActivateTextFilter(const FilterText: string);
    function AllocRecordBuffer: PChar; override;
    procedure CheckActive; override;
    procedure CheckFieldCompatibility(Field: TField; FieldDef: TFieldDef); override;
    procedure ClearCalcFields(Buffer: PChar); override;
    procedure DataEvent(Event: TDataEvent; Info: Longint); override;
    procedure DeactivateFilters;
    procedure DefChanged(Sender: TObject); override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure DestroyLookupCursor; virtual;
    procedure DoOnNewRecord; override;
    procedure EnableEvents;
    function FindRecord(Restart, GoForward: Boolean): Boolean; override;
    procedure FreeRecordBuffer(var Buffer: PChar); override;
    function GetActiveRecBuf(var RecBuf: PChar): Boolean;
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
    function GetCanModify: Boolean; override;
    function GetCommandText: WideString;
    function GetDataSource: TDataSource; override;
    function GetRecNo: Integer; override;
    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordCount: Integer; override;
    function GetRecordSize: Word; override;
    function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;
    procedure InitOleDBAccess(Initializing: Boolean);
    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
    procedure InternalCancel; override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalEdit; override;
    procedure InternalFirst; override;
    function InternalGetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
    procedure InternalGotoBookmark(Bookmark: Pointer); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: PChar); override;
    procedure InternalInsert; override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalRefresh; override;
    procedure InternalRequery(Options: TExecuteOptions = []);
    procedure InternalSetSort(Value: WideString);
    procedure InternalSetToRecord(Buffer: PChar); override;
    function IsCursorOpen: Boolean; override;
    procedure Loaded; override;
    function LocateRecord(const KeyFields: string; const KeyValues: OleVariant;
      Options: TLocateOptions; SyncCursor: Boolean): Boolean;
    procedure MasterChanged(Sender: TObject); virtual;
    procedure MasterDisabled(Sender: TObject); virtual;
    procedure OpenCursor(InfoQuery: Boolean); override;
    procedure PrepareCursor; virtual;
    procedure RefreshParams;
    procedure ReleaseLock;
    procedure SetBlockReadSize(Value: Integer); override;
    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
    procedure SetCommandText(const Value: WideString);
    procedure SetConnection(const Value: TADOConnection); virtual;
    function SetConnectionFlag(Flag: Integer; Value: Boolean): Boolean; virtual;
    procedure SetDataSource(const Value: TDataSource); virtual;
    function SetDetailFilter: Boolean;
    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
    procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
    procedure SetFiltered(Value: Boolean); override;
    procedure SetFilterOptions(Value: TFilterOptions); override;
    procedure SetFilterText(const Value: string); override;
    procedure SetParamsFromCursor;
    procedure SetRecNo(Value: Integer); override;
    procedure UpdateIndexDefs; override;
    procedure UpdateRecordSetPosition(Buffer: PChar);
    property MasterDataLink: TMasterDataLink read FMasterDataLink;
    property Command: TADOCommand read FCommand;
    property CommandText: WideString read GetCommandText write SetCommandText;
    property CommandTimeout: Integer read GetCommandTimeout write SetCommandTimeout default 30;
    property CommandType: TCommandType read GetCommandType write SetCommandType default cmdText;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property FieldDefs stored FStoreDefs;
    property IndexDefs: TIndexDefs read FIndexDefs write FIndexDefs;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
    property MasterFields: string read GetMasterFields write SetMasterFields;
    property ParamCheck: Boolean read GetParamCheck write SetParamCheck default True;
    property Parameters: TParameters read GetParameters write SetParameters;
    property Prepared: Boolean read GetPrepared write SetPrepared default False;
    property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
  protected
    { RecordsetEvents }
    function ConnectionPoint: IConnectionPoint;
    procedure WillChangeField(cFields: Integer; Fields: OleVariant;
      var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
    procedure FieldChangeComplete(cFields: Integer; Fields: OleVariant;
      const pError: Error; var adStatus: EventStatusEnum;
      const pRecordset: _Recordset); safecall;
    procedure WillChangeRecord(adReason: EventReasonEnum;
      cRecords: Integer; var adStatus: EventStatusEnum;
      const pRecordset: _Recordset); safecall;
    procedure RecordChangeComplete(adReason: EventReasonEnum;
      cRecords: Integer; const pError: Error;
      var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
    procedure WillChangeRecordset(adReason: EventReasonEnum;
      var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
    procedure RecordsetChangeComplete(adReason: EventReasonEnum;
      const pError: Error; var adStatus: EventStatusEnum;
      const pRecordset: _Recordset); safecall;
    procedure WillMove(adReason: EventReasonEnum;
      var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
    procedure MoveComplete(adReason: EventReasonEnum; const pError: Error;
      var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
    procedure EndOfRecordset(var fMoreData: WordBool;
      var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
    procedure FetchProgress(Progress, MaxProgress: Integer;
      var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
    procedure FetchComplete(const pError: Error;
      var adStatus: EventStatusEnum; const pRecordset: _Recordset); safecall;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function BookmarkValid(Bookmark: TBookmark): Boolean; override;
    procedure CancelBatch(AffectRecords: TAffectRecords = arAll);
    procedure CancelUpdates;
    procedure Clone(Source: TCustomADODataSet; LockType: TADOLockType = ltUnspecified);
    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
    procedure DeleteRecords(AffectRecords: TAffectRecords = arAll);
    property EnableBCD: Boolean read FEnableBCD write FEnableBCD default True;
    procedure FilterOnBookmarks(Bookmarks: array of const);
    function GetBlobFieldData(FieldNo: Integer; var Buffer: TBlobByteData): Integer; override;
    procedure GetDetailLinkFields(MasterFields, DetailFields: TList); override;
    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; override;
    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; override;
    function IsSequenced: Boolean; override;
    procedure LoadFromFile(const FileName: WideString);
    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;
    function NextRecordset(var RecordsAffected: Integer): _Recordset;
    procedure Requery(Options: TExecuteOptions = []);
    procedure SaveToFile(const FileName: WideString = ''; Format: TPersistFormat = pfADTG);
    function Seek(const KeyValues: Variant; SeekOption: TSeekOption = soFirstEQ): Boolean;
    function Supports(CursorOptions: TCursorOptions): Boolean;
    procedure UpdateBatch(AffectRecords: TAffectRecords = arAll);
    function UpdateStatus: TUpdateStatus; override;
    property DesignerData: string read FDesignerData write FDesignerData;
    property IndexName: string read GetIndexName write SetIndexName;
    property IndexFieldCount: Integer read GetIndexFieldCount;
    property IndexFields[Index: Integer]: TField read GetIndexField write SetIndexField;
    property FilterGroup: TFilterGroup read GetFilterGroup write SetFilterGroup;
    property Properties: Properties read GetProperties;
    property Recordset: _Recordset read FRecordsetObject write SetRecordset;
    property RecordsetState: TObjectStates read GetRecordsetState;
    property RecordStatus: TRecordStatusSet read GetRecordStatus;
    property Sort: WideString read GetSort write SetSort;
  published
    property Active default False;
    property AutoCalcFields;
    property CacheSize: Integer read GetCacheSize write SetCacheSize default 1;
    property Connection: TADOConnection read GetConnection write SetConnection;
    property ConnectionString: WideString read GetConnectionString write SetConnectionString;
    property CursorLocation: TCursorLocation read GetCursorLocation write SetCursorLocation default clUseClient;
    property CursorType: TCursorType read GetCursorType write SetCursorType default ctKeyset;
    property ExecuteOptions: TExecuteOptions read GetExecuteOptions write SetExecuteOptions default [];
    property Filter;
    property Filtered;
    property LockType: TADOLockType read GetLockType write SetLockType default ltOptimistic;
    property MarshalOptions: TMarshalOption read GetMarshalOptions write SetMarshalOptions default moMarshalAll;
    property MaxRecords: Integer read GetMaxRecords write SetMaxRecords default 0;
    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;
    property BeforeRefresh;
    property AfterRefresh;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnFilterRecord;
    property OnNewRecord;
    property OnPostError;
    property OnWillChangeField: TWillChangeFieldEvent read FOnWillChangeField write FOnWillChangeField;
    property OnFieldChangeComplete: TFieldChangeCompleteEvent read FOnFieldChangeComplete write FOnFieldChangeComplete;
    property OnWillChangeRecord: TWillChangeRecordEvent read FOnWillChangeRecord write FOnWillChangeRecord;
    property OnRecordChangeComplete: TRecordChangeCompleteEvent read FOnRecordChangeComplete write FOnRecordChangeComplete;
    property OnWillChangeRecordset: TRecordsetReasonEvent read FOnWillChangeRecordset write FOnWillChangeRecordset;
    property OnRecordsetChangeComplete: TRecordsetErrorEvent read FOnRecordsetChangeComplete write FOnRecordsetChangeComplete;
    property OnWillMove: TRecordsetReasonEvent read FOnWillMove write FOnWillMove;
    property OnMoveComplete: TRecordsetErrorEvent read FOnMoveComplete write FOnMoveComplete;
    property OnEndOfRecordset: TEndOfRecordsetEvent read FOnEndOfRecordset write FOnEndOfRecordset;
    property OnFetchComplete: TRecordsetEvent read FOnFetchComplete write FOnFetchComplete;
    property OnFetchProgress: TFetchProgressEvent read FOnFetchProgress write FOnFetchProgress;
    property OnRecordsetCreate: TRecordsetCreate read FOnRecordsetCreate write FOnRecordsetCreate;
  end;

{ TADODataSet }

  TADODataSet = class(TCustomADODataSet)
  private
    FRDSConnection: TRDSConnection;
    procedure SetRDSConnection(Value: TRDSConnection);
  protected
    procedure DataEvent(Event: TDataEvent; Info: Longint); override;
    procedure OpenCursor(InfoQuery: Boolean); override;
    procedure SetConnection(const Value: TADOConnection); override;
    procedure SetDataSetField(const Value: TDataSetField); override;
  public
    procedure CreateDataSet;
    procedure GetIndexNames(List: TStrings);
    property IndexDefs;
  published
    property CommandText;
    property CommandTimeout;
    property CommandType;
    property DataSetField;
    property DataSource;
    property EnableBCD;
    property FieldDefs;
    property IndexName;
    property IndexFieldNames;
    property MasterFields;
    property ParamCheck;
    property Parameters;
    property Prepared;
    property RDSConnection: TRDSConnection read FRDSConnection write SetRDSConnection;
    property StoreDefs;
    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;
    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnNewRecord;
    property OnPostError;
   end;

{ TADOTable }

  TADOTable = class(TCustomADODataSet)
  private
    function GetTableDirect: Boolean;
    procedure SetTableDirect(const Value: Boolean);
    function GetReadOnly: Boolean;
    procedure SetReadOnly(const Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    procedure GetIndexNames(List: TStrings);
    property IndexDefs;
  published
    property CommandTimeout;
    property EnableBCD;
    property IndexFieldNames;
    property IndexName;
    property MasterFields;
    property MasterSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly stored False;
    property TableDirect: Boolean read GetTableDirect write SetTableDirect default False;
    property TableName: WideString read GetCommandText write SetCommandText;
  end;

{ TADOQuery }

  TADOQuery = class(TCustomADODataSet)
  private
    FSQL: TStrings;
    FRowsAffected: Integer;
    function GetSQL: TStrings;
    procedure SetSQL(const Value: TStrings);
  protected
    procedure QueryChanged(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecSQL: Integer; {for TQuery compatibility}
    property RowsAffected: Integer read FRowsAffected;
  published
    property CommandTimeout;
    property DataSource;
    property EnableBCD;
    property ParamCheck;
    property Parameters;
    property Prepared;
    property SQL: TStrings read GetSQL write SetSQL;
  end;

{ TADOStoredProc }

  TADOStoredProc = class(TCustomADODataSet)