📄 sdoledb.pas
字号:
{*******************************************************}
{ }
{ Delphi SQLDirect Component Library }
{ OLEDB support Unit }
{ }
{ Copyright (c) 1997,2005 by Yuri Sheino }
{ }
{*******************************************************}
{$I SqlDir.inc}
unit SDOleDb {$IFDEF SD_CLR} platform {$ENDIF};
interface
uses
Windows, SysUtils, Classes, Db, Registry, SyncObjs,
ActiveX, ComObj,
{$IFDEF SD_VCL6}
FmtBcd, Variants, OleDB,
{$ELSE}
SD_OleDb_D5, // a copy of OleDb.pas to exclude a collision with vclado50.bpl
{$ENDIF}
{$IFDEF SD_CLR}
System.Runtime.InteropServices,
{$ENDIF}
SDConsts, SDCommon;
//--------------------------------------------------------------------
// Additions to OleDb.pas
//--------------------------------------------------------------------
const
DBPROP_SKIPROWCOUNTRESULTS = $123;
IID_IErrorRecords: TGUID = '{0C733A67-2A1C-11CE-ADE5-00AA0044773D}';
IID_ISequentialStream:TGUID = '{0C733A30-2A1C-11CE-ADE5-00AA0044773D}';
IID_IStream: TGUID = '{0000000C-0000-0000-C000-000000000046}';
IID_IStorage: TGUID = '{0000000B-0000-0000-C000-000000000046}';
IID_ILockBytes: TGUID = '{0000000A-0000-0000-C000-000000000046}';
IID_IDBSchemaRowset: TGUID = '{0C733A7B-2A1C-11CE-ADE5-00AA0044773D}';
type
// *********************************************************************//
// Interface: IErrorRecords
// GUID: {0C733A67-2A1C-11CE-ADE5-00AA0044773D}
// *********************************************************************//
IErrorRecords = interface(IUnknown)
['{0C733A67-2A1C-11CE-ADE5-00AA0044773D}']
function AddErrorRecord(pErrorInfo: PERRORINFO; dwLookupID: DWORD;
pdispparams: PDISPPARAMS; const punkCustomError: IUnknown; dwDynamicErrorID: DWORD): HResult; stdcall;
function GetBasicErrorInfo(ulRecordNum: ULONG; pErrorInfo: PERRORINFO): HResult; stdcall;
function GetCustomErrorObject(ulRecordNum: ULONG; const riid: TGUID; out ppObject: IUnknown): HResult; stdcall;
function GetErrorInfo(ulRecordNum: ULONG; lcid: TLCID; out ppErrorInfo: IErrorInfo): HResult; stdcall;
function GetErrorParameters(ulRecordNum: ULONG; pdispparams: PDISPPARAMS): HResult; stdcall;
function GetRecordCount(out pcRecords: ULONG): HResult; stdcall;
end;
{ Safecall Version }
IErrorRecordsSC = interface(IUnknown)
['{0C733A67-2A1C-11CE-ADE5-00AA0044773D}']
function AddErrorRecord(pErrorInfo: PERRORINFO; dwLookupID: DWORD;
pdispparams: PDISPPARAMS; const punkCustomError: IUnknown; dwDynamicErrorID: DWORD): HResult; safecall;
function GetBasicErrorInfo(ulRecordNum: ULONG; pErrorInfo: PERRORINFO): HResult; safecall;
function GetCustomErrorObject(ulRecordNum: ULONG; const riid: TGUID; out ppObject: IUnknown): HResult; safecall;
function GetErrorInfo(ulRecordNum: ULONG; lcid: TLCID; out ppErrorInfo: IErrorInfo): HResult; safecall;
function GetErrorParameters(ulRecordNum: ULONG; pdispparams: PDISPPARAMS): HResult; safecall;
function GetRecordCount(out pcRecords: ULONG): HResult; safecall;
end;
// *********************************************************************//
// Interface: IDBSchemaRowset
// GUID: {0C733A7B-2A1C-11CE-ADE5-00AA0044773D}
// *********************************************************************//
IDBSchemaRowset = interface(IUnknown)
['{0C733A7B-2A1C-11CE-ADE5-00AA0044773D}']
function GetRowset(const pUnkOuter: IUnknown; const rguidSchema: TGUID;
cRestrictions: ULONG;
rgRestrictions: PVariantArg;
const riid: TGUID;
cPropertySets: ULONG;
rgPropertySets: PDBPropSetArray;
out pRowset: IUnknown): HResult; stdcall;
function GetSchemas(var cSchemas: ULONG; out prgSchemas: PGUID; out prgRestrictionSupport:PULONG): HResult; stdcall;
end;
{ Safecall Version }
IDBSchemaRowsetSC = interface(IUnknown)
['{0C733A7B-2A1C-11CE-ADE5-00AA0044773D}']
function GetRowset(const pUnkOuter: IUnknown; const rguidSchema: TGUID;
cRestrictions: ULONG;
rgRestrictions: PVariantArg;
const riid: TGUID;
cPropertySets: ULONG;
rgPropertySets: PDBPropSetArray;
out pRowset: IUnknown): HResult; safecall;
function GetSchemas(var cSchemas: ULONG; out prgSchemas: PGUID; out prgRestrictionSupport:PULONG): HResult; safecall;
end;
//--------------------------------------------------------------------
// Microsoft OLE DB Provider for SQL Server
//
// SQLOLEDB.H | Provider Specific definitions
//
//--------------------------------------------------------------------
const
// ProgID and CLSID of Microsoft OLE DB Provider for SQL Server (SQLOLEDB)
ProgID_SQLOLEDB = 'SQLOLEDB';
CLSID_SQLOLEDB: TGUID = '{0C7FF16C-38E3-11d0-97AB-00C04FC2AD98}';
// Error Lookup CLSID
CLSID_SQLOLEDB_ERROR: TGUID = '{C0932C62-38E5-11d0-97AB-00C04FC2AD98}';
// Enumerator CLSID
CLSID_SQLOLEDB_ENUMERATOR: TGUID = '{DFA22B8E-E68D-11d0-97E4-00C04FC2AD98}';
// Provider-specific Interface Ids
IID_ISQLServerErrorInfo: TGUID= '{5CF4CA12-EF21-11D0-97E7-00C04FC2AD98}';
IID_IRowsetFastLoad: TGUID = '{5CF4CA13-EF21-11D0-97E7-00C04FC2AD98}';
IID_IUMSInitialize: TGUID = '{5CF4CA14-EF21-11D0-97E7-00C04FC2AD98}';
IID_ISchemaLock: TGUID = '{4C2389FB-2511-11d4-B258-00C04F7971CE}';
DBGUID_MSSQLXML: TGUID = '{5d531cb2-e6ed-11d2-b252-00c04f681b71}';
DBGUID_XPATH: TGUID = '{ec2a4293-e898-11d2-b1b7-00c04f680c56}';
IID_ICommandStream: TGUID = '{0c733abf-2a1c-11ce-ade5-00aa0044773d}';
IID_ISQLXMLHelper: TGUID = '{d22a7678-f860-40cd-a567-1563deb46d49}';
// Provider-specific schema rowsets
DBSCHEMA_LINKEDSERVERS: TGUID = '{9093caf4-2eac-11d1-9809-00c04fc2ad98}';
CRESTRICTIONS_DBSCHEMA_LINKEDSERVERS = 1;
//----------------------------------------------------------------------------
// Provider-specific property sets
DBPROPSET_SQLSERVERDATASOURCE: TGUID = '{28efaee4-2d2c-11d1-9807-00c04fc2ad98}';
DBPROPSET_SQLSERVERDATASOURCEINFO:TGUID='{df10cb94-35f6-11d2-9c54-00c04f7971d3}';
DBPROPSET_SQLSERVERDBINIT: TGUID = '{5cf4ca10-ef21-11d0-97e7-00c04fc2ad98}';
DBPROPSET_SQLSERVERROWSET: TGUID = '{5cf4ca11-ef21-11d0-97e7-00c04fc2ad98}';
DBPROPSET_SQLSERVERSESSION: TGUID = '{28efaee5-2d2c-11d1-9807-00c04fc2ad98}';
DBPROPSET_SQLSERVERCOLUMN: TGUID = '{3b63fb5e-3fbb-11d3-9f29-00c04f8ee9dc}';
DBPROPSET_SQLSERVERSTREAM: TGUID = '{9f79c073-8a6d-4bca-a8a8-c9b79a9b962d}';
//----------------------------------------------------------------------------
// Provider-specific columns for IColumnsRowset
(*
DBCOLUMN_SS_COMPFLAGS :TDBID = {{0x627bd890,0xed54,0x11d2,{0xb9,0x94,0x0,0xc0,0x4f,0x8c,0xa8,0x2c}}, DBKIND_GUID_PROPID, (LPOLESTR)100};
DBCOLUMN_SS_SORTID :TDBID = {{0x627bd890,0xed54,0x11d2,{0xb9,0x94,0x0,0xc0,0x4f,0x8c,0xa8,0x2c}}, DBKIND_GUID_PROPID, (LPOLESTR)101};
DBCOLUMN_BASETABLEINSTANCE:TDBID = {{0x627bd890,0xed54,0x11d2,{0xb9,0x94,0x0,0xc0,0x4f,0x8c,0xa8,0x2c}}, DBKIND_GUID_PROPID, (LPOLESTR)102};
DBCOLUMN_SS_TDSCOLLATION :TDBID = {{0x627bd890,0xed54,0x11d2,{0xb9,0x94,0x0,0xc0,0x4f,0x8c,0xa8,0x2c}}, DBKIND_GUID_PROPID, (LPOLESTR)103};
*)
//----------------------------------------------------------------------------
// PropIds for DBPROP_INIT_GENERALTIMEOUT
DBPROP_INIT_GENERALTIMEOUT = $11c;
//----------------------------------------------------------------------------
// PropIds for DBPROPSET_SQLSERVERDATASOURCE
SSPROP_ENABLEFASTLOAD = 2;
//----------------------------------------------------------------------------
// PropIds for DBPROPSET_SQLSERVERDATASOURCEINFO
SSPROP_UNICODELCID = 2;
SSPROP_UNICODECOMPARISONSTYLE = 3;
SSPROP_COLUMNLEVELCOLLATION = 4;
SSPROP_CHARACTERSET = 5;
SSPROP_SORTORDER = 6;
SSPROP_CURRENTCOLLATION = 7;
//----------------------------------------------------------------------------
// PropIds for DBPROPSET_SQLSERVERDBINIT
SSPROP_INIT_CURRENTLANGUAGE = 4;
SSPROP_INIT_NETWORKADDRESS = 5;
SSPROP_INIT_NETWORKLIBRARY = 6;
SSPROP_INIT_USEPROCFORPREP = 7;
SSPROP_INIT_AUTOTRANSLATE = 8;
SSPROP_INIT_PACKETSIZE = 9;
SSPROP_INIT_APPNAME = 10;
SSPROP_INIT_WSID = 11;
SSPROP_INIT_FILENAME = 12;
SSPROP_INIT_ENCRYPT = 13;
SSPROP_AUTH_REPL_SERVER_NAME = 14;
SSPROP_INIT_TAGCOLUMNCOLLATION = 15;
//-----------------------------------------------------------------------------
// Values for SSPROP_USEPROCFORPREP
SSPROPVAL_USEPROCFORPREP_OFF = 0;
SSPROPVAL_USEPROCFORPREP_ON = 1;
SSPROPVAL_USEPROCFORPREP_ON_DROP = 2;
//----------------------------------------------------------------------------
// PropIds for DBPROPSET_SQLSERVERSESSION
SSPROP_QUOTEDCATALOGNAMES = 2;
SSPROP_ALLOWNATIVEVARIANT = 3;
SSPROP_SQLXMLXPROGID = 4;
//----------------------------------------------------------------------------
// PropIds for DBPROPSET_SQLSERVERROWSET
SSPROP_MAXBLOBLENGTH = 8;
SSPROP_FASTLOADOPTIONS = 9;
SSPROP_FASTLOADKEEPNULLS = 10;
SSPROP_FASTLOADKEEPIDENTITY = 11;
SSPROP_CURSORAUTOFETCH = 12;
SSPROP_DEFERPREPARE = 13;
SSPROP_IRowsetFastLoad = 14;
//----------------------------------------------------------------------------
// PropIds for DBPROPSET_SQLSERVERCOLUMN
SSPROP_COL_COLLATIONNAME = 14;
//----------------------------------------------------------------------------
// PropIds for DBPROPSET_SQLSERVERSTREAM
SSPROP_STREAM_MAPPINGSCHEMA = 15;
SSPROP_STREAM_XSL = 16;
SSPROP_STREAM_BASEPATH = 17;
SSPROP_STREAM_COMMANDTYPE = 18;
SSPROP_STREAM_XMLROOT = 19;
SSPROP_STREAM_FLAGS = 20;
SSPROP_STREAM_CONTENTTYPE = 23;
//----------------------------------------------------------------------------
// Possible values for SSPROP_STREAM_FLAGS
STREAM_FLAGS_DISALLOW_URL =$00000001;
STREAM_FLAGS_DISALLOW_ABSOLUTE_PATH =$00000002;
STREAM_FLAGS_DISALLOW_QUERY =$00000004;
STREAM_FLAGS_DONTCACHEMAPPINGSCHEMA =$00000008;
STREAM_FLAGS_DONTCACHETEMPLATE =$00000010;
STREAM_FLAGS_DONTCACHEXSL =$00000020;
STREAM_FLAGS_RESERVED =$ffff0000;
// Values for SSPROPVAL_COMMANDTYPE
SSPROPVAL_COMMANDTYPE_REGULAR = 21;
SSPROPVAL_COMMANDTYPE_BULKLOAD = 22;
//-------------------------------------------------------------------
// define SQL Server Spefific Variant Type
//-------------------------------------------------------------------
DBTYPE_SQLVARIANT = 144;
type
// the structure returned by ISQLServerErrorInfo::GetSQLServerInfo
PSSErrorInfo = ^TSSErrorInfo;
TSSErrorInfo = record
pwszMessage: PWideChar; // identical to the string returned IErrorInfo::GetDescription
pwszServer: PWideChar;
pwszProcedure: PWideChar;
lNative: UINT;
bState: Byte;
bClass: Byte;
wLineNumber: Word;
end;
// *********************************************************************//
// Interface: ISQLServerErrorInfo
// GUID: {5CF4CA12-EF21-11d0-97E7-00C04FC2AD98}
// *********************************************************************//
ISQLServerErrorInfo = interface(IUnknown)
['{5CF4CA12-EF21-11d0-97E7-00C04FC2AD98}']
function GetErrorInfo(
out ppErrorInfo: PSSErrorInfo;
out ppStringsBuffer: PWideChar): HResult; stdcall;
end;
{ Safecall Version }
ISQLServerErrorInfoSC = interface(IUnknown)
['{5CF4CA12-EF21-11d0-97E7-00C04FC2AD98}']
function GetErrorInfo(
out ppErrorInfo: PSSErrorInfo;
out ppStringsBuffer: PWideChar): HResult; safecall;
end;
//
// SQLOLEDB.H | Provider Specific definitions (end)
//--------------------------------------------------------------------
type
ESDOleDbError = class(ESDEngineError);
{ TIOleDbDatabase }
TIOleDbDatabase = class(TISqlDatabase)
private
FIDBInitialize: IDBInitialize;
FIDBCreateSession: IDBCreateSession;
FIDBCreateCommand: IDBCreateCommand;
FITransaction: ITransactionLocal;
FMultResultsSupported: Boolean;
FOutputParamsReturned: LongInt;
FIsMSSQLProv: Boolean;
FCurSqlCmd: TISqlCommand; // a command, which uses a database handle currently (when FIsSingleConn is True)
function OleDbGetDBPropValue(APropIDs: array of DBPROPID): string;
procedure SetDBInitProps(bInitPropSet, bIntegratedAuth: Boolean);
protected
procedure Check(Status: HResult);
// function GetHandle: TSDPtr; override;
procedure DoConnect(const sRemoteDatabase, sUserName, sPassword: string); override;
procedure DoDisconnect(Force: Boolean); override;
procedure DoCommit; override;
procedure DoRollback; override;
procedure DoStartTransaction; override;
procedure SetAutoCommitOption(Value: Boolean); override;
// procedure SetHandle(AHandle: TSDPtr); override;
public
constructor Create(ADbParams: TStrings); override;
destructor Destroy; override;
function CreateSqlCommand: TISqlCommand; override;
function GetClientVersion: LongInt; override;
function GetServerVersion: LongInt; override;
function GetVersionString: string; override;
function GetSchemaInfo(ASchemaType: TSDSchemaType; AObjectName: string): TISqlCommand; override;
procedure SetTransIsolation(Value: TISqlTransIsolation); override;
function SPDescriptionsAvailable: Boolean; override;
function TestConnected: Boolean; override;
procedure ReleaseDBHandle(ASqlCmd: TISqlCommand; IsFetchAll: Boolean);
property CurSqlCmd: TISqlCommand read FCurSqlCmd;
property DBCreateCommand: IDBCreateCommand read FIDBCreateCommand;
property IsMSSQLProv: Boolean read FIsMSSQLProv;
property MultResultsSupported: Boolean read FMultResultsSupported;
property OutputParamsReturned: LongInt read FOutputParamsReturned;
end;
{ TIOleDbCommand }
TIOleDbCommand = class(TISqlCommand)
private
FICommandText: ICommandText;
FIMultipleResults: IMultipleResults;
FIRowAccessor,
FIParamAccessor: IAccessor;
FHRowAccessor,
FHParamAccessor: HACCESSOR;
FRowBindPtr,
FParamBindPtr: PDBBINDING;
FHRows: PUintArray;
FCurrRow, // current fetched row in FHRows array
FFetchedRows: UINT; // actual number of fetched rows
FPrefetchRows: Integer; // number of rows requested by each call FIRowset.GetNextRows
FRowsAffected: Integer; // DBROWCOUNT
FIsSingleConn: Boolean; // True, if it's required to use a database handle always
FIsSrvCursor: Boolean; // if server cursor is used
FNextResults: Boolean;
FBlobParamsBufferOff: Integer;
FFirstCalcFieldIdx: Integer;// first field, which is not bound. The following fields are not corresponded actual database fields
function GetSqlDatabase: TIOleDbDatabase;
function CnvtDBData(AFieldName: string; ADataType: TFieldType; InBuf, Buffer: TSDPtr; BufSize: Integer): Boolean;
function CnvtDBDateTime2DateTimeRec(ADataType: TFieldType; Buffer: TSDPtr; BufSize: Integer): TDateTimeRec;
procedure InternalExecute(bFieldDescribe: Boolean);
procedure InternalSpGetParams;
procedure ReleaseRowSet;
procedure ReleaseHRows;
procedure SetICommandProps;
procedure SetICommandText(Value: string);
procedure SetICmdParameterInfo;
function OleDbDataSourceType(FieldType: TFieldType): string;
protected
FIRowset: IRowset;
procedure AcquireDBHandle;
procedure ReleaseDBHandle;
procedure Check(Status: HResult);
procedure Connect; virtual;
function CnvtDateTime2DBDateTime(ADataType: TFieldType; Value: TDateTime; Buffer: TSDValueBuffer; BufSize: Integer): Integer; override;
procedure AllocFieldsBuffer; override;
procedure AllocParamsBuffer; override;
procedure BindParamsBuffer; override;
procedure FreeFieldsBuffer; override;
procedure FreeParamsBuffer; override;
procedure SetFieldsBuffer; override;
function GetFieldsBufferSize: Integer; override;
function GetParamsBufferSize: Integer; override;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -