david
fff1b2a4dc
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.SDAC@3 6f543ec7-021b-7e4c-98c9-62eafc7fb9a8
5788 lines
169 KiB
ObjectPascal
5788 lines
169 KiB
ObjectPascal
|
|
//////////////////////////////////////////////////
|
|
// SQL Server Data Access Components
|
|
// Copyright © 1998-2007 Core Lab. All right reserved.
|
|
// MSAccess
|
|
//////////////////////////////////////////////////
|
|
|
|
{$IFNDEF CLR}
|
|
|
|
{$I Sdac.inc}
|
|
|
|
unit MSAccess;
|
|
{$ENDIF}
|
|
|
|
{ $R MSAccess.res}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF CLR}
|
|
Variants, System.XML, System.Text,
|
|
{$ELSE}
|
|
CLRClasses, CRXml,
|
|
{$ENDIF}
|
|
Classes, MemDS, DBAccess, MemData, CRAccess, OLEDBAccess, SysUtils, DB, CRParser,
|
|
OLEDBC, OLEDBIntf, MSConsts, MemUtils, DASQLMonitor, Windows, DAConsts, Win32Timer;
|
|
|
|
{$I SdacVer.inc}
|
|
|
|
const
|
|
ftMSXML = 50;
|
|
|
|
{ TMSParam }
|
|
const
|
|
/// WAR Need to sync with EdMSParams.FieldTypesWithSize on change
|
|
FieldTypesWithSize: set of TFieldType = [ftString, ftFixedChar, {ftMemo - BLOB, }ftBytes, ftVarBytes, ftWideString];
|
|
|
|
type
|
|
TMSParam = class (TDAParam)
|
|
private
|
|
FOLEDBType: DBTYPE;
|
|
protected
|
|
function GetSize: integer; override;
|
|
procedure SetSize(Value: integer); override;
|
|
|
|
procedure SetAsString(Value: string); override;
|
|
procedure SetAsWideString(Value: WideString); override;
|
|
procedure SetAsVariant(const Value: Variant); override;
|
|
|
|
procedure CreateObject; override;
|
|
|
|
function IsObjectDataType: boolean; overload;
|
|
property ParamObject;
|
|
property OLEDBType: DBTYPE read FOLEDBType write FOLEDBType;
|
|
public
|
|
constructor Create(Collection: TCollection); override;
|
|
|
|
procedure AssignFieldValue(Field: TField; const Value: Variant); override;
|
|
|
|
property AsString: string read GetAsString write SetAsString;
|
|
property AsWideString: WideString read GetAsWideString write SetAsWideString;
|
|
|
|
end;
|
|
|
|
{ TMSParams }
|
|
TMSParams = class (TDAParams)
|
|
private
|
|
function GetItem(Index: Integer): TMSParam;
|
|
procedure SetItem(Index: Integer; Value: TMSParam);
|
|
|
|
public
|
|
constructor Create(Owner: TPersistent);
|
|
|
|
procedure Assign(Source: TPersistent); override;
|
|
|
|
function ParamByName(const Value: string): TMSParam;
|
|
function FindParam(const Value: string): TMSParam;
|
|
property Items[Index: integer]: TMSParam read GetItem write SetItem; default;
|
|
|
|
end;
|
|
|
|
{ TMSConnection }
|
|
|
|
TMSConnection = class;
|
|
TMSConnectionOptions = class (TDAConnectionOptions)
|
|
protected
|
|
FQuotedIdentifier: boolean;
|
|
FLanguage: string;
|
|
FEncrypt: boolean;
|
|
FPersistSecurityInfo: boolean;
|
|
FAutoTranslate: boolean;
|
|
FNetworkLibrary: string;
|
|
FApplicationName: string;
|
|
FWorkstationID: string;
|
|
FPacketSize: integer;
|
|
FNumericType: TDANumericType;
|
|
FProvider: TOLEDBProvider;
|
|
FInitialFileName: string;
|
|
FMultipleActiveResultSets: boolean;
|
|
//FMaxDatabaseSize: integer;
|
|
FFailoverPartner: string;
|
|
|
|
procedure SetQuotedIdentifier(const Value: boolean);
|
|
procedure SetLanguage(const Value: string);
|
|
procedure SetEncrypt(const Value: boolean);
|
|
procedure SetPersistSecurityInfo(const Value: boolean);
|
|
procedure SetAutoTranslate(const Value: boolean);
|
|
procedure SetNetworkLibrary(const Value: string);
|
|
procedure SetApplicationName(const Value: string);
|
|
procedure SetWorkstationID(const Value: string);
|
|
procedure SetPacketSize(const Value: integer);
|
|
procedure SetNumericType(Value: TDANumericType);
|
|
procedure SetProvider(const Value: TOLEDBProvider);
|
|
procedure SetInitialFileName(const Value: string);
|
|
procedure SetMultipleActiveResultSets(const Value: boolean);
|
|
//procedure SetMaxDatabaseFile(const Value: integer);
|
|
procedure SetFailoverPartner(const Value: string);
|
|
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
|
|
public
|
|
constructor Create(Owner: TMSConnection);
|
|
|
|
published
|
|
property QuotedIdentifier: boolean read FQuotedIdentifier write SetQuotedIdentifier default True;
|
|
property Language: string read FLanguage write SetLanguage;
|
|
property Encrypt: boolean read FEncrypt write SetEncrypt default False;
|
|
property PersistSecurityInfo: boolean read FPersistSecurityInfo write SetPersistSecurityInfo default False;
|
|
property AutoTranslate: boolean read FAutoTranslate write SetAutoTranslate default True;
|
|
property NetworkLibrary: string read FNetworkLibrary write SetNetworkLibrary;
|
|
property ApplicationName: string read FApplicationName write SetApplicationName;
|
|
property WorkstationID: string read FWorkstationID write SetWorkstationID;
|
|
property PacketSize: integer read FPacketSize write SetPacketSize default 4096;
|
|
property NumericType: TDANumericType read FNumericType write SetNumericType default ntFloat;
|
|
property Provider: TOLEDBProvider read FProvider write SetProvider default prAuto;
|
|
property InitialFileName: string read FInitialFileName write SetInitialFileName;
|
|
property MultipleActiveResultSets: boolean read FMultipleActiveResultSets write SetMultipleActiveResultSets default False;
|
|
//property MaxDatabaseSize: integer read FMaxDatabaseSize write SetMaxDatabaseFile default 128;
|
|
property FailoverPartner: string read FFailoverPartner write SetFailoverPartner;
|
|
property KeepDesignConnected;
|
|
property DisconnectedMode;
|
|
property LocalFailover;
|
|
end;
|
|
|
|
TMSConnectionInfoMessageEvent = procedure (Sender: TObject; E: EMSError) of object;
|
|
TMSSQL = class;
|
|
|
|
TMSConnection = class (TCustomDAConnection)
|
|
protected
|
|
FLoginPrompt: boolean;
|
|
FLockLoginPrompt: boolean;
|
|
|
|
FDatabase: string;
|
|
FIsolationLevel: TIsolationLevel;
|
|
FAuthentication: TMSAuthentication;
|
|
|
|
FConnectionTimeout: integer;
|
|
// FMultipleConnections: boolean;
|
|
FOptions: TMSConnectionOptions;
|
|
|
|
FMSSQL: TMSSQL;
|
|
|
|
FOnInfoMessage: TMSConnectionInfoMessageEvent;
|
|
|
|
function GetIConnectionClass: TCRConnectionClass; override;
|
|
function GetICommandClass: TCRCommandClass; override;
|
|
function GetIRecordSetClass: TCRRecordSetClass; override;
|
|
|
|
procedure CreateIConnection; override;
|
|
procedure SetIConnection(Value: TCRConnection); override;
|
|
procedure SetOptions(Value: TMSConnectionOptions);
|
|
|
|
function GetOLEDBConnection: TOLEDBConnection;
|
|
|
|
function SQLMonitorClass: TClass; override;
|
|
function ConnectDialogClass: TConnectDialogClass; override;
|
|
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
|
|
procedure SetDatabase(Value: string);
|
|
|
|
procedure SetIsolationLevel(const Value: TIsolationLevel);
|
|
// procedure SetMultipleConnections(const Value: boolean);
|
|
|
|
procedure SetAuthentication(const Value: TMSAuthentication);
|
|
procedure SetConnectionTimeout(const Value: integer);
|
|
function NeedPrompt: boolean; override;
|
|
|
|
function IsFatalError(E: EDAError): boolean; override;
|
|
procedure DoError(E: Exception; var Fail, Reconnect, Reexecute: boolean; ReconnectAttempt: integer;
|
|
var ConnLostCause: TConnLostCause); override;
|
|
procedure DoInfoMessage(E: EMSError);
|
|
function IsKeyViolation(E: EDAError): boolean; override;
|
|
|
|
procedure Check(const Status: HRESULT; Sender: TObject);
|
|
procedure CheckInactive;
|
|
|
|
{ Transaction control }
|
|
procedure InternalStartTransaction; override;
|
|
|
|
function CommitOnDisconnect: boolean; override;
|
|
|
|
function GetConnectString: string; override;
|
|
procedure SetConnectString(Value: string); override;
|
|
function GetClientVersion: string;
|
|
function GetServerVersion: string;
|
|
|
|
|
|
function CreateOptions: TDAConnectionOptions; override;
|
|
|
|
function IConnection: TOLEDBConnection;
|
|
function IsCaseSensitive: boolean; override;
|
|
public
|
|
constructor Create(Owner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
function CreateDataSet: TCustomDADataSet; override;
|
|
function CreateSQL: TCustomDASQL; override;
|
|
|
|
procedure ChangePassword(NewPassword: string);
|
|
function ExecSQL(Text: string; const Params: array of variant): variant; override;
|
|
|
|
procedure GetTableNames(List: TStrings); override;
|
|
procedure GetDatabaseNames(List: TStrings); override;
|
|
procedure GetStoredProcNames(List: TStrings); overload; override;
|
|
procedure GetStoredProcNames(List: TStrings; System: boolean); reintroduce; overload;
|
|
|
|
property ClientVersion: string read GetClientVersion;
|
|
property ServerVersion: string read GetServerVersion;
|
|
|
|
published
|
|
property Database: string read FDatabase write SetDatabase;
|
|
property IsolationLevel: TIsolationLevel read FIsolationLevel write SetIsolationLevel default ilReadCommitted;
|
|
property Authentication: TMSAuthentication read FAuthentication write SetAuthentication default auServer;
|
|
property ConnectionTimeout: integer read FConnectionTimeout write SetConnectionTimeout default 15;
|
|
// property MultipleConnections: boolean read FMultipleConnections write SetMultipleConnections; {without default!}
|
|
|
|
property Options: TMSConnectionOptions read FOptions write SetOptions;
|
|
|
|
property PoolingOptions;
|
|
property Pooling;
|
|
|
|
property Username;
|
|
property Password;
|
|
property Server;
|
|
property Connected stored IsConnectedStored;
|
|
|
|
property AfterConnect;
|
|
property BeforeConnect;
|
|
property AfterDisconnect;
|
|
property BeforeDisconnect;
|
|
property OnLogin;
|
|
property OnError;
|
|
property ConnectDialog;
|
|
property LoginPrompt;
|
|
property ConnectString;
|
|
|
|
property OnInfoMessage: TMSConnectionInfoMessageEvent read FOnInfoMessage write FOnInfoMessage;
|
|
property OnConnectionLost;
|
|
end;
|
|
|
|
{ TCustomMSDataSet }
|
|
|
|
TMSDataSetOptions = class (TDADataSetOptions)
|
|
private
|
|
FEnableBCD: boolean;
|
|
FUniqueRecords: boolean;
|
|
FCursorUpdate: boolean;
|
|
FQueryIdentity: boolean;
|
|
FCheckRowVersion: boolean;
|
|
FDMLRefresh: boolean;
|
|
FAutoRefresh: boolean;
|
|
FAutoRefreshInterval: integer;
|
|
FSmartRefresh: boolean;
|
|
FDefaultValues: boolean;
|
|
FNonBlocking: boolean;
|
|
|
|
procedure SetEnableBCD(Value: boolean);
|
|
procedure SetUniqueRecords(Value: boolean);
|
|
procedure SetCursorUpdate(Value: boolean);
|
|
function GetAllFieldsEditable: boolean;
|
|
procedure SetAllFieldsEditable(const Value: boolean);
|
|
procedure SetAutoRefresh(Value: boolean);
|
|
procedure SetAutoRefreshInterval(Value: integer);
|
|
//procedure SetSmartRefresh(Value: boolean);
|
|
procedure SetNonBlocking(Value: boolean);
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
|
|
public
|
|
constructor Create(Owner: TCustomDADataSet);
|
|
|
|
published
|
|
property AllFieldsEditable: boolean read GetAllFieldsEditable write SetAllFieldsEditable stored False;
|
|
property EnableBCD: boolean read FEnableBCD write SetEnableBCD default False;
|
|
property UniqueRecords: boolean read FUniqueRecords write SetUniqueRecords default False;
|
|
property CursorUpdate: boolean read FCursorUpdate write SetCursorUpdate default True;
|
|
property QueryIdentity: boolean read FQueryIdentity write FQueryIdentity default True;
|
|
property CheckRowVersion: boolean read FCheckRowVersion write FCheckRowVersion default False;
|
|
property FullRefresh default False;
|
|
property DMLRefresh: boolean read FDMLRefresh write FDMLRefresh default False;
|
|
property AutoRefresh: boolean read FAutoRefresh write SetAutoRefresh default False;
|
|
property AutoRefreshInterval: integer read FAutoRefreshInterval write SetAutoRefreshInterval default 60; /// Seconds dac6.txt
|
|
//property SmartRefresh: boolean read FSmartRefresh write SetSmartRefresh default False;
|
|
property DefaultValues: boolean read FDefaultValues write FDefaultValues default False;
|
|
property NonBlocking: boolean read FNonBlocking write SetNonBlocking default False;
|
|
|
|
property LongStrings;
|
|
property RequiredFields default False;
|
|
property StrictUpdate;
|
|
property NumberRange;
|
|
property ReturnParams;
|
|
property TrimFixedChar;
|
|
property TrimVarChar;
|
|
property QueryRecCount;
|
|
property AutoPrepare;
|
|
property RemoveOnRefresh;
|
|
property FlatBuffers;
|
|
property QuoteNames;
|
|
property DetailDelay;
|
|
{$IFDEF HAVE_COMPRESS}
|
|
property CompressBlobMode;
|
|
{$ENDIF}
|
|
property LocalMasterDetail;
|
|
property CacheCalcFields;
|
|
property UpdateBatchSize;
|
|
property UpdateAllFields;
|
|
end;
|
|
|
|
TCustomMSDataSet = class;
|
|
TMSUpdateExecuteEvent = procedure (Sender: TCustomMSDataSet;
|
|
StatementTypes: TStatementTypes; Params: TMSParams) of object;
|
|
|
|
TMSSQLGenerator = class (TDASQLGenerator)
|
|
protected
|
|
function AssembleSB(const StatementType: TStatementType): string; override;
|
|
function GetActualFieldNameEx(FieldDesc: TCRFieldDesc; TableInfo: TCRTableInfo): string; overload; override;
|
|
procedure GenerateInsertSQL(
|
|
const KeyAndDataFields: TKeyAndDataFields;
|
|
const ModifiedFieldsOnly: boolean;
|
|
const Index: integer = -1); override;
|
|
procedure GenerateUpdateSQL(
|
|
const KeyAndDataFields: TKeyAndDataFields;
|
|
const ModifiedFieldsOnly: boolean;
|
|
const Index: integer = -1); override;
|
|
procedure GenerateRefreshSQLSelectPart(const KeyAndDataFields: TKeyAndDataFields); override;
|
|
procedure GenerateRefreshSQL(
|
|
const KeyAndDataFields: TKeyAndDataFields;
|
|
const ModifiedFieldsOnly: boolean); override;
|
|
function GetActualFieldName(FldDesc: TCRFieldDesc; IsRefresh: boolean): string; override;
|
|
procedure AddFieldToCondition(SB: StringBuilder; FieldDesc: TCRFieldDesc;
|
|
const StatementType: TStatementType;
|
|
const ModifiedFieldsOnly: boolean;
|
|
const Index: integer = -1); override;
|
|
|
|
procedure GenerateConditions(SB: StringBuilder; const StatementType: TStatementType;
|
|
const ModifiedFieldsOnly: boolean;
|
|
const KeyAndDataFields: TKeyAndDataFields;
|
|
const Index: integer = -1); override;
|
|
end;
|
|
|
|
TMSUpdateSQL = class;
|
|
|
|
TCustomMSDataSet = class (TCustomDADataSet)
|
|
private
|
|
function GetConnection: TMSConnection;
|
|
procedure SetConnection(Value: TMSConnection);
|
|
procedure SetCursorType(const Value: TMSCursorType);
|
|
procedure SetCommandTimeout(const Value: integer);
|
|
|
|
function GetUpdateObject: TMSUpdateSQL;
|
|
procedure SetUpdateObject(Value: TMSUpdateSQL);
|
|
protected
|
|
{ IProviderSupport }
|
|
function PSGetKeyFields: string; override;
|
|
|
|
protected
|
|
FIRecordSet: TOLEDBRecordSet;
|
|
FICommand: TOLEDBCommand;
|
|
|
|
FLockInitFieldDefs: boolean; //Used to prevent multiple calls to OLE DB Execute on FieldDefs.Update in DT generators
|
|
|
|
FBeforeUpdateExecute: TMSUpdateExecuteEvent;
|
|
FAfterUpdateExecute: TMSUpdateExecuteEvent;
|
|
|
|
FIsAnyFieldDescCanBeModified: boolean;
|
|
FTimestampField: TField;
|
|
|
|
FOptions: TMSDataSetOptions;
|
|
FCursorType: TMSCursorType;
|
|
|
|
FCommandTimeout: integer;
|
|
|
|
FIsInInitFieldDefs: boolean;
|
|
FUseParamType: boolean;
|
|
|
|
FCanOpenNext: boolean;
|
|
|
|
FAutoRefreshTimer: TWin32Timer;
|
|
|
|
{ Smart Refresh}
|
|
{$IFNDEF STD}
|
|
FRefreshServiceBroker: TComponent;
|
|
FRefreshQueue: string;
|
|
FRefreshService: string;
|
|
FAfterSmartRefresh: TDataSetNotifyEvent;
|
|
FNeedSmartRefresh: boolean;
|
|
{$ENDIF}
|
|
|
|
procedure AutoRefreshTimer(Sender: TObject);
|
|
|
|
function QuoteName(const AName: string): string; overload; override;
|
|
function QuoteName(const AName: string; const LeftQuote, RightQuote: string): string; reintroduce; overload;
|
|
|
|
function GetParams: TMSParams;
|
|
procedure SetParams(Value: TMSParams);
|
|
|
|
procedure CreateIRecordSet; override;
|
|
procedure SetIRecordSet(Value: TData); override;
|
|
procedure SetNumericType;
|
|
|
|
procedure CreateCommand; override;
|
|
|
|
function CreateOptions: TDADataSetOptions; override;
|
|
procedure SetOptions(Value: TMSDataSetOptions);
|
|
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
|
|
procedure BeginConnection(NoConnectCheck: boolean = True); override;
|
|
procedure EndConnection; override;
|
|
|
|
{ Smart Refresh}
|
|
{$IFDEF SMART_REFRESH}
|
|
{$IFNDEF STD}
|
|
procedure RegisterNotification;
|
|
procedure UnregisterNotification;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{ Open/Close }
|
|
procedure SetActive(Value: Boolean); override;
|
|
procedure DataReopen; override;
|
|
procedure InternalExecute; override;
|
|
procedure InternalOpen; override;
|
|
procedure InternalClose; override;
|
|
procedure OpenCursor(InfoQuery: boolean); override;
|
|
procedure GetFieldsInfo;
|
|
function GetRecCount: longint; override;
|
|
function GetRecordCount: integer; override;
|
|
procedure DoCursorTypeChanged; // Callback from internal level. Called if CursorType or ReadOnly is changed on OLEDB execute
|
|
procedure SetFetchAll(Value: boolean); override;
|
|
procedure UpdateExecute(const StatementTypes: TStatementTypes); override;
|
|
|
|
procedure CheckInactive; override;
|
|
|
|
{ Fields }
|
|
procedure InitFieldDefs; override;
|
|
procedure InternalInitFieldDefs; override;
|
|
function GetFieldType(DataType: word): TFieldType; override;
|
|
function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
|
|
{$IFDEF USE_FTAUTOINC}
|
|
function GetFieldType(FieldDesc: TFieldDesc): TFieldType; override;
|
|
{$ENDIF}
|
|
procedure SetNumberRange(FieldDef: TFieldDef); override;
|
|
procedure DetectIdentityField; override;
|
|
|
|
{ Edit }
|
|
procedure CreateSQLGenerator; override;
|
|
procedure SetReadOnly(Value: boolean); override;
|
|
procedure InternalBeforeEdit; override;
|
|
procedure GetKeyAndDataFields(
|
|
out KeyAndDataFields: TKeyAndDataFields;
|
|
const ForceUseAllKeyFields: boolean); override;
|
|
|
|
procedure InternalRefreshRecord; override;
|
|
procedure CheckUpdateQuery(const StatementType: TStatementType); override;
|
|
function UseParamType: boolean; override; //This function indicates ParamType using in PerformSQL
|
|
function PerformSQL(const SQL: string; const StatementTypes: TStatementTypes): boolean; override;
|
|
|
|
procedure InternalCreateProcCall(Name: string; NeedDescribe: boolean);
|
|
|
|
{ RefreshQuick}
|
|
function IsRefreshQuickField(FieldDesc: TFieldDesc): boolean; override;
|
|
procedure SaveMaxRefreshQuickValue(FieldDesc: TFieldDesc; const Value: variant); override;
|
|
|
|
function GetCanModify: boolean; override;
|
|
|
|
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: boolean): TGetResult; override;
|
|
|
|
function NeedReturnParams: boolean; override;
|
|
|
|
procedure AssignFieldValue(Param: TDAParam; Field: TField; Old: boolean); override;
|
|
{ Smart Refresh}
|
|
{$IFNDEF STD}
|
|
procedure DoSmartRefresh;
|
|
{$ENDIF}
|
|
|
|
{ Navigation }
|
|
procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
|
|
|
|
procedure DoAfterExecute(Result: boolean); override;
|
|
|
|
{ Before / After UpdateExecute }
|
|
function AssignedBeforeUpdateExecute: boolean; override;
|
|
procedure DoBeforeUpdateExecute(Sender: TDataSet; StatementTypes: TStatementTypes;
|
|
Params: TDAParams); override;
|
|
function AssignedAfterUpdateExecute: boolean; override;
|
|
procedure DoAfterUpdateExecute(Sender: TDataSet; StatementTypes: TStatementTypes;
|
|
Params: TDAParams); override;
|
|
|
|
{ SQL Modifications }
|
|
function SQLAddWhere(SQLText, Condition: string): string; override;
|
|
function SQLDeleteWhere(SQLText: string): string; override;
|
|
function SQLGetWhere(SQLText: string): string; override;
|
|
function SQLSetOrderBy(SQLText: string; Fields: string): string; override;
|
|
function SQLGetOrderBy(SQLText: string): string; override;
|
|
|
|
(* procedure SetBeforeFetch(Value: TBeforeFetchEvent); override;
|
|
procedure SetAfterFetch(Value: TAfterFetchEvent); override;*)
|
|
|
|
procedure SetRefreshOptions(Value: TRefreshOptions); override;
|
|
|
|
{ XML }
|
|
procedure WriteFieldXMLDataType(Field: TField; FieldDesc: TFieldDesc; const FieldAlias: string;
|
|
XMLWriter: XMLTextWriter); override;
|
|
procedure WriteFieldXMLAttributeType(Field: TField; FieldDesc: TFieldDesc; const FieldAlias: string;
|
|
XMLWriter: XMLTextWriter); override;
|
|
|
|
public
|
|
constructor Create(Owner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
{ Open/Close }
|
|
function Fetched: boolean; override;
|
|
procedure UnPrepare; override;
|
|
function OpenNext: boolean; // Open next rowset in statement. if rowset not returne theh OpenNext return False. If statement has error, then raised exception
|
|
procedure BreakExec;
|
|
procedure RefreshQuick(const CheckDeleted: boolean);
|
|
|
|
function FindParam(const Value: string): TMSParam;
|
|
function ParamByName(const Value: string): TMSParam;
|
|
|
|
{ Edit}
|
|
procedure CreateProcCall(Name: string);
|
|
|
|
procedure Post; override;
|
|
procedure Cancel; override;
|
|
|
|
{ SQL Modify }
|
|
property Connection: TMSConnection read GetConnection write SetConnection;
|
|
|
|
property Options: TMSDataSetOptions read FOptions write SetOptions;
|
|
|
|
{ Edit }
|
|
property Params: TMSParams read GetParams write SetParams stored False;
|
|
|
|
property CursorType: TMSCursorType read FCursorType write SetCursorType default ctDefaultResultSet;
|
|
property CommandTimeout: integer read FCommandTimeout write SetCommandTimeout default 0;
|
|
|
|
property BeforeUpdateExecute: TMSUpdateExecuteEvent read FBeforeUpdateExecute write FBeforeUpdateExecute;
|
|
property AfterUpdateExecute: TMSUpdateExecuteEvent read FAfterUpdateExecute write FAfterUpdateExecute;
|
|
property BeforeFetch;
|
|
property AfterFetch;
|
|
|
|
property FetchAll: boolean read FFetchAll write SetFetchAll default True;
|
|
|
|
property UpdateObject: TMSUpdateSQL read GetUpdateObject write SetUpdateObject;
|
|
end;
|
|
|
|
{ TMSUpdateSQL }
|
|
|
|
TMSUpdateSQL = class (TCustomDAUpdateSQL)
|
|
protected
|
|
function DataSetClass: TCustomDADataSetClass; override;
|
|
function SQLClass: TCustomDASQLClass; override;
|
|
end;
|
|
|
|
{ TMSQuery }
|
|
|
|
TMSQuery = class (TCustomMSDataSet)
|
|
protected
|
|
procedure SetIRecordSet(Value: TData); override;
|
|
|
|
published
|
|
property SQLInsert;
|
|
property SQLDelete;
|
|
property SQLUpdate;
|
|
property SQLRefresh;
|
|
|
|
property Connection;
|
|
property ParamCheck;
|
|
property SQL;
|
|
property Debug;
|
|
property Macros;
|
|
property Params;
|
|
property FetchRows;
|
|
property ReadOnly;
|
|
property UniDirectional;
|
|
property CachedUpdates;
|
|
|
|
property AfterExecute;
|
|
property BeforeUpdateExecute;
|
|
property AfterUpdateExecute;
|
|
property OnUpdateError;
|
|
property OnUpdateRecord;
|
|
|
|
property UpdateObject;
|
|
property RefreshOptions;
|
|
|
|
property AutoCalcFields;
|
|
property Filtered;
|
|
property Filter;
|
|
property FilterOptions;
|
|
|
|
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 OnFilterRecord;
|
|
property OnNewRecord;
|
|
property OnPostError;
|
|
{$IFNDEF VER4}
|
|
property AfterRefresh;
|
|
property BeforeRefresh;
|
|
{$ENDIF}
|
|
|
|
property Options;
|
|
property FilterSQL;
|
|
|
|
property MasterSource;
|
|
property MasterFields;
|
|
property DetailFields;
|
|
|
|
property UpdatingTable;
|
|
|
|
property FetchAll;
|
|
property CursorType;
|
|
property CommandTimeout;
|
|
|
|
property IndexFieldNames;
|
|
property Active; /// CR DAC 13049
|
|
property BeforeFetch;
|
|
property AfterFetch;
|
|
end;
|
|
|
|
{ TMSTable }
|
|
|
|
TCustomMSTable = class (TCustomMSDataSet)
|
|
protected
|
|
{ IProviderSupport }
|
|
function PSGetTableName: string; override;
|
|
procedure PSSetParams(AParams: DB.TParams); override;
|
|
{$IFDEF VER5P}
|
|
procedure PSSetCommandText(const CommandText: string); override;
|
|
{$ENDIF}
|
|
|
|
protected
|
|
FTableName: string;
|
|
FOrderFields: string;
|
|
|
|
procedure SetTableName(const Value: string);
|
|
|
|
procedure SetOrderFields(Value: string);
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
|
|
{ Open/Close }
|
|
procedure OpenCursor(InfoQuery: boolean); override;
|
|
|
|
public
|
|
{ Open/Close }
|
|
procedure Prepare; override;
|
|
procedure PrepareSQL;
|
|
procedure Execute; override;
|
|
|
|
property TableName: string read FTableName write SetTableName;
|
|
property OrderFields: string read FOrderFields write SetOrderFields;
|
|
end;
|
|
|
|
TMSTable = class (TCustomMSTable)
|
|
published
|
|
property TableName;
|
|
property OrderFields;
|
|
property MasterFields;
|
|
property DetailFields;
|
|
property MasterSource;
|
|
property ReadOnly;
|
|
|
|
property Connection;
|
|
|
|
property Debug;
|
|
property FetchRows;
|
|
property UniDirectional;
|
|
property CachedUpdates;
|
|
|
|
property OnUpdateError;
|
|
property OnUpdateRecord;
|
|
|
|
property UpdateObject;
|
|
property RefreshOptions;
|
|
|
|
property Active;
|
|
property AutoCalcFields;
|
|
property Filtered;
|
|
property Filter;
|
|
property FilterOptions;
|
|
|
|
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 OnFilterRecord;
|
|
property OnNewRecord;
|
|
property OnPostError;
|
|
{$IFNDEF VER4}
|
|
property AfterRefresh;
|
|
property BeforeRefresh;
|
|
{$ENDIF}
|
|
property Options;
|
|
property FilterSQL;
|
|
|
|
property FetchAll;
|
|
property CursorType;
|
|
property CommandTimeout;
|
|
|
|
property IndexFieldNames;
|
|
|
|
property BeforeFetch;
|
|
property AfterFetch;
|
|
end;
|
|
|
|
{ TMSStoredProc }
|
|
|
|
TCustomMSStoredProc = class (TCustomMSDataSet)
|
|
protected
|
|
{ IProviderSupport }
|
|
{$IFDEF VER5P}
|
|
procedure PSSetCommandText(const CommandText: string); override;
|
|
{$ENDIF}
|
|
|
|
protected
|
|
FStoredProcName: string;
|
|
FIsInPrepare: boolean;
|
|
|
|
procedure SetIRecordSet(Value: TData); override;
|
|
procedure SetStoredProcName(const Value: string);
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
|
|
procedure BeforeOpenCursor(InfoQuery: boolean); override;
|
|
procedure BeforeExecute; override;
|
|
procedure CreateFieldDefs; override;
|
|
|
|
public
|
|
procedure ExecProc; // for BDE compatibility
|
|
|
|
procedure Prepare; override;
|
|
procedure PrepareSQL;
|
|
|
|
property UpdatingTable;
|
|
property StoredProcName: string read FStoredProcName write SetStoredProcName;
|
|
end;
|
|
|
|
TMSStoredProc = class(TCustomMSStoredProc)
|
|
published
|
|
property StoredProcName;
|
|
|
|
property SQLInsert;
|
|
property SQLDelete;
|
|
property SQLUpdate;
|
|
property SQLRefresh;
|
|
|
|
property Connection;
|
|
property ParamCheck stored False;
|
|
property SQL;
|
|
property Debug;
|
|
property Params;
|
|
property FetchRows;
|
|
property ReadOnly;
|
|
property UniDirectional;
|
|
property CachedUpdates;
|
|
|
|
property AfterExecute;
|
|
property BeforeUpdateExecute;
|
|
property AfterUpdateExecute;
|
|
property OnUpdateError;
|
|
property OnUpdateRecord;
|
|
|
|
property Options;
|
|
property UpdateObject;
|
|
property RefreshOptions;
|
|
|
|
property Active;
|
|
property AutoCalcFields;
|
|
property Filtered;
|
|
property Filter;
|
|
property FilterOptions;
|
|
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 OnFilterRecord;
|
|
property OnNewRecord;
|
|
property OnPostError;
|
|
{$IFNDEF VER4}
|
|
property AfterRefresh;
|
|
property BeforeRefresh;
|
|
{$ENDIF}
|
|
|
|
property UpdatingTable;
|
|
|
|
property FetchAll;
|
|
property CursorType;
|
|
property CommandTimeout;
|
|
end;
|
|
|
|
{ TMSSQL }
|
|
|
|
TMSSQL = class (TCustomDASQL)
|
|
private
|
|
function GetConnection: TMSConnection;
|
|
procedure SetConnection(Value: TMSConnection);
|
|
|
|
function GetParams: TMSParams;
|
|
procedure SetParams(Value: TMSParams);
|
|
|
|
protected
|
|
FICommand: TOLEDBCommand;
|
|
FCommandTimeout: integer;
|
|
FNonBlocking: boolean;
|
|
|
|
function GetPermitPrepare: boolean;
|
|
procedure SetPermitPrepare(Value: boolean);
|
|
|
|
procedure CreateICommand; override;
|
|
procedure SetICommand(Value: TCRCommand); override;
|
|
procedure InternalPrepare; override;
|
|
procedure InternalExecute(Iters: integer); override;
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
|
|
function ParseSQL(const SQL: string; Params: TDAParams; RenamePrefix: string = ''): string; override;
|
|
function CreateParser(const Text: string): TParser; override;
|
|
procedure AssembleSQL; override;
|
|
function CreateParamsObject: TDAParams; override;
|
|
procedure CreateParams; override;
|
|
procedure WriteParams(WriteValue: boolean = True); override;
|
|
procedure ReadParams; override;
|
|
|
|
procedure SetCommandTimeout(const Value: integer);
|
|
procedure SetNonBlocking(const Value: boolean);
|
|
public
|
|
constructor Create(Owner: TComponent); override;
|
|
procedure Execute(Iters: integer); override;
|
|
procedure BreakExec;
|
|
|
|
procedure CreateProcCall(Name: string);
|
|
published
|
|
function FindParam(const Value: string): TMSParam;
|
|
function ParamByName(const Value: string): TMSParam;
|
|
|
|
property Connection: TMSConnection read GetConnection write SetConnection;
|
|
property Params: TMSParams read GetParams write SetParams stored False;
|
|
|
|
property ParamCheck;
|
|
property SQL;
|
|
property Macros;
|
|
property Debug;
|
|
|
|
property AfterExecute;
|
|
property CommandTimeout: integer read FCommandTimeout write SetCommandTimeout;
|
|
property NonBlocking: boolean read FNonBlocking write SetNonBlocking default False;
|
|
|
|
property PermitPrepare: boolean write SetPermitPrepare stored False;
|
|
|
|
end;
|
|
|
|
{ TMSMetadata }
|
|
|
|
TMSObjectType = (otDatabases,
|
|
otColumnPrivileges, otColumns,
|
|
otForeignKeys, otPrimaryKeys,
|
|
otIndexes,
|
|
otServerTypes,
|
|
otSchemata, otStatistics,
|
|
otStoredProcs, otStoredProcParams,
|
|
otAliases, otTables, otSynonyms, otSystemTables, otViews, otGlobalTempTables, otLocalTempTables, otSystemViews,
|
|
otAliasesInfo, otTablesInfo, otSynonymsInfo, otSystemTablesInfo, otViewsInfo, otGlobalTempTablesInfo, otLocalTempTablesInfo, otExternalTablesInfo, otSystemViewsInfo,
|
|
otTableConstraints, otTablePrivileges,
|
|
otLinkedServers,
|
|
otAssemblies,
|
|
otAssemblyDependencies,
|
|
otUserTypes,
|
|
otXMLCollections);
|
|
|
|
TMSMetadata = class (TCustomMSDataSet)
|
|
protected
|
|
FObjectType: TMSObjectType;
|
|
|
|
FDatabaseName: string;
|
|
FSchemaName: string;
|
|
FTableName: string;
|
|
FStoredProcName: string;
|
|
FColumnName: string;
|
|
FIndexName: string;
|
|
FConstraintName: string;
|
|
FLinkedServer: string;
|
|
FAssemblyName: string;
|
|
FAssemblyID: integer;
|
|
FReferencedAssemblyID: integer;
|
|
FUDTName: string;
|
|
FSchemaCollectionName: string;
|
|
FTargetNamespaceURI: string;
|
|
|
|
procedure SetDatabaseName(Value: string);
|
|
procedure SetSchemaName(Value: string);
|
|
procedure SetObjectType(Value: TMSObjectType);
|
|
procedure SetTableName(Value: string);
|
|
procedure SetStoredProcName(Value: string);
|
|
procedure SetColumnName(Value: string);
|
|
procedure SetIndexName(Value: string);
|
|
procedure SetConstraintName(Value: string);
|
|
procedure SetLinkedServer(Value: string);
|
|
procedure SetAssemblyName(Value: string);
|
|
procedure SetAssemblyID(Value: integer);
|
|
procedure SetReferencedAssemblyID(Value: integer);
|
|
procedure SetUDTName(Value: string);
|
|
procedure SetSchemaCollectionName(Value: string);
|
|
procedure SetTargetNamespaceURI(Value: string);
|
|
|
|
function RequestIRowset: IRowset;
|
|
procedure InternalExecute; override;
|
|
procedure OpenCursor(InfoQuery: boolean); override;
|
|
|
|
public
|
|
constructor Create(Owner: TComponent); override;
|
|
|
|
published
|
|
property ObjectType: TMSObjectType read FObjectType write SetObjectType default otDatabases;
|
|
|
|
property DatabaseName: string read FDatabaseName write SetDatabaseName;
|
|
property SchemaName: string read FSchemaName write SetSchemaName;
|
|
property TableName: string read FTableName write SetTableName;
|
|
property StoredProcName: string read FStoredProcName write SetStoredProcName;
|
|
property ColumnName: string read FColumnName write SetColumnName;
|
|
property IndexName: string read FIndexName write SetIndexName;
|
|
property ConstraintName: string read FConstraintName write SetConstraintName;
|
|
|
|
property LinkedServer: string read FLinkedServer write SetLinkedServer;
|
|
property AssemblyName: string read FAssemblyName write SetAssemblyName;
|
|
property AssemblyID: integer read FAssemblyID write SetAssemblyID default 0;
|
|
property ReferencedAssemblyID: integer read FReferencedAssemblyID write SetReferencedAssemblyID default 0;
|
|
property UDTName: string read FUDTName write SetUDTName;
|
|
property SchemaCollectionName: string read FSchemaCollectionName write SetSchemaCollectionName;
|
|
property TargetNamespaceURI: string read FTargetNamespaceURI write SetTargetNamespaceURI;
|
|
|
|
property Active;
|
|
property Connection;
|
|
end;
|
|
|
|
TMSSchemaCollection = record
|
|
Name: string;
|
|
CatalogName: string;
|
|
SchemaName: string;
|
|
end;
|
|
|
|
TMSXMLField = class(TField)
|
|
protected
|
|
FTyped: boolean;
|
|
FSchemaCollection: TMSSchemaCollection;
|
|
procedure GetText(var Text: string; DisplayText: Boolean); override;
|
|
procedure SetSchemaCollection(Name, CatalogName, SchemaName: string);
|
|
|
|
function GetBlobSize: Integer;
|
|
// function GetModified: Boolean;
|
|
// procedure SetModified(Value: Boolean);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
|
|
// Copied from TBlobField
|
|
// procedure Assign(Source: TPersistent); override;
|
|
procedure Clear; override;
|
|
class function IsBlob: Boolean; override;
|
|
procedure LoadFromFile(const FileName: string);
|
|
procedure LoadFromStream(Stream: TStream);
|
|
procedure SaveToFile(const FileName: string);
|
|
procedure SaveToStream(Stream: TStream);
|
|
procedure SetFieldType(Value: TFieldType); override;
|
|
property BlobSize: Integer read GetBlobSize;
|
|
// property Modified: Boolean read GetModified write SetModified;
|
|
property Value: string read GetAsString write SetAsString;
|
|
|
|
property XML: string read GetAsString write SetAsString;
|
|
property Typed: boolean read FTyped;
|
|
property SchemaCollection: TMSSchemaCollection read FSchemaCollection;
|
|
published
|
|
// property Transliterate: Boolean read FTransliterate write FTransliterate default True;
|
|
// property Size default 0;
|
|
end;
|
|
|
|
{ TMSDataSource }
|
|
|
|
TMSDataSource = class(TCRDataSource)
|
|
end;
|
|
|
|
TMSAccessUtils = class
|
|
public
|
|
class procedure GetKeyAndDataFields(
|
|
Obj: TCustomMSDataSet;
|
|
out KeyAndDataFields: TKeyAndDataFields;
|
|
const ForceUseAllKeyFields: boolean);
|
|
class procedure SetDesigning(Obj: TCustomMSDataSet; Value: Boolean; SetChildren: Boolean = True);
|
|
class procedure SetLockLoginPromt(Obj: TMSConnection; Value: Boolean);
|
|
|
|
class function FIConnection(Obj: TMSConnection): TOLEDBConnection;
|
|
class function FIRecordSet(Obj: TCustomMSDataSet): TOLEDBRecordSet;
|
|
|
|
class function GetOLEDBSQL(Obj: TCustomMSDataSet): string; overload;
|
|
class function GetOLEDBSQL(Obj: TMSSQL): string; overload;
|
|
|
|
class function FIDBCreateSession(Obj: TOLEDBConnection): IDBCreateSession;
|
|
|
|
class procedure DoError(Obj: TMSConnection; E: Exception; var Fail: boolean);
|
|
end;
|
|
|
|
procedure GetServerList(List: TStrings);
|
|
procedure GetDatabasesList(const Connection: TMSconnection; List: TStrings);
|
|
procedure GetTablesList(const Connection: TMSconnection; List: TStrings);
|
|
|
|
function IsLargeDataTypeUsed(const Field: TField): boolean; overload;
|
|
|
|
function TableNamesFromList(List: TStrings): string;
|
|
procedure TableNamesToList(Value: string; List: TStrings);
|
|
|
|
var
|
|
DefConnectDialogClassProc: function: TClass = nil;
|
|
CurrentProjectOutputDir: string;
|
|
__UseUpdateOptimization: boolean;
|
|
|
|
|
|
implementation
|
|
|
|
{ $DEFINE SMART_REFRESH}
|
|
|
|
uses
|
|
{$IFDEF CLR}
|
|
System.Runtime.InteropServices, System.Reflection,
|
|
{$ENDIF}
|
|
{$IFDEF VER7P}
|
|
StrUtils,
|
|
{$ENDIF}
|
|
{$IFDEF VER6P}
|
|
{$IFNDEF CLR}
|
|
Variants,
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
comobj,
|
|
{$ENDIF}
|
|
DBCommon, DBConsts, MSParser, Registry, ActiveX, MSSQLMonitor, Math, DBMonitorIntf,
|
|
MSConnectionPool, CRConnectionPool,
|
|
{$IFDEF SMART_REFRESH}
|
|
{$IFNDEF STD}
|
|
MSServiceBroker,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Messages;
|
|
|
|
{$IFDEF SMART_REFRESH}
|
|
{$IFNDEF STD}
|
|
const
|
|
sSdacService = '__SdacNotificationService';
|
|
sSdacQueue = '__SdacNotificationQueue';
|
|
|
|
type
|
|
TMSRefreshServiceBroker = class(TMSServiceBroker)
|
|
private
|
|
FDataSet: TCustomMSDataSet;
|
|
FErrorCount: integer;
|
|
protected
|
|
procedure OnThreadEvent(Sender: TObject; Event: TObject; var Cancel: boolean); override;
|
|
procedure OnThreadMessage(Sender: TObject; Event: TObject); override;
|
|
public
|
|
procedure Start; override;
|
|
end;
|
|
|
|
{ TMSRefreshServiceBroker }
|
|
|
|
procedure TMSRefreshServiceBroker.OnThreadEvent(Sender: TObject; Event: TObject; var Cancel: boolean);
|
|
|
|
procedure CheckQNError(Source, Info: string);
|
|
begin
|
|
if Source = 'statement' then begin
|
|
if Info = 'query' then
|
|
DatabaseError(SInvalidQNStatement)
|
|
else
|
|
if Info = 'invalid' then
|
|
DatabaseError(SStatementNotSupported)
|
|
else
|
|
if Info = 'set options' then
|
|
DatabaseError(SInvalidQNSetOptions)
|
|
else
|
|
if Info = 'isolation' then
|
|
DatabaseError(SInvalidQNIsolation)
|
|
else
|
|
if Info = 'query template limit' then
|
|
DatabaseError(STemplateLimit);
|
|
end
|
|
else
|
|
if Source = 'timeout' then
|
|
DatabaseError(SSubscriptionTimedOut)
|
|
else
|
|
if Source = 'object' then begin
|
|
if Info = 'drop' then
|
|
DatabaseError(SQNObjectDropped)
|
|
else
|
|
if Info = 'alter' then
|
|
DatabaseError(SQNObjectAltered)
|
|
end
|
|
else
|
|
if Source = 'system' then begin
|
|
if Info = 'restart' then
|
|
DatabaseError(SSQLServerStarted)
|
|
else
|
|
if Info = 'error' then
|
|
DatabaseError(SSQLInternalError)
|
|
else
|
|
if Info = 'resource' then
|
|
DatabaseError(SSubscriptionRemoved)
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited;
|
|
|
|
if TMSServiceBrokerMsg(Event).MessageProperties.QNMessage <> GetComponentName(FDataSet) then
|
|
Cancel := True
|
|
else
|
|
try
|
|
// Check Query Notification Error
|
|
CheckQNError(TMSServiceBrokerMsg(Event).MessageProperties.QNSource, TMSServiceBrokerMsg(Event).MessageProperties.QNInfo);
|
|
except
|
|
if FErrorCount >= 1 then begin
|
|
// FDataSet.UnregisterNotification
|
|
raise;
|
|
end
|
|
else
|
|
Inc(FErrorCount);
|
|
Cancel := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSRefreshServiceBroker.OnThreadMessage(Sender: TObject; Event: TObject);
|
|
begin
|
|
Event.Free;
|
|
FDataSet.DoSmartRefresh;
|
|
end;
|
|
|
|
procedure TMSRefreshServiceBroker.Start;
|
|
begin
|
|
FErrorCount := 0;
|
|
inherited;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF VER6P}
|
|
const
|
|
varShortInt = $0010; { vt_i1 }
|
|
varWord = $0012; { vt_ui2 }
|
|
varLongWord = $0013; { vt_ui4 }
|
|
varInt64 = $0014; { vt_i8 }
|
|
{$ENDIF}
|
|
|
|
function IsLargeDataTypeUsed(const Field: TField): boolean; overload;
|
|
begin
|
|
Result :=
|
|
(Field is TBlobField) or
|
|
((Field is TMemoField) and (TMemoField(Field).BlobSize > MaxNonBlobFieldLen));
|
|
end;
|
|
|
|
function IsLargeDataTypeUsed(const Param: TParam): boolean; overload;
|
|
begin
|
|
Result :=
|
|
(Param.DataType = ftBlob)
|
|
or (Param.DataType = ftMemo)
|
|
{$IFDEF VER10P}
|
|
or (Param.DataType = ftWideMemo)
|
|
{$ENDIF};
|
|
end;
|
|
|
|
function TableNamesFromList(List: TStrings): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to List.Count - 1 do
|
|
if i = 0 then
|
|
Result := BracketIfNeed(List[i])
|
|
else
|
|
Result := Result + ', ' + BracketIfNeed(List[i]);
|
|
end;
|
|
|
|
procedure TableNamesToList(Value: string; List: TStrings);
|
|
var
|
|
St: string;
|
|
i: integer;
|
|
begin
|
|
Value := Trim(Value);
|
|
List.Clear;
|
|
|
|
St := '';
|
|
for i := 1 to Length(Value) do
|
|
if (Value[i] = ',') or (Value[i] = ';') then begin
|
|
St := UnbracketIfPossible(Trim(St));
|
|
if St <> '' then
|
|
List.Add(St);
|
|
St := '';
|
|
end
|
|
else
|
|
St := St + Value[i];
|
|
|
|
St := UnbracketIfPossible(Trim(St));
|
|
if St <> '' then
|
|
List.Add(St);
|
|
end;
|
|
|
|
function GetFieldType(DataType: word): TFieldType;
|
|
begin
|
|
case DataType of
|
|
dtInt64:
|
|
Result := ftLargeInt;
|
|
dtWord:
|
|
Result := ftWord;
|
|
dtBoolean:
|
|
Result := ftBoolean;
|
|
dtCurrency:
|
|
Result := ftCurrency;
|
|
dtBytes:
|
|
Result := ftBytes;
|
|
dtVarBytes:
|
|
Result := ftVarBytes;
|
|
dtMSXML:
|
|
Result := TFieldType(ftMSXML);
|
|
{$IFDEF VER5P}
|
|
{ dtVariant:
|
|
Result := ftVariant;}
|
|
{ dtIUnknown:
|
|
Result := ftInterface;}
|
|
{$ENDIF}
|
|
else
|
|
Result := MemDS.GetFieldType(DataType);
|
|
end;
|
|
end;
|
|
|
|
function GetDataType(FieldType: TFieldType): word;
|
|
begin
|
|
if Integer(FieldType) = ftMSXML then
|
|
Result := dtMSXML
|
|
else
|
|
Result := MemDS.GetDataType(FieldType);
|
|
end;
|
|
|
|
function SetWhere(SQL: string; Condition: string): string;
|
|
begin
|
|
Result := _SetWhere(SQL, Condition, TMSParser, True, lxSELECT, lxWHERE);
|
|
end;
|
|
|
|
function AddWhere(SQL: string; Condition: string): string;
|
|
begin
|
|
Result := _AddWhere(SQL, Condition, TMSParser, False, lxSELECT, lxWHERE);
|
|
end;
|
|
|
|
function DeleteWhere(SQL: string): string;
|
|
begin
|
|
Result := SetWhere(SQL, '');
|
|
end;
|
|
|
|
function GetWhere(SQL: string): string;
|
|
begin
|
|
Result := _GetWhere(SQL, TMSParser, False, lxSELECT, lxWHERE);
|
|
end;
|
|
|
|
function SetOrderBy(SQL: string; Fields: string): string;
|
|
begin
|
|
Result := _SetOrderBy(SQL, Fields, TMSParser, lxSELECT, lxORDER, lxBY);
|
|
end;
|
|
|
|
function GetOrderBy(SQL: string): string;
|
|
begin
|
|
Result := _GetOrderBy(SQL, TMSParser, lxSELECT, lxORDER, lxBY);
|
|
end;
|
|
|
|
procedure GetServerList(List: TStrings);
|
|
procedure GetServerListByReg;
|
|
var
|
|
Reg: TRegistry;
|
|
i: integer;
|
|
Value: string;
|
|
sl: tstringlist;
|
|
begin
|
|
Reg := TRegistry.Create;
|
|
sl := TStringList.Create;
|
|
try
|
|
Reg.RootKey := HKEY_Local_Machine;
|
|
if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\MSSQLServer\Client\ConnectTo') then begin
|
|
Reg.GetValueNames(sl);
|
|
|
|
// Delete non-server occurences
|
|
for i := sl.Count - 1 downto 0 do begin
|
|
Value := Reg.ReadString(sl[i]);
|
|
if Pos(',', Value) = 0 then
|
|
sl.Delete(i);
|
|
end;
|
|
|
|
sl.Sort;
|
|
List.AddStrings(sl);
|
|
end;
|
|
finally
|
|
Reg.Free;
|
|
sl.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure GetServerListByOleDBEnum;
|
|
var
|
|
SourcesRowset: ISourcesRowset;
|
|
Rowset: IRowset;
|
|
ds: TCustomMSDataset;
|
|
iu: IUnknown;
|
|
begin
|
|
if CoCreateInstance(CLSID_SQLOLEDB_ENUMERATOR,
|
|
nil,
|
|
CLSCTX_INPROC_SERVER,
|
|
IID_ISourcesRowset,
|
|
SourcesRowset) <> S_OK then
|
|
Exit;
|
|
|
|
if SourcesRowset.GetSourcesRowset(nil, IID_IRowset, 0, nil, iu) <> S_OK then
|
|
Exit;
|
|
|
|
Rowset := IRowset(iu);
|
|
ds := TCustomMSDataSet.Create(nil);
|
|
try
|
|
TDBAccessUtils.SetLockDebug(ds, True); // To prevent AV on TCustomDADataSet.OpenCursor -> UsedConnection.SQLMonitorClass
|
|
ds.FIRecordSet.SetIRowset(Rowset, False);
|
|
ds.Open;
|
|
|
|
while not ds.Eof do begin
|
|
List.Add(ds.Fields[0].AsString);
|
|
ds.Next;
|
|
end;
|
|
finally
|
|
ds.Free;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
List.Clear;
|
|
GetServerListByOleDBEnum;
|
|
GetServerListByReg;
|
|
end;
|
|
|
|
procedure GetDatabasesList(const Connection: TMSconnection; List: TStrings);
|
|
begin
|
|
if Connection = nil then
|
|
Exit;
|
|
|
|
Connection.GetDatabaseNames(List);
|
|
end;
|
|
|
|
procedure GetTablesList(const Connection: TMSconnection; List: TStrings);
|
|
begin
|
|
if Connection = nil then
|
|
Exit;
|
|
|
|
Connection.GetTableNames(List);
|
|
end;
|
|
|
|
{ TMSParam }
|
|
|
|
constructor TMSParam.Create(Collection: TCollection);
|
|
begin
|
|
inherited Create(Collection);
|
|
|
|
Bound := True;
|
|
end;
|
|
|
|
procedure TMSParam.SetAsString(Value: string);
|
|
begin
|
|
if not (DataType in [ftBytes, ftVarBytes]) then
|
|
inherited
|
|
else
|
|
Self.Value := Value;
|
|
end;
|
|
|
|
procedure TMSParam.SetAsWideString(Value: WideString);
|
|
begin
|
|
if not (DataType in [ftBytes, ftVarBytes]) then
|
|
inherited
|
|
else
|
|
Self.Value := Value;
|
|
end;
|
|
|
|
function TMSParam.GetSize: integer;
|
|
begin
|
|
if DataType in FieldTypesWithSize then begin
|
|
if inherited GetSize > 0 then
|
|
Result := inherited GetSize
|
|
else
|
|
if (DataType in [ftBytes, ftVarBytes]) and VarIsArray(Value) then
|
|
{$IFDEF CLR}
|
|
Result := VarArrayHighBound(Value, 1) - VarArrayLowBound(Value, 1) + 1
|
|
{$ELSE}
|
|
Result := TVarData(Value).VArray.Bounds[0].ElementCount
|
|
{$ENDIF}
|
|
else
|
|
Result := Length(GetAsString);
|
|
end
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TMSParam.SetSize(Value: integer);
|
|
begin
|
|
if DataType in FieldTypesWithSize then
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMSParam.SetAsVariant(const Value: Variant);
|
|
var
|
|
l, lold: integer;
|
|
begin
|
|
inherited;
|
|
if (DataType in FieldTypesWithSize) and not (VarIsNull(Value) or VarIsEmpty(Value)) then begin
|
|
lold := inherited GetSize;
|
|
if lold > 0 then begin
|
|
{$IFDEF CLR}
|
|
if VarType(Value) = varArray + varByte then
|
|
l := Length(TBytes(Value))
|
|
else
|
|
{$ENDIF}
|
|
l := Length(Value);
|
|
if l > lold then
|
|
inherited SetSize(l);
|
|
end;
|
|
end;
|
|
Bound := True;
|
|
end;
|
|
|
|
procedure TMSParam.CreateObject;
|
|
begin
|
|
Assert(FParamObject = nil);
|
|
if (DataType in [ftBlob, ftMemo{$IFDEF VER10P}, ftWideMemo{$ENDIF}]) or (DataType = TFieldType(ftMSXML)) then
|
|
{$IFDEF HAVE_COMPRESS}
|
|
FParamObject := TCompressedBlob.Create;
|
|
{$ELSE}
|
|
FParamObject := {$IFDEF CLR}CoreLab.Dac.MemData.{$ENDIF}TBlob.Create;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TMSParam.IsObjectDataType: boolean;
|
|
begin
|
|
Result := inherited IsObjectDataType;
|
|
end;
|
|
|
|
procedure TMSParam.AssignFieldValue(Field: TField; const Value: Variant);
|
|
var
|
|
FieldDesc: TOLEDBFieldDesc;
|
|
begin
|
|
inherited AssignFieldValue(Field, Value);
|
|
|
|
if IsClass(Field.DataSet, TCustomMSDataSet) then begin
|
|
FieldDesc := TOLEDBFieldDesc(TCustomDADataSet(Field.DataSet).GetFieldDesc(Field));
|
|
OLEDBType := FieldDesc.OLEDBType;
|
|
end;
|
|
end;
|
|
|
|
{ TMSParams }
|
|
|
|
constructor TMSParams.Create(Owner: TPersistent);
|
|
begin
|
|
inherited Create(TMSParam);
|
|
|
|
FOwner := Owner;
|
|
FNeedsUpdateItem := True;
|
|
end;
|
|
|
|
procedure TMSParams.Assign(Source: TPersistent);
|
|
var
|
|
i: integer;
|
|
begin
|
|
inherited;
|
|
|
|
if Source is TMSParams then
|
|
for i := 0 to Count - 1 do
|
|
TMSParams(Source)[i].Assign(Items[i]);
|
|
end;
|
|
|
|
function TMSParams.GetItem(Index: Integer): TMSParam;
|
|
begin
|
|
Result := inherited Items[Index] as TMSParam;
|
|
end;
|
|
|
|
procedure TMSParams.SetItem(Index: Integer; Value: TMSParam);
|
|
begin
|
|
inherited SetItem(Index, Value);
|
|
end;
|
|
|
|
function TMSParams.ParamByName(const Value: string): TMSParam;
|
|
begin
|
|
Result := TMSParam(inherited ParamByName(GetParamNameWODog(Value)));
|
|
end;
|
|
|
|
function TMSParams.FindParam(const Value: string): TMSParam;
|
|
begin
|
|
Result := TMSParam(inherited FindParam(GetParamNameWODog(Value)));
|
|
end;
|
|
|
|
{ TMSConnectionOptions }
|
|
|
|
procedure TMSConnectionOptions.AssignTo(Dest: TPersistent);
|
|
begin
|
|
inherited;
|
|
|
|
if Dest is TMSConnectionOptions then begin
|
|
TMSConnectionOptions(Dest).QuotedIdentifier := QuotedIdentifier;
|
|
TMSConnectionOptions(Dest).Language := Language;
|
|
TMSConnectionOptions(Dest).Encrypt := Encrypt;
|
|
TMSConnectionOptions(Dest).PersistSecurityInfo := PersistSecurityInfo;
|
|
TMSConnectionOptions(Dest).AutoTranslate := AutoTranslate;
|
|
TMSConnectionOptions(Dest).NetworkLibrary := NetworkLibrary;
|
|
TMSConnectionOptions(Dest).PacketSize := PacketSize;
|
|
TMSConnectionOptions(Dest).ApplicationName := ApplicationName;
|
|
TMSConnectionOptions(Dest).WorkstationID := WorkstationID;
|
|
TMSConnectionOptions(Dest).Provider := Provider;
|
|
TMSConnectionOptions(Dest).FailoverPartner := FailoverPartner;
|
|
end;
|
|
end;
|
|
|
|
constructor TMSConnectionOptions.Create(Owner: TMSConnection);
|
|
begin
|
|
inherited Create(Owner);
|
|
|
|
FQuotedIdentifier := True;
|
|
FPacketSize := DefaultPacketSize;
|
|
FAutoTranslate := True;
|
|
FProvider := prAuto;
|
|
//FMaxDatabaseSize := 128;
|
|
FFailoverPartner := '';
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetEncrypt(const Value: boolean);
|
|
begin
|
|
if FEncrypt <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FEncrypt := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prEncrypt, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetPersistSecurityInfo(const Value: boolean);
|
|
begin
|
|
if FPersistSecurityInfo <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FPersistSecurityInfo := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prPersistSecurityInfo, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetAutoTranslate(const Value: boolean);
|
|
begin
|
|
if FAutoTranslate <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FAutoTranslate := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prAutoTranslate, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetLanguage(const Value: string);
|
|
begin
|
|
if FLanguage <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FLanguage := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prLanguage, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetNetworkLibrary(
|
|
const Value: string);
|
|
begin
|
|
if FNetworkLibrary <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FNetworkLibrary := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prNetworkLibrary, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetApplicationName(
|
|
const Value: string);
|
|
begin
|
|
if FApplicationName <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FApplicationName := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prApplicationName, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetWorkstationID(
|
|
const Value: string);
|
|
begin
|
|
if FWorkstationID <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FWorkstationID := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prWorkstationID, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetPacketSize(const Value: integer);
|
|
begin
|
|
if FPacketSize <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FPacketSize := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prPacketSize, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetProvider(const Value: TOLEDBProvider);
|
|
begin
|
|
if FProvider <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FProvider := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prProvider, Integer(Value));
|
|
if (Value = prCompact) and (TMSConnection(FOwner).Database = DefaultSDACDatabase) then
|
|
TMSConnection(FOwner).Database := ''
|
|
else
|
|
if (Value <> prCompact) and (TMSConnection(FOwner).Database = '') then
|
|
TMSConnection(FOwner).Database := DefaultSDACDatabase;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetNumericType(Value: TDANumericType);
|
|
begin
|
|
if FNumericType <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FNumericType := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetQuotedIdentifier(const Value: boolean);
|
|
begin
|
|
if FQuotedIdentifier <> Value then begin
|
|
// CheckInactive is not need
|
|
|
|
FQuotedIdentifier := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prQuotedIdentifier, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetInitialFileName(const Value: string);
|
|
begin
|
|
if FInitialFileName <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FInitialFileName := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prInitialFileName, Value);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnectionOptions.SetMultipleActiveResultSets(const Value: boolean);
|
|
begin
|
|
if FMultipleActiveResultSets <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FMultipleActiveResultSets := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prMARS, Value);
|
|
end;
|
|
end;
|
|
|
|
(*procedure TMSConnectionOptions.SetMaxDatabaseFile(const Value: integer);
|
|
begin
|
|
if FMaxDatabaseSize <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FMaxDatabaseSize := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prMaxDatabaseSize, Value);
|
|
end;
|
|
end;*)
|
|
|
|
procedure TMSConnectionOptions.SetFailoverPartner(const Value: string);
|
|
begin
|
|
if FFailoverPartner <> Value then begin
|
|
TMSConnection(FOwner).CheckInactive;
|
|
FFailoverPartner := Value;
|
|
if TMSConnection(FOwner).IConnection <> nil then
|
|
TMSConnection(FOwner).IConnection.SetProp(prFailoverPartner, Value);
|
|
end;
|
|
end;
|
|
|
|
{ TMSConnection }
|
|
|
|
constructor TMSConnection.Create(Owner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
FLockLoginPrompt := False;
|
|
|
|
Database := DefaultSDACDatabase;
|
|
IsolationLevel := ilReadCommitted;
|
|
Authentication := auServer;
|
|
// MultipleConnections := True;
|
|
|
|
ConnectionTimeout := DefaultConnectionTimeout;
|
|
FOptions := inherited Options as TMSConnectionOptions;
|
|
end;
|
|
|
|
destructor TMSConnection.Destroy;
|
|
begin
|
|
FMSSQL.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TMSConnection.CreateOptions: TDAConnectionOptions;
|
|
begin
|
|
Result := TMSConnectionOptions.Create(Self);
|
|
end;
|
|
|
|
function TMSConnection.IConnection: TOLEDBConnection;
|
|
begin
|
|
Result := TOLEDBConnection(FIConnection);
|
|
end;
|
|
|
|
function TMSConnection.IsCaseSensitive: boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TMSConnection.Check(const Status: HRESULT; Sender: TObject);
|
|
begin
|
|
Assert(FIConnection <> nil);
|
|
TOLEDBConnection(FIConnection).Check(Status, Sender);
|
|
end;
|
|
|
|
procedure TMSConnection.CheckInactive;
|
|
begin
|
|
if Connected then
|
|
if ([csUpdating, csDesigning] * ComponentState) <> [] then
|
|
Close
|
|
else
|
|
DatabaseError(SConnectionOpen, Self);
|
|
end;
|
|
|
|
procedure TMSConnection.InternalStartTransaction;
|
|
begin
|
|
inherited;
|
|
|
|
if {Assigned(OnConnectionLost) and}
|
|
((TOLEDBCOnnection(FIConnection).DBMSPrimaryVer <= 8) or (TOLEDBCOnnection(FIConnection).ProviderPrimaryVer <= 8))and
|
|
not (Options.Provider = prCompact) then begin
|
|
FTransactionID := '';
|
|
ExecSQL(SCheckConnection, []);
|
|
end;
|
|
FTransactionID := 'Local';
|
|
end;
|
|
|
|
|
|
function TMSConnection.CommitOnDisconnect: boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TMSConnection.GetConnectString: string;
|
|
|
|
procedure AddParam(const ParamName: string; const Value: string; const DefValue: string);
|
|
begin
|
|
if Value <> DefValue then begin
|
|
if Result <> '' then
|
|
Result := Result + ';';
|
|
Result := Result + ParamName + '=' + Value;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := '';
|
|
|
|
/// list of supported parameters must be syncronized with SetConnectString (ProcessParam and set param to default)
|
|
if Options.FProvider <> prAuto then
|
|
AddParam('Provider', GetProviderName(Options.FProvider), '');
|
|
AddParam('User ID', UserName, '');
|
|
AddParam('Password', Password, '');
|
|
if Options.Provider <> prCompact then begin
|
|
AddParam('Data Source', Server, '');
|
|
AddParam('Initial Catalog', Database, DefaultSDACDatabase);
|
|
end
|
|
else
|
|
AddParam('Data Source', '"' + Database + '"', '');
|
|
AddParam('Connect Timeout', IntToStr(ConnectionTimeout), IntToStr(DefaultConnectionTimeout));
|
|
AddParam('Use Encryption for Data', BoolToStr(Options.Encrypt, True), 'False');
|
|
AddParam('Persist Security Info', BoolToStr(Options.PersistSecurityInfo, True), 'False');
|
|
AddParam('Auto Translate', BoolToStr(Options.AutoTranslate, True), 'True');
|
|
AddParam('Packet Size', IntToStr(Options.PacketSize), IntToStr(DefaultPacketSize));
|
|
AddParam('Application Name', Options.ApplicationName, '');
|
|
AddParam('Workstation ID', Options.WorkstationID, '');
|
|
AddParam('Current Language', Options.Language, '');
|
|
AddParam('Network Library', Options.NetworkLibrary, '');
|
|
if Options.InitialFileName <> '' then
|
|
AddParam('AttachDBFileName', Options.InitialFileName, '');
|
|
AddParam('MultipleActiveResultSets', BoolToStr(Options.MultipleActiveResultSets, True), 'False');
|
|
//AddParam('Max Database Size', IntToStr(Options.MaxDatabaseSize), '128');
|
|
if Options.FailoverPartner <> '' then
|
|
AddParam('Failover Partner', Options.FailoverPartner, '');
|
|
|
|
if Authentication = auWindows then
|
|
Result := Result + ';Integrated Security=SSPI';
|
|
|
|
{ if Password <> '' then
|
|
Result := Result + ';Persist Security Info=True';}
|
|
|
|
end;
|
|
|
|
procedure TMSConnection.SetConnectString(Value: string);
|
|
var
|
|
IntegratedSecuritySSPI: boolean;
|
|
|
|
procedure ParseIniString;
|
|
procedure ProcessParam(const paramName, paramValue: string);
|
|
function Recognized(const Args: array of string): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to Length(Args) - 1 do begin
|
|
Result := SameText(paramName, Args[i]);
|
|
if Result then
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
s: string;
|
|
|
|
begin
|
|
/// list of supported parameters must be syncronized with GetConnectString and dbxsda.ParseIniString
|
|
if Recognized(['Provider']) then begin
|
|
s := UpperCase(paramValue);
|
|
if (s <> SSQLOLEDB) and (s <> SSQLNativeClient) and (s <> SSQLEverywhere) then
|
|
raise Exception.CreateFmt(SBadParamValue, [paramName, paramValue]);
|
|
Options.Provider := GetProvider(s);
|
|
end
|
|
else
|
|
if Recognized(['User ID', 'UID', 'Username']) then
|
|
UserName := paramValue
|
|
else
|
|
if Recognized(['Password', 'PWD']) then
|
|
Password := paramValue
|
|
else
|
|
if Recognized(['Data Source', 'Server']) then begin
|
|
if Options.Provider <> prCompact then
|
|
Server := paramValue
|
|
else
|
|
Database := paramValue;
|
|
end
|
|
else
|
|
if Recognized(['Initial Catalog', 'Database']) then
|
|
Database := paramValue
|
|
else
|
|
if Recognized(['Connect Timeout', 'ConnectTimeout', 'Timeout']) then
|
|
ConnectionTimeout := StrToInt(paramValue)
|
|
else
|
|
if Recognized(['Use Encryption for Data', 'Encryption', 'Encrypt']) then
|
|
Options.Encrypt := {$IFDEF VER6}MemUtils.{$ENDIF}StrToBool(paramValue)
|
|
else
|
|
if Recognized(['PersistSecurityInfo', 'Persist Security Info']) then
|
|
Options.PersistSecurityInfo := {$IFDEF VER6}MemUtils.{$ENDIF}StrToBool(paramValue)
|
|
else
|
|
if Recognized(['AutoTranslate', 'Auto Translate']) then
|
|
Options.AutoTranslate := {$IFDEF VER6}MemUtils.{$ENDIF}StrToBool(paramValue)
|
|
else
|
|
if Recognized(['Packet Size', 'PacketSize']) then
|
|
Options.PacketSize := StrToInt(paramValue)
|
|
else
|
|
if Recognized(['Current Language', 'Language']) then
|
|
Options.Language := paramValue
|
|
else
|
|
if Recognized(['Network Library', 'Network', 'NetworkLibrary', 'NetLibrary']) then
|
|
Options.NetworkLibrary := paramValue
|
|
else
|
|
if Recognized(['ApplicationName', 'Application Name', 'AppName']) then
|
|
Options.ApplicationName := paramValue
|
|
else
|
|
if Recognized(['WorkstationID', 'Workstation ID', 'WSID']) then
|
|
Options.WorkstationID := paramValue
|
|
else
|
|
if Recognized(['Integrated Security', 'Trusted_Connection']) then begin
|
|
if paramValue = 'SSPI' then
|
|
IntegratedSecuritySSPI := True
|
|
else
|
|
if not TryStrToBool(paramValue, IntegratedSecuritySSPI) then
|
|
raise Exception.CreateFmt(SBadParamValue, [paramName, paramValue]);
|
|
end
|
|
else
|
|
if Recognized(['AttachDBFileName', 'InitialFileName', 'InitFileName']) then
|
|
Options.InitialFileName := paramValue
|
|
else
|
|
if Recognized(['MultipleActiveResultSets', 'Multiple Active Result Sets', 'MARS Connection', 'MARS']) then
|
|
Options.MultipleActiveResultSets := {$IFDEF VER6}MemUtils.{$ENDIF}StrToBool(paramValue)
|
|
else
|
|
//if Recognized(['Max Database Size']) then
|
|
// Options.MaxDatabaseSize := StrToInt(paramValue)
|
|
//else
|
|
if Recognized(['Failover Partner', 'Failover_Partner']) then
|
|
Options.FailoverPartner := paramValue
|
|
else
|
|
if Recognized([
|
|
'Persist Security Info',
|
|
'Use Procedure for Prepare',
|
|
'Asynchronous Connection',
|
|
'Client Failover',
|
|
'Tag with column collation when possible']) then
|
|
// ignored
|
|
else
|
|
raise Exception.CreateFmt(SParamNameUnknown, [paramName]);
|
|
end;
|
|
|
|
var
|
|
i, l: integer;
|
|
cs: string;
|
|
inString, inValue, allowSpaces: boolean;
|
|
newIndex, startIndex: integer;
|
|
paramName, paramValue: string;
|
|
csLength: integer;
|
|
|
|
begin
|
|
cs := Trim(Value);
|
|
|
|
// parse connection string
|
|
startIndex := 1;
|
|
paramName := '';
|
|
paramValue := '';
|
|
|
|
csLength := Length(cs);
|
|
|
|
while startIndex < csLength do begin
|
|
// look for param name
|
|
newIndex := PosEx('=', cs, startIndex);
|
|
if newIndex > 0 then begin
|
|
paramName := Trim(Copy(cs, startIndex, newIndex - startIndex));
|
|
if paramName = '' then
|
|
raise Exception.Create(SParamNameMissing);
|
|
end;
|
|
|
|
// look for param value
|
|
inString := False;
|
|
inValue := False; // Shows that we are parsing non-quoted value. Must be single word.
|
|
allowSpaces := True; // Brought in to avoid two-word non-quoted values.
|
|
|
|
for i := newIndex + 1 to csLength do begin
|
|
if cs[i] = '"' then
|
|
inString := not inString
|
|
else
|
|
if not inString then begin
|
|
if cs[i] = ';' then begin
|
|
paramValue := Trim(Copy(cs, newIndex + 1, i - newIndex - 1));
|
|
break;
|
|
end
|
|
else
|
|
if cs[i] <= ' ' then begin
|
|
if inValue then
|
|
// no more spaces are allowed
|
|
allowSpaces := False;
|
|
end
|
|
else
|
|
// check whether char is valid for non-quoted param value
|
|
case cs[i] of
|
|
'!'..'/', '\', '_', '@', '0'..'9', 'a'..'z', 'A'..'Z':
|
|
begin
|
|
inValue := True;
|
|
if not allowSpaces then
|
|
raise Exception.Create(SInvalidChar);
|
|
end
|
|
else
|
|
raise Exception.Create(SInvalidChar);
|
|
end;
|
|
end;
|
|
|
|
if i = csLength then
|
|
paramValue := Trim(Copy(cs, newIndex + 1, i - newIndex));
|
|
end;
|
|
|
|
if paramValue = '' then
|
|
raise Exception.Create(SParamValueMissing);
|
|
|
|
l := Length(paramValue);
|
|
if (l >= 2) and (paramValue[1] = '"') and (paramValue[l] = '"') then
|
|
paramValue := Trim(Copy(paramValue, 2, l - 2));
|
|
|
|
ProcessParam(paramName, paramValue);
|
|
|
|
startIndex := i + 1;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
OldCS: string;
|
|
|
|
begin
|
|
OldCS := ConnectString;
|
|
try
|
|
UserName := '';
|
|
Password := '';
|
|
Server := '';
|
|
Database := DefaultSDACDatabase;
|
|
// bug in editor - ConnectionTimeout is not returned;
|
|
// ConnectionTimeout := DefaultConnectionTimeout;
|
|
Options.Encrypt := False;
|
|
Options.PersistSecurityInfo := False;
|
|
Options.AutoTranslate := True;
|
|
Options.PacketSize := DefaultPacketSize;
|
|
Options.Language := '';
|
|
Options.NetworkLibrary := '';
|
|
Options.Provider := prAuto;
|
|
Options.InitialFileName := '';
|
|
Options.MultipleActiveResultSets := False;
|
|
Authentication := auServer;
|
|
//Options.MaxDatabaseSize := 128;
|
|
Options.FailoverPartner := '';
|
|
|
|
IntegratedSecuritySSPI := False;
|
|
ParseIniString;
|
|
|
|
if IntegratedSecuritySSPI then
|
|
Authentication := auWindows;
|
|
except
|
|
ConnectString := OldCS;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnection.CreateIConnection;
|
|
var
|
|
CRConnection: TCRConnection;
|
|
begin
|
|
if FIConnection <> nil then
|
|
Exit;
|
|
|
|
CRConnection := GetOLEDBConnection;
|
|
SetIConnection(CRConnection);
|
|
end;
|
|
|
|
procedure TMSConnection.SetIConnection(Value: TCRConnection);
|
|
begin
|
|
inherited;
|
|
|
|
FIConnection := Value as TOLEDBConnection;
|
|
|
|
Database := FDatabase; // To prevent empty value
|
|
if FIConnection <> nil then
|
|
TOLEDBConnection(FIConnection).OnInfoMessage := DoInfoMessage;
|
|
end;
|
|
|
|
function TMSConnection.GetIConnectionClass: TCRConnectionClass;
|
|
begin
|
|
Result := TOLEDBConnection;
|
|
end;
|
|
|
|
function TMSConnection.GetICommandClass: TCRCommandClass;
|
|
begin
|
|
Result := TOLEDBCommand;
|
|
end;
|
|
|
|
function TMSConnection.GetIRecordSetClass: TCRRecordSetClass;
|
|
begin
|
|
Result := TOLEDBRecordSet;
|
|
end;
|
|
|
|
procedure TMSConnection.SetOptions(Value: TMSConnectionOptions);
|
|
begin
|
|
FOptions.Assign(Value);
|
|
end;
|
|
|
|
function TMSConnection.GetOLEDBConnection: TOLEDBConnection;
|
|
var
|
|
ConnectionParameters: TMSConnectionParameters;
|
|
begin
|
|
if Pooling then begin
|
|
ConnectionParameters := TMSConnectionParameters.Create;
|
|
try
|
|
ConnectionParameters.MinPoolSize := PoolingOptions.MinPoolSize;
|
|
ConnectionParameters.MaxPoolSize := PoolingOptions.MaxPoolSize;
|
|
ConnectionParameters.ConnectionLifeTime := PoolingOptions.ConnectionLifetime;
|
|
ConnectionParameters.Validate := PoolingOptions.Validate;
|
|
ConnectionParameters.Username := Username;
|
|
ConnectionParameters.Server := Server;
|
|
ConnectionParameters.Password := Password;
|
|
|
|
ConnectionParameters.Database := Database;
|
|
ConnectionParameters.IsolationLevel := IsolationLevel;
|
|
ConnectionParameters.Authentication := Authentication;
|
|
|
|
ConnectionParameters.QuotedIdentifier := Options.QuotedIdentifier;
|
|
ConnectionParameters.Language := Options.Language;
|
|
ConnectionParameters.Encrypt := Options.Encrypt;
|
|
ConnectionParameters.PersistSecurityInfo := Options.PersistSecurityInfo;
|
|
ConnectionParameters.AutoTranslate := Options.AutoTranslate;
|
|
ConnectionParameters.NetworkLibrary := Options.NetworkLibrary;
|
|
ConnectionParameters.ApplicationName := Options.ApplicationName;
|
|
ConnectionParameters.WorkstationID := Options.WorkstationID;
|
|
ConnectionParameters.PacketSize := Options.PacketSize;
|
|
ConnectionParameters.Provider := Options.FProvider;
|
|
Result := TMSConnectionPoolManager.GetConnection(ConnectionParameters) as TOLEDBConnection;
|
|
finally
|
|
ConnectionParameters.Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Result := TOLEDBConnection.Create;
|
|
Result.SetProp(prDatabase, FDatabase);
|
|
Result.SetProp(prIsolationLevel, Integer(FIsolationLevel));
|
|
Result.SetProp(prAuthentication, Integer(FAuthentication));
|
|
Result.SetProp(prConnectionTimeout, FConnectionTimeout);
|
|
|
|
if FOptions <> nil then begin
|
|
Result.SetProp(prQuotedIdentifier, FOptions.FQuotedIdentifier);
|
|
Result.SetProp(prLanguage, FOptions.FLanguage);
|
|
Result.SetProp(prEncrypt, FOptions.FEncrypt);
|
|
Result.SetProp(prPersistSecurityInfo, FOptions.FPersistSecurityInfo);
|
|
Result.SetProp(prAutoTranslate, FOptions.FAutoTranslate);
|
|
Result.SetProp(prNetworkLibrary, FOptions.FNetworkLibrary);
|
|
Result.SetProp(prApplicationName, FOptions.FApplicationName);
|
|
Result.SetProp(prWorkstationID, FOptions.FWorkstationID);
|
|
Result.SetProp(prPacketSize, FOptions.FPacketSize);
|
|
Result.SetProp(prProvider, Integer(FOptions.FProvider));
|
|
Result.SetProp(prInitialFileName, FOptions.FInitialFileName);
|
|
Result.SetProp(prMARS, FOptions.FMultipleActiveResultSets);
|
|
//Result.SetProp(prMaxDatabaseSize, FOptions.FMaxDatabaseSize);
|
|
Result.SetProp(prFailoverPartner, FOptions.FFailoverPartner);
|
|
end;
|
|
|
|
// FIConnection.SetProp(prMultipleConnections, @FMultipleConnections);
|
|
end;
|
|
|
|
if FIConnection <> nil then
|
|
Result.Assign(FIConnection as TOLEDBConnection);
|
|
end;
|
|
|
|
procedure TMSConnection.AssignTo(Dest: TPersistent);
|
|
begin
|
|
inherited AssignTo(Dest);
|
|
|
|
if Dest is TMSConnection then begin
|
|
TMSConnection(Dest).Database := Database;
|
|
TMSConnection(Dest).IsolationLevel := IsolationLevel;
|
|
TMSConnection(Dest).Authentication := Authentication;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnection.SetDatabase(Value: string);
|
|
begin
|
|
if (Value <> Database) and (Options <> nil) and (Options.Provider = prCompact) then
|
|
Disconnect;
|
|
|
|
if Value = '' then
|
|
if (Options <> nil) and (Options.Provider = prCompact) then
|
|
Value := ''
|
|
else
|
|
Value := DefaultSDACDatabase;
|
|
|
|
if Value <> Database then begin
|
|
FDatabase := Value;
|
|
|
|
if (Options <> nil) and (Options.Provider = prCompact) and
|
|
(csDesigning in ComponentState) and (Value <> '') and (Value[1] = '.') and (CurrentProjectOutputDir <> '') then
|
|
Value := IncludeTrailingBackslash(CurrentProjectOutputDir) + Value;
|
|
|
|
if FIConnection <> nil then
|
|
FIConnection.SetProp(prDatabase, Value);
|
|
end;
|
|
end;
|
|
|
|
function TMSConnection.CreateDataSet: TCustomDADataSet;
|
|
begin
|
|
Result := TCustomMSDataSet.Create(nil);
|
|
TCustomMSDataSet(Result).SetDesigning(csDesigning in ComponentState);
|
|
Result.Connection := Self;
|
|
end;
|
|
|
|
function TMSConnection.CreateSQL: TCustomDASQL;
|
|
begin
|
|
Result := TMSSQL.Create(nil);
|
|
TMSSQL(Result).SetDesigning(csDesigning in ComponentState);
|
|
Result.Connection := Self;
|
|
end;
|
|
|
|
function TMSConnection.GetClientVersion: string;
|
|
begin
|
|
Connect;
|
|
Assert(FIConnection <> nil);
|
|
Result := IConnection.ProviderVer;
|
|
end;
|
|
|
|
function TMSConnection.GetServerVersion: string;
|
|
begin
|
|
Connect;
|
|
Assert(FIConnection <> nil);
|
|
Result := IConnection.DBMSVer;
|
|
end;
|
|
|
|
procedure TMSConnection.ChangePassword(NewPassword: string);
|
|
var
|
|
OldConnected: boolean;
|
|
OldPassword: string;
|
|
OldLoginPrompt: boolean;
|
|
begin
|
|
OldConnected := Connected;
|
|
OldPassword := Password;
|
|
OldLoginPrompt := LoginPrompt;
|
|
try
|
|
if not Connected then
|
|
CreateIConnection
|
|
else
|
|
Disconnect;
|
|
LoginPrompt := False;
|
|
Assert(FIConnection <> nil);
|
|
FIConnection.SetProp(prOldPassword, Password);
|
|
Password := NewPassword;
|
|
try
|
|
Connect;
|
|
except
|
|
Password := OldPassword;
|
|
raise;
|
|
end;
|
|
finally
|
|
Assert(FIConnection <> nil);
|
|
FIConnection.SetProp(prOldPassword, '');
|
|
LoginPrompt := OldLoginPrompt;
|
|
if not OldConnected then
|
|
Disconnect;
|
|
end;
|
|
end;
|
|
|
|
function TMSConnection.ExecSQL(Text: string; const Params: array of variant): variant;
|
|
var
|
|
i: integer;
|
|
Param: TParam;
|
|
begin
|
|
if FMSSQL = nil then
|
|
FMSSQL := CreateSQL as TMSSQL;
|
|
|
|
FMSSQL.SQL.Text := ''; // drop params from previous sql
|
|
FMSSQL.SQL.Text := Text;
|
|
|
|
for i := 0 to FMSSQL.ParamCount - 1 do
|
|
if i <= High(Params) then
|
|
FMSSQL.Params[i].Value := Params[i]
|
|
else
|
|
FMSSQL.Params[i].Value := Null;
|
|
|
|
Param := FMSSQL.FindParam('Result');
|
|
if Param <> nil then
|
|
if Param.DataType = ftUnknown then
|
|
Param.DataType := ftInteger;
|
|
|
|
FMSSQL.Execute;
|
|
|
|
if Param <> nil then
|
|
Result := Param.Value
|
|
else
|
|
Result := Null;
|
|
end;
|
|
|
|
procedure TMSConnection.GetTableNames(List: TStrings);
|
|
var
|
|
MDDS: TMSMetadata;
|
|
|
|
procedure AddNamesToList;
|
|
var
|
|
NameFld: TStringField;
|
|
SchemaFld: TStringField;
|
|
begin
|
|
MDDS.Open;
|
|
|
|
NameFld := MDDS.FieldByName('TABLE_NAME') as TStringField;
|
|
SchemaFld := nil;
|
|
if Options.Provider <> prCompact then
|
|
SchemaFld := MDDS.FieldByName('TABLE_SCHEMA') as TStringField;
|
|
while not MDDS.Eof do begin
|
|
if (SchemaFld <> nil) and (SchemaFld.Value <> '') then
|
|
List.Add(SchemaFld.Value + '.' + NameFld.Value)
|
|
else
|
|
List.Add(NameFld.Value);
|
|
MDDS.Next;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
List.Clear;
|
|
MDDS := nil;
|
|
try
|
|
MDDS := TMSMetadata.Create(nil);
|
|
MDDS.Connection := Self;
|
|
MDDS.DatabaseName := MDDS.Connection.Database;
|
|
|
|
MDDS.ObjectType := otTables;
|
|
AddNamesToList;
|
|
|
|
if Options.Provider <> prCompact then begin
|
|
MDDS.ObjectType := otViews;
|
|
AddNamesToList;
|
|
end;
|
|
|
|
if List is TStringList then
|
|
TStringList(List).Sort;
|
|
finally
|
|
MDDS.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnection.GetDatabaseNames(List: TStrings);
|
|
var
|
|
MDDS: TMSMetadata;
|
|
NameFld: TStringField;
|
|
begin
|
|
List.Clear;
|
|
|
|
if Options.Provider = prCompact then
|
|
Exit;
|
|
|
|
MDDS := nil;
|
|
try
|
|
MDDS := TMSMetadata.Create(nil);
|
|
MDDS.Connection := Self;
|
|
MDDS.ObjectType := otDatabases;
|
|
|
|
try
|
|
MDDS.Open;
|
|
except
|
|
on E: EMSError do begin
|
|
if E.ErrorCode = 4060 then
|
|
Database := '';
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
NameFld := MDDS.FieldByName('CATALOG_NAME') as TStringField;
|
|
while not MDDS.Eof do begin
|
|
List.Add(NameFld.Value);
|
|
MDDS.Next
|
|
end;
|
|
|
|
if List is TStringList then
|
|
TStringList(List).Sort;
|
|
finally
|
|
MDDS.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnection.GetStoredProcNames(List: TStrings);
|
|
var
|
|
MDDS: TMSMetadata;
|
|
NameFld: TStringField;
|
|
begin
|
|
List.Clear;
|
|
|
|
if Options.Provider = prCompact then
|
|
Exit;
|
|
|
|
MDDS := nil;
|
|
try
|
|
MDDS := TMSMetadata.Create(nil);
|
|
MDDS.Connection := Self;
|
|
MDDS.ObjectType := otStoredProcs;
|
|
|
|
try
|
|
MDDS.Open;
|
|
except
|
|
on E: EMSError do begin
|
|
if E.ErrorCode = 4060 then
|
|
Database := '';
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
NameFld := MDDS.FieldByName('PROCEDURE_NAME') as TStringField;
|
|
while not MDDS.Eof do begin
|
|
List.Add(NameFld.Value);
|
|
MDDS.Next
|
|
end;
|
|
|
|
if List is TStringList then
|
|
TStringList(List).Sort;
|
|
finally
|
|
MDDS.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnection.GetStoredProcNames(List: TStrings; System: boolean);
|
|
var
|
|
Query: TMSQuery;
|
|
NameFld: TStringField;
|
|
begin
|
|
if System then
|
|
GetStoredProcNames(List)
|
|
else
|
|
begin
|
|
List.Clear;
|
|
|
|
if Options.Provider = prCompact then
|
|
Exit;
|
|
|
|
Query := TMSQuery.Create(nil);
|
|
try
|
|
Query.Connection := Self;
|
|
Query.SQL.Clear;
|
|
Query.SQL.Add('SELECT name FROM sysobjects');
|
|
Query.SQL.Add('WHERE OBJECTPROPERTY(id, N''IsProcedure'') = 1 or OBJECTPROPERTY(id, N''IsExtendedProc'') = 1');
|
|
Query.SQL.Add('ORDER BY name');
|
|
try
|
|
Query.Open;
|
|
except
|
|
on E: EMSError do begin
|
|
if E.ErrorCode = 4060 then
|
|
Database := '';
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
NameFld := Query.FieldByName('name') as TStringField;
|
|
while not Query.Eof do begin
|
|
List.Add(NameFld.Value);
|
|
Query.Next;
|
|
end;
|
|
finally
|
|
Query.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TMSConnection.SQLMonitorClass: TClass;
|
|
begin
|
|
Result := TMSSQLMonitor;
|
|
end;
|
|
|
|
function TMSConnection.ConnectDialogClass: TConnectDialogClass;
|
|
begin
|
|
if Assigned(DefConnectDialogClassProc) then
|
|
Result := TConnectDialogClass(DefConnectDialogClassProc)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TMSConnection.SetIsolationLevel(const Value: TIsolationLevel);
|
|
begin
|
|
if FIsolationLevel <> Value then begin
|
|
FIsolationLevel := Value;
|
|
if FIConnection <> nil then
|
|
FIConnection.SetProp(prIsolationLevel, Integer(Value));
|
|
end;
|
|
end;
|
|
{
|
|
procedure TMSConnection.SetMultipleConnections(const Value: boolean);
|
|
begin
|
|
if FMultipleConnections <> Value then begin
|
|
FMultipleConnections := Value;
|
|
Assert(TOLEDBConnection(FIConnection) <> nil);
|
|
FIConnection.SetProp(prMultipleConnections, @Value);
|
|
end;
|
|
end;}
|
|
|
|
procedure TMSConnection.SetAuthentication(const Value: TMSAuthentication);
|
|
begin
|
|
if FAuthentication <> Value then begin
|
|
Disconnect;
|
|
FAuthentication := Value;
|
|
if FIConnection <> nil then
|
|
FIConnection.SetProp(prAuthentication, Integer(Value));
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnection.SetConnectionTimeout(const Value: integer);
|
|
begin
|
|
if FConnectionTimeout <> Value then begin
|
|
FConnectionTimeout := Value;
|
|
if FIConnection <> nil then
|
|
FIConnection.SetProp(prConnectionTimeout, Value);
|
|
end;
|
|
end;
|
|
|
|
function TMSConnection.NeedPrompt: boolean;
|
|
begin
|
|
Result := False;
|
|
if Authentication = auWindows then
|
|
Exit;
|
|
|
|
if Options.Provider = prCompact then
|
|
Exit;
|
|
|
|
Result := not FLockLoginPrompt and
|
|
(LoginPrompt or (csDesigning in ComponentState) and
|
|
((Username = '') and (Password = ''))) and
|
|
not ((csDesigning in ComponentState) and ((csReading in ComponentState) or FStreamedConnected))
|
|
end;
|
|
|
|
function TMSConnection.IsFatalError(E: EDAError): boolean;
|
|
begin
|
|
if E is EMSError then
|
|
with EMSError(E) do begin
|
|
Result := SeverityClass >= 20; {fatal error}
|
|
if not Result then
|
|
Result :=
|
|
((SeverityClass = 16) and (State = 1) and (MSSQLErrorCode <= NE_MAX_NETERROR)) // Network Library
|
|
or
|
|
((SeverityClass = 10) and (State = 1) and (MSSQLErrorCode = WSAECONNRESET)) // Win sockets
|
|
or
|
|
((SeverityClass = 16) and (State = 1) and (MSSQLErrorCode = WSAECONNRESET)) // Win sockets
|
|
or
|
|
((SeverityClass = 16) and (State = 1) and (MSSQLErrorCode = ERROR_PIPE_NOT_CONNECTED)) // Named pipes
|
|
or
|
|
((SeverityClass = 16) and (State = 1) and (MSSQLErrorCode = ERROR_NETNAME_DELETED)); // Named pipes
|
|
end
|
|
else
|
|
Result := inherited IsFatalError(E);
|
|
end;
|
|
|
|
procedure TMSConnection.DoError(E: Exception; var Fail, Reconnect, Reexecute: boolean;
|
|
ReconnectAttempt: integer; var ConnLostCause: TConnLostCause);
|
|
var
|
|
i: integer;
|
|
begin
|
|
inherited;
|
|
|
|
if Reconnect then
|
|
for i := 0 to DataSetCount - 1 do begin // Check underfetched data
|
|
Assert(DataSets[i] is TCustomMSDataSet);
|
|
if TCustomMSDataSet(DataSets[i]).FIRecordSet.GetIRowset <> nil then begin
|
|
Reconnect := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSConnection.DoInfoMessage(E: EMSError);
|
|
begin
|
|
TMSSQLMonitorClass(SQLMonitorClass).InfoMessage(Self, E.Message);
|
|
|
|
if Assigned(FOnInfoMessage) then
|
|
FOnInfoMessage(Self, E);
|
|
end;
|
|
|
|
function TMSConnection.IsKeyViolation(E: EDAError): boolean;
|
|
begin
|
|
if E is EMSError then
|
|
Result := (E.ErrorCode = 2627{Violation of %ls constraint '%.*ls'. Cannot insert duplicate key in object '%.*ls'.})
|
|
else
|
|
Result := inherited IsKeyViolation(E);
|
|
end;
|
|
|
|
{TMSDataSetOptions}
|
|
|
|
constructor TMSDataSetOptions.Create(Owner: TCustomDADataSet);
|
|
begin
|
|
inherited Create(Owner);
|
|
|
|
LongStrings := True;
|
|
RequiredFields := False;
|
|
EnableBCD := False;
|
|
UniqueRecords := False;
|
|
CursorUpdate := True;
|
|
QueryIdentity := True;
|
|
CheckRowVersion := False;
|
|
FullRefresh := False;
|
|
DMLRefresh := False;
|
|
FAutoRefresh := False;
|
|
FAutoRefreshInterval := 60;
|
|
FSmartRefresh := False;
|
|
FDefaultValues := False;
|
|
FNonBlocking := False;
|
|
end;
|
|
|
|
procedure TMSDataSetOptions.SetEnableBCD(Value: boolean);
|
|
begin
|
|
if FEnableBCD <> Value then begin
|
|
TCustomMSDataSet(FOwner).CheckInactive;
|
|
FEnableBCD := Value;
|
|
TCustomMSDataSet(FOwner).SetNumericType;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSDataSetOptions.SetUniqueRecords(Value: boolean);
|
|
begin
|
|
if FUniqueRecords <> Value then begin
|
|
TCustomMSDataSet(FOwner).CheckInactive;
|
|
TCustomMSDataSet(FOwner).FieldDefs.Updated := False;
|
|
FUniqueRecords := Value;
|
|
TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prUniqueRecords, FUniqueRecords);
|
|
TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prRequestSQLObjects, FUniqueRecords or not FOwner.ReadOnly);
|
|
FOwner.FieldDefs.Updated := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSDataSetOptions.SetCursorUpdate(Value: boolean);
|
|
begin
|
|
if FCursorUpdate <> Value then begin
|
|
TCustomMSDataSet(FOwner).CheckInactive;
|
|
TCustomMSDataSet(FOwner).FieldDefs.Updated := False;
|
|
FCursorUpdate := Value;
|
|
TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prCursorUpdate, FCursorUpdate);
|
|
end;
|
|
end;
|
|
|
|
function TMSDataSetOptions.GetAllFieldsEditable: boolean;
|
|
begin
|
|
Result := not SetFieldsReadOnly;
|
|
end;
|
|
|
|
procedure TMSDataSetOptions.SetAllFieldsEditable(const Value: boolean);
|
|
begin
|
|
SetFieldsReadOnly := not Value;
|
|
end;
|
|
|
|
procedure TMSDataSetOptions.SetAutoRefresh(Value: boolean);
|
|
begin
|
|
if FAutoRefresh <> Value then begin
|
|
FAutoRefresh := Value;
|
|
if not (csDesigning in FOwner.ComponentState) then
|
|
TCustomMSDataSet(FOwner).FAutoRefreshTimer.Enabled := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSDataSetOptions.SetAutoRefreshInterval(Value: integer);
|
|
begin
|
|
if FAutoRefreshInterval <> Value then begin
|
|
FAutoRefreshInterval := Value;
|
|
TCustomMSDataSet(FOwner).FAutoRefreshTimer.Interval := Value * MSecsPerSec;
|
|
end;
|
|
end;
|
|
|
|
(*procedure TMSDataSetOptions.SetSmartRefresh(Value: boolean);
|
|
begin
|
|
if FSmartRefresh <> Value then begin
|
|
TCustomMSDataSet(FOwner).CheckInactive;
|
|
|
|
FSmartRefresh := Value;
|
|
|
|
TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prSmartRefresh, FSmartRefresh);
|
|
if FSmartRefresh then
|
|
TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prSmartRefreshMsg, GetComponentName(FOwner));
|
|
end;
|
|
end;*)
|
|
|
|
procedure TMSDataSetOptions.SetNonBlocking(Value: boolean);
|
|
begin
|
|
if FNonBlocking <> Value then begin
|
|
TCustomMSDataSet(FOwner).CheckInactive;
|
|
FNonBlocking := Value;
|
|
TCustomMSDataSet(FOwner).FIRecordSet.SetProp(prNonBlocking, FNonBlocking);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSDataSetOptions.AssignTo(Dest: TPersistent);
|
|
begin
|
|
inherited;
|
|
|
|
if Dest is TMSDataSetOptions then begin
|
|
TMSDataSetOptions(Dest).LongStrings := LongStrings;
|
|
TMSDataSetOptions(Dest).EnableBCD := EnableBCD;
|
|
TMSDataSetOptions(Dest).UniqueRecords := UniqueRecords;
|
|
TMSDataSetOptions(Dest).AllFieldsEditable := AllFieldsEditable;
|
|
TMSDataSetOptions(Dest).CursorUpdate := CursorUpdate;
|
|
TMSDataSetOptions(Dest).FullRefresh := FullRefresh;
|
|
TMSDataSetOptions(Dest).DMLRefresh := DMLRefresh;
|
|
TMSDataSetOptions(Dest).AutoRefresh := AutoRefresh;
|
|
TMSDataSetOptions(Dest).AutoRefreshInterval := AutoRefreshInterval;
|
|
//TMSDataSetOptions(Dest).SmartRefresh := SmartRefresh;
|
|
end;
|
|
end;
|
|
|
|
{ TMSSQLGenerator }
|
|
|
|
function TMSSQLGenerator.GetActualFieldNameEx(FieldDesc: TCRFieldDesc; TableInfo: TCRTableInfo): string;
|
|
var
|
|
p: integer;
|
|
begin
|
|
Result := TOLEDBFieldDesc(FieldDesc).BaseColumnName;
|
|
if (FieldDesc.TableInfo = TableInfo) or (FieldDesc.TableInfo.TableName = TableInfo.TableName) then begin
|
|
p := Pos('.', Result);
|
|
if p <> 0 then
|
|
Result := Copy(Result, p + 1, MaxInt);{Delete table name from fieldname}
|
|
end;
|
|
end;
|
|
|
|
function TMSSQLGenerator.AssembleSB(const StatementType: TStatementType): string;
|
|
begin
|
|
if TCustomMSDataSet(FOwner).Options.DMLRefresh and (StatementType = stInsert) then
|
|
Result :=
|
|
FHeaderSB.ToString +
|
|
FFldSB.ToString +
|
|
FMiddleSB.ToString +
|
|
FFldParamSB.ToString +
|
|
FFooterSB.ToString +
|
|
FCondSB.ToString
|
|
else
|
|
Result := inherited AssembleSB(StatementType);
|
|
end;
|
|
|
|
procedure TMSSQLGenerator.GenerateInsertSQL(
|
|
const KeyAndDataFields: TKeyAndDataFields;
|
|
const ModifiedFieldsOnly: boolean;
|
|
const Index: integer = -1);
|
|
var
|
|
Field, IdentityField: TField;
|
|
FieldDesc: TCRFieldDesc;
|
|
i: integer;
|
|
ActualName: string;
|
|
AIConnection: TOLEDBConnection;
|
|
IsFirstParam: boolean;
|
|
begin
|
|
inherited;
|
|
|
|
if FFldSB.Length = 0 then begin
|
|
AIConnection := TMSAccessUtils.FIConnection(TMSConnection(FOwner.Connection));
|
|
if (AIConnection <> nil) and (AIConnection.ProviderPrimaryVer <> 3) then begin
|
|
Clear;
|
|
FHeaderSB.Append('INSERT INTO ');
|
|
FHeaderSB.Append(FTableInfo.NormalizeName(FTableInfo.TableNameFull, FOwner.Options.QuoteNames));
|
|
FHeaderSB.Append(' DEFAULT VALUES');
|
|
end
|
|
else begin
|
|
for i := 0 to High(KeyAndDataFields.DataFieldDescs) do begin
|
|
FieldDesc := KeyAndDataFields.DataFieldDescs[i];
|
|
Field := FOwner.GetField(FieldDesc);
|
|
Assert(Field <> nil);
|
|
if not Field.ReadOnly then begin
|
|
ActualName := GetActualFieldName(FieldDesc, False);
|
|
|
|
if FFldSB.Length > 0 then begin
|
|
FFldSB.Append(', ');
|
|
FFldParamSB.Append(', ');
|
|
end;
|
|
FFldSB.Append(ActualName);
|
|
FFldParamSB.Append('DEFAULT');
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if TCustomMSDataSet(FOwner).CursorType = ctDefaultResultSet then begin
|
|
{ Getting Identity value }
|
|
if TCustomMSDataSet(FOwner).Options.QueryIdentity and (TOLEDBConnection(TCustomMSDataSet(FOwner).Connection.IConnection).DBMSPrimaryVer <> 3) then begin
|
|
IdentityField := TDBAccessUtils.GetIdentityField(FOwner);
|
|
if IdentityField <> nil then begin
|
|
// Warning - Identity param must be last in param list, see SetIdentityParam
|
|
// Warning - If in 'INSERT ...' statement present sql_variant value then adding 'SET ...' fails statement
|
|
// Warning - TOLEDBFieldDesc(GetFieldDescByField(FIdentityField)).BaseColumnName cannot be used (for example see gettting identity on INSERT into View)
|
|
|
|
FFooterSB.Append(#$D#$A'SET ');
|
|
TCustomMSDataSet(FOwner).FUseParamType := True;
|
|
AddParam(FFooterSB, FOwner.GetFieldDesc(IdentityField), stInsert, ptInputOutput);
|
|
|
|
if TOLEDBConnection(TCustomMSDataSet(FOwner).Connection.IConnection).DBMSPrimaryVer > 7 then
|
|
FFooterSB.Append(' = SCOPE_IDENTITY()')
|
|
else
|
|
FFooterSB.Append(' = @@Identity');
|
|
end;
|
|
end;
|
|
|
|
{ DMLRefresh }
|
|
if TCustomMSDataSet(FOwner).Options.DMLRefresh then begin
|
|
IsFirstParam := True;
|
|
for i := 0 to High(KeyAndDataFields.DataFieldDescs) do begin
|
|
FieldDesc := KeyAndDataFields.DataFieldDescs[i];
|
|
Field := FOwner.GetField(FieldDesc);
|
|
Assert(Field <> nil);
|
|
if not Field.ReadOnly then begin
|
|
if not IsFirstParam then
|
|
FFooterSB.Append(', ')
|
|
else
|
|
FFooterSB.Append(LineSeparator + 'SELECT ');
|
|
IsFirstParam := False;
|
|
TCustomMSDataSet(FOwner).FUseParamType := True;
|
|
AddParam(FFooterSB, FieldDesc, stRefresh, ptInputOutput);
|
|
FFooterSB.Append(' = ' + QuoteName(TOLEDBFieldDesc(FieldDesc).BaseColumnName));
|
|
end;
|
|
end;
|
|
if not IsFirstParam then begin
|
|
FFooterSB.Append(' FROM ' + FTableInfo.NormalizeName(FTableInfo.TableNameFull, FOwner.Options.QuoteNames) +
|
|
LineSeparator + 'WHERE' + LineSeparator + ' ');
|
|
GenerateConditions(FCondSB, stInsert, ModifiedFieldsOnly, KeyAndDataFields);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSSQLGenerator.GenerateUpdateSQL(
|
|
const KeyAndDataFields: TKeyAndDataFields;
|
|
const ModifiedFieldsOnly: boolean;
|
|
const Index: integer = -1);
|
|
var
|
|
Field: TField;
|
|
FieldDesc: TCRFieldDesc;
|
|
i: integer;
|
|
IsFirstParam: boolean;
|
|
OldCondSB: StringBuilder;
|
|
begin
|
|
inherited;
|
|
|
|
if TCustomMSDataSet(FOwner).CursorType = ctDefaultResultSet then begin
|
|
{ DMLRefresh }
|
|
if (FFldSB.Length > 0) and TCustomMSDataSet(FOwner).Options.DMLRefresh then begin
|
|
FFooterSB.Append(LineSeparator);
|
|
FFooterSB.Append('SELECT ');
|
|
IsFirstParam := True;
|
|
for i := 0 to High(KeyAndDataFields.DataFieldDescs) do begin
|
|
FieldDesc := KeyAndDataFields.DataFieldDescs[i];
|
|
Field := FOwner.GetField(FieldDesc);
|
|
if not Field.ReadOnly then begin
|
|
if not IsFirstParam then
|
|
FFooterSB.Append(', ');
|
|
IsFirstParam := False;
|
|
TCustomMSDataSet(FOwner).FUseParamType := True;
|
|
AddParam(FFooterSB, FieldDesc, stRefresh, ptInputOutput);
|
|
FFooterSB.Append(' = ' + QuoteName(TOLEDBFieldDesc(FieldDesc).BaseColumnName));
|
|
end;
|
|
end;
|
|
FFooterSB.Append(' FROM ');
|
|
FFooterSB.Append(FTableInfo.NormalizeName(FTableInfo.TableNameFull, FOwner.Options.QuoteNames));
|
|
FFooterSB.Append(LineSeparator);
|
|
FFooterSB.Append('WHERE');
|
|
FFooterSB.Append(LineSeparator);
|
|
FFooterSB.Append(' ');
|
|
OldCondSB := FCondSB;
|
|
try
|
|
FCondSB := StringBuilder.Create;
|
|
try
|
|
GenerateConditions(FCondSB, stUpdate, ModifiedFieldsOnly, KeyAndDataFields);
|
|
FFooterSB.Append(FCondSB.ToString);
|
|
finally
|
|
FCondSB.Free;
|
|
end;
|
|
finally
|
|
FCondSB := OldCondSB;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSSQLGenerator.GenerateRefreshSQLSelectPart(const KeyAndDataFields: TKeyAndDataFields);
|
|
var
|
|
Field: TField;
|
|
FieldDesc: TOLEDBFieldDesc;
|
|
TableName: string;
|
|
UseDataFields: boolean;
|
|
FieldArrHigh: integer;
|
|
begin
|
|
inherited;
|
|
|
|
if TCustomMSDataSet(FOwner).FTimestampField <> nil then begin
|
|
UseDataFields := Length(KeyAndDataFields.DataFieldDescs) + Length(KeyAndDataFields.DataFieldDescs) > 0;
|
|
if UseDataFields then
|
|
FieldArrHigh := Length(KeyAndDataFields.DataFieldDescs) + Length(KeyAndDataFields.DataFieldDescs) - 1
|
|
else
|
|
FieldArrHigh := High(KeyAndDataFields.KeyFieldDescs);
|
|
|
|
if FieldArrHigh >= 0 then
|
|
FFldSB.Append(', ');
|
|
Field := TCustomMSDataSet(FOwner).FTimestampField;
|
|
FieldDesc := TOLEDBFieldDesc(FOwner.GetFieldDesc(Field));
|
|
TableName := GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, TCustomMSDataSet(FOwner).Connection.Database);
|
|
if TableName = '' then
|
|
FFldSB.Append(QuoteName(FieldDesc.ActualName))
|
|
else
|
|
if FieldDesc.TableInfo.TableAlias <> '' then
|
|
FFldSB.Append(FieldDesc.TableInfo.NormalizeName(FieldDesc.TableInfo.TableAlias, FOwner.Options.QuoteNames) +
|
|
'.' + QuoteName(FieldDesc.BaseColumnName))
|
|
else
|
|
FFldSB.Append(FieldDesc.TableInfo.NormalizeName(FieldDesc.TableInfo.TableName, FOwner.Options.QuoteNames) +
|
|
'.' + QuoteName(FieldDesc.BaseColumnName));
|
|
|
|
if not (csDesigning in FOwner.ComponentState) then
|
|
FFldSB.Append(' AS ' + GenerateIndexName(IntToStr(TCustomMSDataSet(FOwner).FIRecordSet.Fields.IndexOf(FieldDesc))));
|
|
end;
|
|
end;
|
|
|
|
procedure TMSSQLGenerator.GenerateRefreshSQL(
|
|
const KeyAndDataFields: TKeyAndDataFields;
|
|
const ModifiedFieldsOnly: boolean);
|
|
|
|
procedure GenerateSPFullRefreshSQL;
|
|
var
|
|
i: integer;
|
|
Field: TField;
|
|
FieldDesc: TOLEDBFieldDesc;
|
|
TableName: string;
|
|
TblNames: TStringList;
|
|
begin
|
|
TblNames := TStringList.Create;
|
|
try
|
|
// SELECT ... FROM ... WHERE ... {WITH NOLOCK}
|
|
// Add SELECT section
|
|
FHeaderSB.Append('SELECT ');
|
|
for i := 0 to FOwner.Fields.Count - 1 do begin
|
|
Field := FOwner.Fields[i];
|
|
if Field.FieldKind = fkData then begin
|
|
FieldDesc := TOLEDBFieldDesc(FOwner.GetFieldDesc(Field));
|
|
|
|
TableName := GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, TCustomMSDataSet(FOwner).Connection.Database);
|
|
if TblNames.IndexOf(TableName) = - 1 then
|
|
TblNames.Add(TableName);
|
|
|
|
FHeaderSB.Append(TableName + '.' + FieldDesc.Name);
|
|
if not (csDesigning in FOwner.ComponentState) then
|
|
FHeaderSB.Append(' AS _' + IntToStr(TCustomMSDataSet(FOwner).FIRecordSet.Fields.IndexOf(FieldDesc)));
|
|
FHeaderSB.Append(', ');
|
|
end;
|
|
end;
|
|
FHeaderSB.Length := FHeaderSB.Length - 2;
|
|
|
|
// Add FROM section
|
|
FHeaderSB.Append(' FROM ');
|
|
for i := 0 to TblNames.Count - 1 do
|
|
FHeaderSB.Append(QuoteName(TblNames[i]) + ', '); // Table name without aliases
|
|
FHeaderSB.Length := FHeaderSB.Length - 2;
|
|
|
|
// Add WHERE section
|
|
GenerateConditions(FCondSB, stRefresh, ModifiedFieldsOnly, (*False {Refresh does not need to testing changes applied by other users},*) KeyAndDataFields);
|
|
if FCondSB.Length > 0 then
|
|
FMiddleSB.Append(' WHERE ');
|
|
finally
|
|
TblNames.Free;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if (FOwner is TCustomMSStoredProc) and TCustomMSDataSet(FOwner).Options.FullRefresh then
|
|
GenerateSPFullRefreshSQL
|
|
else
|
|
if TCustomMSDataSet(FOwner).Options.FullRefresh or (FOwner.ReadOnly and not TCustomMSDataSet(FOwner).Options.UniqueRecords) then begin
|
|
GenerateConditions(FCondSB, stRefresh, ModifiedFieldsOnly, KeyAndDataFields);
|
|
if FCondSB.Length = 0 then
|
|
FHeaderSB.Append(FOwner.SQL.Text)
|
|
else begin
|
|
FHeaderSB.Append(AddWhere(FOwner.SQL.Text, FCondSB.ToString));
|
|
FCondSB.Length := 0; // WHERE clause already added to FHeaderSB
|
|
end;
|
|
end
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
function TMSSQLGenerator.GetActualFieldName(FldDesc: TCRFieldDesc; IsRefresh: boolean): string;
|
|
var
|
|
TablesInfo: TCRTablesInfo;
|
|
TableInfo: TCRTableInfo;
|
|
IsView: boolean;
|
|
UpdatingTableIdx: integer;
|
|
begin
|
|
if not (((FldDesc.TableInfo <> nil) and (FldDesc.TableInfo.IsView)) or IsRefresh) then begin
|
|
Result := TOLEDBFieldDesc(FldDesc).BaseColumnName;
|
|
if Result = '' then
|
|
Result := FldDesc.ActualName;
|
|
Result := QuoteName(Result);
|
|
Exit;
|
|
end;
|
|
|
|
IsView := False;
|
|
UpdatingTableIdx := TDBAccessUtils.GetUpdatingTableIdx(FOwner);
|
|
TablesInfo := TDBAccessUtils.GetTablesInfo(FOwner);
|
|
if (UpdatingTableIdx >= 0) and (UpdatingTableIdx < TablesInfo.Count) then begin
|
|
TableInfo := TablesInfo[UpdatingTableIdx];
|
|
if TableInfo <> nil then
|
|
IsView := TableInfo.IsView;
|
|
end;
|
|
|
|
if (FldDesc.TableInfo <> nil) and (not IsView) then
|
|
Result := inherited GetActualFieldName(FldDesc, IsRefresh)
|
|
else
|
|
Result := QuoteName(FldDesc.ActualName);
|
|
end;
|
|
|
|
procedure TMSSQLGenerator.AddFieldToCondition(SB: StringBuilder; FieldDesc: TCRFieldDesc;
|
|
const StatementType: TStatementType;
|
|
const ModifiedFieldsOnly: boolean;
|
|
const Index: integer = -1);
|
|
var
|
|
ActualName: string;
|
|
IsIdentityField: boolean;
|
|
Field: TField;
|
|
begin
|
|
Assert(FieldDesc <> nil);
|
|
|
|
if ModifiedFieldsOnly then begin
|
|
Field := FOwner.GetField(FieldDesc);
|
|
IsIdentityField := Field = TDBAccessUtils.GetIdentityField(FOwner);
|
|
if (StatementType = stInsert) and IsIdentityField then begin // DMLRefresh ?
|
|
ActualName := GetActualFieldName(FieldDesc, False);
|
|
FCondSB.Append(ActualName);
|
|
FCondSB.Append(' = ');
|
|
if TOLEDBConnection(TCustomMSDataSet(FOwner).Connection.IConnection).DBMSPrimaryVer > 7 then
|
|
FCondSB.Append('SCOPE_IDENTITY()')
|
|
else
|
|
FCondSB.Append('@@Identity');
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMSSQLGenerator.GenerateConditions(SB: StringBuilder;
|
|
const StatementType: TStatementType;
|
|
const ModifiedFieldsOnly: boolean;
|
|
const KeyAndDataFields: TKeyAndDataFields;
|
|
const Index: integer = -1);
|
|
|
|
procedure GenerateCondForRQ;
|
|
{SQL Server Books Online -> Accessing and Changing Relational Data ->
|
|
Transact-SQL Syntax Elements -> Using Data Types -> Using Special Data:
|
|
|
|
In SQL Server version 7.0 and SQL Server 2000, @@DBTS is only incremented for use
|
|
in timestamp columns. If a table contains a timestamp column, every time a row is
|
|
modified by an INSERT, UPDATE, or DELETE statement, the timestamp value in the row
|
|
is set to the current @@DBTS value, and then @@DBTS is incremented by one...}
|
|
var
|
|
TimestampField: TField;
|
|
MaxTimestamp: Int64;
|
|
FieldDesc: TOLEDBFieldDesc;
|
|
begin
|
|
TimestampField := TCustomMSDataSet(FOwner).FTimestampField;
|
|
if TimestampField = nil then
|
|
DatabaseError(STimestampFieldRequired);
|
|
|
|
FieldDesc := TOLEDBFieldDesc(FOwner.GetFieldDesc(TimestampField));
|
|
MaxTimestamp := TOLEDBTableInfo(FieldDesc.TableInfo).MaxTimestamp;
|
|
FCondSB.Append(GetActualFieldName(FOwner.GetFieldDesc(TimestampField) as TCRFieldDesc, True) + ' > ' + '0x' + IntToHex(MaxTimestamp, SizeOf(MaxTimestamp) * 2));
|
|
end;
|
|
|
|
var
|
|
i: integer;
|
|
FldUsed: set of byte;
|
|
TestChanges: boolean;
|
|
begin
|
|
Assert(FOwner <> nil);
|
|
Assert(FOwner.Connection <> nil);
|
|
Assert(IsClass(FOwner.Connection, TMSConnection));
|
|
|
|
FCondSB.Length := 0;
|
|
|
|
if StatementType = stRefreshQuick then
|
|
GenerateCondForRQ
|
|
else
|
|
begin
|
|
TestChanges := (StatementType = stInsert) and TCustomMSDataSet(FOwner).Options.DMLRefresh and
|
|
(TCustomMSDataSet(FOwner).CursorType = ctDefaultResultSet) and TCustomMSDataSet(FOwner).Options.CheckRowVersion;
|
|
|
|
TestChanges := TestChanges or ((StatementType = stUpdate) and TCustomMSDataSet(FOwner).Options.DMLRefresh and
|
|
(TCustomMSDataSet(FOwner).CursorType = ctDefaultResultSet) and TCustomMSDataSet(FOwner).Options.CheckRowVersion);
|
|
|
|
if not TestChanges then
|
|
inherited
|
|
else
|
|
begin
|
|
if (TCustomMSDataSet(FOwner).FTimestampField <> nil) and not TCustomMSDataSet(FOwner).FTimestampField.IsNull then
|
|
AddFieldToCondition(FCondSB, FOwner.GetFieldDesc(TCustomMSDataSet(FOwner).FTimestampField) as TCRFieldDesc, StatementType, ModifiedFieldsOnly, Index)
|
|
else
|
|
begin
|
|
FldUsed := [];
|
|
if Length(KeyAndDataFields.KeyFieldDescs) > 0 then
|
|
for i := 0 to High(KeyAndDataFields.KeyFieldDescs) do begin
|
|
AddFieldToCondition(FCondSB, KeyAndDataFields.KeyFieldDescs[i], StatementType, ModifiedFieldsOnly, Index);
|
|
FldUsed := FldUsed + [KeyAndDataFields.KeyFieldDescs[i].FieldNo];
|
|
end;
|
|
|
|
if Length(KeyAndDataFields.DataFieldDescs) = 0 then
|
|
DatabaseError(SNoKeyFields);
|
|
for i := 0 to High(KeyAndDataFields.DataFieldDescs) do
|
|
if not IsBlobDataType(KeyAndDataFields.DataFieldDescs[i].DataType) // not "text", "ntext", "image"
|
|
and not (KeyAndDataFields.DataFieldDescs[i].FieldNo in FldUsed) then
|
|
AddFieldToCondition(FCondSB, KeyAndDataFields.DataFieldDescs[i], StatementType, ModifiedFieldsOnly, Index);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TCustomMSDataSet}
|
|
|
|
procedure TCustomMSDataSet.AutoRefreshTimer(Sender: TObject);
|
|
begin
|
|
if State = dsBrowse then begin
|
|
try
|
|
if FTimestampField <> nil then
|
|
RefreshQuick(True)
|
|
else
|
|
Refresh;
|
|
except
|
|
Options.AutoRefresh := False;
|
|
raise;
|
|
end;
|
|
|
|
// Reset timer
|
|
FAutoRefreshTimer.Enabled := False;
|
|
FAutoRefreshTimer.Enabled := True;
|
|
end;
|
|
end;
|
|
|
|
function TCustomMSDataSet.QuoteName(const AName: string): string;
|
|
begin
|
|
Result := QuoteName(AName, FLeftQuote, FRightQuote);
|
|
end;
|
|
|
|
function TCustomMSDataSet.QuoteName(const AName: string; const LeftQuote, RightQuote: string): string;
|
|
begin
|
|
if FOptions.QuoteNames and (AName <> '')
|
|
and ((AName[1] <> LeftQuote) and (AName[Length(AName)] <> RightQuote)) then
|
|
Result := Concat(LeftQuote, AName, RightQuote)
|
|
else
|
|
Result := BracketIfNeed(AName);
|
|
end;
|
|
|
|
function TCustomMSDataSet.GetParams: TMSParams;
|
|
begin
|
|
Result := TMSParams(inherited Params);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetParams(Value: TMSParams);
|
|
begin
|
|
inherited Params := Value;
|
|
end;
|
|
|
|
constructor TCustomMSDataSet.Create(Owner: TComponent);
|
|
begin
|
|
inherited Create(Owner);
|
|
|
|
FOptions := inherited Options as TMSDataSetOptions;
|
|
|
|
FLeftQuote := OLEDBAccess.LeftQuote;
|
|
FRightQuote := OLEDBAccess.RightQuote;
|
|
|
|
FLockInitFieldDefs := False;
|
|
CursorType := ctDefaultResultSet;
|
|
|
|
FIdentityField := nil;
|
|
|
|
FIsInInitFieldDefs := False;
|
|
|
|
FCommandTimeout := 0;
|
|
FetchAll := True;
|
|
|
|
FAutoRefreshTimer := TWin32Timer.Create(nil);
|
|
FAutoRefreshTimer.OnTimer := AutoRefreshTimer;
|
|
FAutoRefreshTimer.Interval := Options.AutoRefreshInterval * MSecsPerSec;
|
|
FAutoRefreshTimer.Enabled := Options.AutoRefresh;
|
|
|
|
{$IFNDEF STD}
|
|
FNeedSmartRefresh := False;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
destructor TCustomMSDataSet.Destroy;
|
|
begin
|
|
if FAutoRefreshTimer <> nil then begin
|
|
FAutoRefreshTimer.Enabled := False;
|
|
FAutoRefreshTimer.Free;
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.AssignTo(Dest: TPersistent);
|
|
begin
|
|
inherited;
|
|
|
|
if Dest is TCustomMSDataSet then begin
|
|
TCustomMSDataSet(Dest).SQLInsert := SQLInsert;
|
|
TCustomMSDataSet(Dest).SQLDelete := SQLDelete;
|
|
TCustomMSDataSet(Dest).SQLUpdate := SQLUpdate;
|
|
TCustomMSDataSet(Dest).SQLRefresh := SQLRefresh;
|
|
TCustomMSDataSet(Dest).CursorType := CursorType;
|
|
|
|
TCustomMSDataSet(Dest).Params.Assign(Params);
|
|
end;
|
|
end;
|
|
|
|
{ Smart Refresh }
|
|
{$IFDEF SMART_REFRESH}
|
|
{$IFNDEF STD}
|
|
procedure TCustomMSDataSet.RegisterNotification;
|
|
var
|
|
CreateDML: string;
|
|
Guid: TGUID;
|
|
|
|
function PrepareGuid(const Guid: string): string;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := ''; //+++ StringBuilder
|
|
for i := 1 to Length(Guid) - 1 do
|
|
case Guid[i] of
|
|
'0'..'9', 'A'..'F', 'a'..'f':
|
|
Result := Result + Guid[i];
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Assert(FRefreshServiceBroker = nil);
|
|
|
|
BeginConnection;
|
|
|
|
if TOLEDBConnection(Connection.IConnection).DBMSPrimaryVer <= 8 then
|
|
DatabaseError(SInvalidServerVersion);
|
|
|
|
{$IFDEF VER6P}
|
|
if CreateGuid(Guid) <> 0 then
|
|
RaiseLastOSError;
|
|
{$ELSE}
|
|
if CoCreateGuid(Guid) <> 0 then
|
|
RaiseLastWin32Error;
|
|
{$ENDIF}
|
|
|
|
FRefreshQueue := sSdacQueue + PrepareGuid(GuidToString(Guid));
|
|
FRefreshService := sSdacService + PrepareGuid(GuidToString(Guid));
|
|
|
|
CreateDML := 'IF NOT EXISTS (SELECT * FROM sys.service_queues WHERE name = N''' + FRefreshQueue + ''') ' +
|
|
'CREATE QUEUE ' + FRefreshQueue + ';' + LineSeparator;
|
|
CreateDML := CreateDML + 'IF NOT EXISTS (SELECT * FROM sys.services WHERE name = N''' + FRefreshService + ''') ' +
|
|
'CREATE SERVICE ' + FRefreshService + ' ON QUEUE ' + FRefreshQueue + ' ([http://schemas.microsoft.com/SQL/Notifications/PostQueryNotification])';
|
|
Connection.ExecSQL(CreateDML, []);
|
|
|
|
FIRecordSet.SetProp(prSmartRefreshService, FRefreshService);
|
|
|
|
FRefreshServiceBroker := TMSRefreshServiceBroker.Create(nil);
|
|
TMSRefreshServiceBroker(FRefreshServiceBroker).FDataSet := Self;
|
|
TMSRefreshServiceBroker(FRefreshServiceBroker).Service := FRefreshService;
|
|
TMSRefreshServiceBroker(FRefreshServiceBroker).Connection := Connection;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.UnregisterNotification;
|
|
var
|
|
DropDML: string;
|
|
begin
|
|
try
|
|
TMSRefreshServiceBroker(FRefreshServiceBroker).Free;
|
|
FRefreshServiceBroker := nil;
|
|
finally
|
|
try
|
|
DropDML := 'IF EXISTS (SELECT * FROM sys.services WHERE name = N''' + FRefreshService + ''') ' +
|
|
'DROP SERVICE ' + FRefreshService + ';' + LineSeparator;
|
|
DropDML := DropDML + 'IF EXISTS (SELECT * FROM sys.service_queues WHERE name = N''' + FRefreshQueue + ''') ' +
|
|
'DROP QUEUE ' + FRefreshQueue + ';';
|
|
try
|
|
Connection.ExecSQL(DropDML, []);
|
|
except
|
|
on E: EOLEDBError do; // silent
|
|
end;
|
|
finally
|
|
EndConnection;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{ Open/Close }
|
|
|
|
procedure TCustomMSDataSet.SetActive(Value: Boolean);
|
|
begin
|
|
if Value <> Active then begin
|
|
if Value then
|
|
SetNumericType;
|
|
|
|
{$IFDEF SMART_REFRESH}
|
|
{$IFNDEF STD}
|
|
if Active and FOptions.FSmartRefresh then
|
|
UnregisterNotification;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
try
|
|
|
|
inherited;
|
|
|
|
if Value and (FIRecordSet.FetchExecutor <> nil) then
|
|
FIRecordSet.FetchExecutor.Resume;
|
|
|
|
except
|
|
on E: EDAError do begin
|
|
if (E.Message = SCursorTypeChanged) then
|
|
Unprepare;
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.DataReopen;
|
|
begin
|
|
if FCursorType in ServerCursorTypes then
|
|
ClearBuffers;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.InternalExecute;
|
|
begin
|
|
SetNumericType;
|
|
inherited;
|
|
if TCRRecordSet(Data).CommandType = ctCursor then
|
|
InternalInitFieldDefs
|
|
else
|
|
TCRRecordSet(Data).GetCommand.SetCursorState(csInactive); // To prevent blocking execute on second exec
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.InternalOpen;
|
|
function IsAnyFieldDescCanBeModified: boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := False;
|
|
for i := 0 to FIRecordSet.Fields.Count - 1 do
|
|
if not FIRecordSet.Fields[i].ReadOnly then begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure FillFieldsOrigin;
|
|
var
|
|
Field: TField;
|
|
FieldDesc: TOLEDBFieldDesc;
|
|
|
|
TableName: string;
|
|
|
|
i: integer;
|
|
begin
|
|
/// downto to correct set FIdentityField
|
|
for i := Fields.Count - 1 downto 0 do begin
|
|
Field := Fields[i];
|
|
|
|
if Field.FieldKind = fkData then begin
|
|
FieldDesc := TOLEDBFieldDesc(GetFieldDesc(Field));
|
|
|
|
if not (Self is TCustomMSTable) then begin
|
|
TableName := GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, Connection.Database);
|
|
Field.Origin := TableName + '.' + BracketIfNeed(FieldDesc.BaseColumnName);
|
|
end
|
|
else
|
|
Field.Origin := TCustomMSTable(Self).FTableName + '.' + Field.FieldName;
|
|
|
|
if FieldDesc.IsAutoIncrement then begin
|
|
if Options.SetFieldsReadOnly then
|
|
Field.ReadOnly := True;
|
|
|
|
Assert((FUpdatingTableInfoIdx >= - 1) and (FUpdatingTableInfoIdx < TablesInfo.Count));
|
|
|
|
if (FUpdatingTableInfoIdx >= 0)
|
|
and (FIRecordSet.TablesInfo.IndexByName(GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, Connection.Database)) = FUpdatingTableInfoIdx) then
|
|
FIdentityField := Field;
|
|
{$IFDEF VER5P}
|
|
Field.AutoGenerateValue := arAutoInc;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
if FieldDesc.IsTimestamp
|
|
and (FUpdatingTableInfoIdx >= 0)
|
|
and (FieldDesc.BaseTableName = FIRecordSet.TablesInfo[FUpdatingTableInfoIdx].TableName) then
|
|
FTimestampField := Field;
|
|
end;
|
|
if Field.DataType = TFieldType(ftMSXML) then begin
|
|
FieldDesc := TOLEDBFieldDesc(GetFieldDesc(Field));
|
|
Assert(Field is TMSXMLField);
|
|
TMSXMLField(Field).SetSchemaCollection(FieldDesc.XMLSchemaCollectionName,
|
|
FieldDesc.XMLSchemaCollectionCatalogName, FieldDesc.XMLSchemaCollectionSchemaName);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i: integer;
|
|
FieldDesc: TFieldDesc;
|
|
begin
|
|
try
|
|
{$IFDEF SMART_REFRESH}
|
|
{$IFNDEF STD}
|
|
if FOptions.FSmartRefresh then
|
|
RegisterNotification;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
finally
|
|
|
|
if CachedUpdates and (FCursorType in ServerCursorTypes) then
|
|
DatabaseError(SCUandServerCursors);
|
|
|
|
inherited;
|
|
//Assert(not FIRecordSet.NativeRowset or (Length(FSQLObjects) <> 0));
|
|
|
|
FNeedAddRef := FCursorType in ServerCursorTypes;
|
|
|
|
FCanOpenNext := not FICommand.IUnknownNextIsNull;
|
|
|
|
if FIRecordSet.NativeRowset then begin
|
|
FIsAnyFieldDescCanBeModified := IsAnyFieldDescCanBeModified;
|
|
|
|
if Fields.Count > 0 then
|
|
FillFieldsOrigin;
|
|
end
|
|
else
|
|
FIsAnyFieldDescCanBeModified := False;
|
|
|
|
// Set right precision for TFloatField
|
|
for i := 0 to Fields.Count - 1 do
|
|
if (Fields[i] is TFloatField)
|
|
and (TFloatField(Fields[i]).Precision = 15 {Default})
|
|
and (Fields[i].FieldKind = fkData) then begin
|
|
FieldDesc := GetFieldDesc(Fields[i]);
|
|
case FieldDesc.DataType of
|
|
dtFloat, dtCurrency: // Precision cannot be greater then 15
|
|
TFloatField(Fields[i]).Precision := FieldDesc.Length;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.InternalClose;
|
|
var
|
|
LockClearMultipleResults: boolean;
|
|
v: Variant;
|
|
begin
|
|
inherited;
|
|
|
|
FTimestampField := nil;
|
|
|
|
if FIsInInitFieldDefs then begin
|
|
FICommand.ClearIUnknown;
|
|
FIRecordSet.GetProp(prLockClearMultipleResults, v);
|
|
LockClearMultipleResults := v;
|
|
if not LockClearMultipleResults then begin
|
|
FICommand.ClearIMultipleResults;
|
|
FICommand.ClearIUnknownNext;
|
|
FCanOpenNext := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.OpenCursor(InfoQuery: boolean);
|
|
begin
|
|
|
|
FIRecordSet.SetProp(prReadOnly, ReadOnly);
|
|
|
|
if FIRecordSet.NativeRowset and (SQL.Count = 0) then
|
|
DatabaseError(SEmptySQLStatement, Self);
|
|
|
|
inherited;
|
|
|
|
if Options.DefaultValues then
|
|
GetFieldsInfo;
|
|
|
|
if InfoQuery then begin
|
|
TCRRecordSet(Data).GetCommand.SetCursorState(csInactive); // To prevent blocking excute on second exec
|
|
TCRRecordSet(Data).CommandType := CRAccess.ctUnknown;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.GetFieldsInfo;
|
|
var
|
|
MetaData: TMSMetadata;
|
|
Field: TField;
|
|
DefValue: string;
|
|
begin
|
|
MetaData := TMSMetadata.Create(nil);
|
|
try
|
|
MetaData.Connection := Connection;
|
|
MetaData.DatabaseName := Connection.Database;
|
|
MetaData.ObjectType := otColumns;
|
|
MetaData.TableName := TablesInfo[FUpdatingTableInfoIdx].TableName;
|
|
MetaData.Open;
|
|
while not MetaData.EOF do begin
|
|
Field := FindField(MetaData.FieldByName('COLUMN_NAME').AsString);
|
|
if (Field <> nil) and MetaData.FieldByName('COLUMN_HASDEFAULT').AsBoolean and not MetaData.FieldByName('COLUMN_DEFAULT').IsNull then begin
|
|
DefValue := MetaData.FieldByName('COLUMN_DEFAULT').AsString;
|
|
case Field.DataType of
|
|
ftBoolean:
|
|
Field.DefaultExpression := BoolToStr(DefValue <> '0', True);
|
|
ftFloat, ftBCD{$IFDEF VER6P}, ftFMTBCD{$ENDIF}:
|
|
Field.DefaultExpression := StringReplace(DefValue, '.', DecimalSeparator, [rfReplaceAll]);
|
|
else
|
|
Field.DefaultExpression := DefValue;
|
|
end;
|
|
end;
|
|
MetaData.Next;
|
|
end;
|
|
finally
|
|
MetaData.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.InitFieldDefs;
|
|
begin
|
|
FIsInInitFieldDefs := True;
|
|
try
|
|
inherited;
|
|
finally
|
|
FIsInInitFieldDefs := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.InternalInitFieldDefs;
|
|
begin
|
|
if not FLockInitFieldDefs then
|
|
inherited;
|
|
end;
|
|
|
|
function TCustomMSDataSet.GetFieldType(DataType: word): TFieldType;
|
|
begin
|
|
Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.GetFieldType(DataType);
|
|
end;
|
|
|
|
function TCustomMSDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
|
|
begin
|
|
if Integer(FieldType) = ftMSXML then
|
|
Result := TMSXMLField
|
|
else
|
|
Result := inherited GetFieldClass(Fieldtype);
|
|
end;
|
|
|
|
{$IFDEF USE_FTAUTOINC}
|
|
function TCustomMSDataSet.GetFieldType(FieldDesc: TFieldDesc): TFieldType;
|
|
begin
|
|
Result := inherited GetFieldType(FieldDesc);
|
|
Assert(FieldDesc is TOLEDBFieldDesc);
|
|
if (Result = ftInteger) and TOLEDBFieldDesc(FieldDesc).IsAutoIncrement then
|
|
Result := ftAutoInc;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomMSDataSet.CreateIRecordSet;
|
|
begin
|
|
inherited;
|
|
|
|
if FIRecordSet = nil then
|
|
SetIRecordSet(TOLEDBRecordSet.Create);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetIRecordSet(Value: TData);
|
|
begin
|
|
inherited;
|
|
|
|
FIRecordSet := TOLEDBRecordSet(Value);
|
|
|
|
if FIRecordSet <> nil then begin
|
|
FICommand := TOLEDBCommand(FIRecordSet.GetCommand);
|
|
if FOptions <> nil then begin
|
|
SetNumericType;
|
|
FIRecordSet.SetProp(prUniqueRecords, FOptions.FUniqueRecords);
|
|
FIRecordSet.SetProp(prCursorUpdate, FOptions.FCursorUpdate);
|
|
end;
|
|
|
|
FIRecordSet.SetProp(prEnableEmptyStrings, True);
|
|
FIRecordSet.SetProp(prReadOnly, ReadOnly);
|
|
FIRecordSet.SetProp(prCursorType, Integer(CursorType));
|
|
FIRecordSet.SetProp(prCommandTimeout, CommandTimeout);
|
|
FIRecordSet.SetProp(prRequestSQLObjects, True);
|
|
|
|
FIRecordSet.SetProp(prRoAfterUpdate, roAfterUpdate in RefreshOptions);
|
|
|
|
TOLEDBRecordSet(FIRecordSet).CursorTypeChanged := DoCursorTypeChanged;
|
|
end
|
|
else
|
|
FICommand := nil;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetNumericType;
|
|
begin
|
|
if (FIRecordSet <> nil) and (FOptions <> nil) then begin
|
|
if FOptions.EnableBCD or (Connection = nil) or (Connection.Options = nil) then begin
|
|
Assert(FIRecordSet <> nil);
|
|
FIRecordSet.SetProp(prEnableBCD, FOptions.FEnableBCD);
|
|
{$IFDEF VER6P}
|
|
FIRecordSet.SetProp(prEnableFMTBCD, False);
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
case Connection.Options.NumericType of
|
|
ntFloat: begin
|
|
FIRecordSet.SetProp(prEnableBCD, False);
|
|
{$IFDEF VER6P}
|
|
FIRecordSet.SetProp(prEnableFMTBCD, False);
|
|
{$ENDIF}
|
|
end;
|
|
ntBCD: begin
|
|
FIRecordSet.SetProp(prEnableBCD, True);
|
|
{$IFDEF VER6P}
|
|
FIRecordSet.SetProp(prEnableFMTBCD, False);
|
|
{$ENDIF}
|
|
end;
|
|
{$IFDEF VER6P}
|
|
ntFMTBCD: begin
|
|
FIRecordSet.SetProp(prEnableBCD, True);
|
|
FIRecordSet.SetProp(prEnableFMTBCD, True);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
if FieldDefs <> nil then
|
|
FieldDefs.Updated := False;
|
|
end;
|
|
|
|
function TCustomMSDataSet.GetCanModify: boolean;
|
|
begin
|
|
Assert(FIRecordSet <> nil, 'FIRecordSet must be setted to this time');
|
|
|
|
Result := inherited GetCanModify or
|
|
not (ReadOnly or UniDirectional) and
|
|
(FIsAnyFieldDescCanBeModified or
|
|
(SQLInsert.Count > 0) or
|
|
(SQLUpdate.Count > 0) or
|
|
(SQLDelete.Count > 0))
|
|
and (FCursorType <> ctStatic);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.CreateCommand;
|
|
begin
|
|
SetCommand(TMSSQL.Create(Self));
|
|
end;
|
|
|
|
function TCustomMSDataSet.CreateOptions: TDADataSetOptions;
|
|
begin
|
|
Result := TMSDataSetOptions.Create(Self);
|
|
end;
|
|
|
|
function TCustomMSDataSet.GetConnection: TMSConnection;
|
|
begin
|
|
Result := TMSConnection(inherited Connection);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetConnection(Value: TMSConnection);
|
|
begin
|
|
inherited Connection := Value;
|
|
end;
|
|
|
|
function TCustomMSDataSet.PSGetKeyFields: string;
|
|
begin
|
|
if FIRecordSet.NativeRowset then
|
|
Result := inherited PSGetKeyFields
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.CreateSQLGenerator;
|
|
begin
|
|
SetSQLGenerator(TMSSQLGenerator.Create(Self));
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetReadOnly(Value: boolean);
|
|
begin
|
|
if ReadOnly <> Value then begin
|
|
if CursorType in ServerCursorTypes then
|
|
CheckInactive;
|
|
FieldDefs.Updated := False;
|
|
FIRecordSet.SetProp(prReadOnly, Value);
|
|
FIRecordSet.SetProp(prRequestSQLObjects, FOptions.FUniqueRecords or not Value);
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.InternalBeforeEdit;
|
|
begin
|
|
if roBeforeEdit in RefreshOptions then begin
|
|
InternalRefreshRecord;
|
|
if CursorType in ServerCursorTypes then
|
|
Resync([]); // CR 9097
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.UnPrepare;
|
|
var
|
|
v: variant;
|
|
LockClearMultipleResults: boolean;
|
|
begin
|
|
Close;
|
|
|
|
if FICommand <> nil then begin
|
|
FICommand.ClearIUnknown;
|
|
FIRecordSet.GetProp(prLockClearMultipleResults, v);
|
|
LockClearMultipleResults := v;
|
|
if not LockClearMultipleResults then begin
|
|
FICommand.ClearIMultipleResults;
|
|
FICommand.ClearIUnknownNext;
|
|
FCanOpenNext := True;
|
|
end;
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TCustomMSDataSet.OpenNext: boolean; // Open next rowset in statement. if rowset is not provided then OpenNext return False. If statement has error, then raised exception
|
|
begin
|
|
if Prepared then
|
|
DatabaseError(SOpenNextPreparedSQL);
|
|
|
|
Result := FCanOpenNext;
|
|
if Result then
|
|
BeginConnection;
|
|
try
|
|
FIRecordSet.SetProp(prLockClearMultipleResults, True);
|
|
try
|
|
Close;
|
|
Unprepare;
|
|
finally
|
|
FIRecordSet.SetProp(prLockClearMultipleResults, False);
|
|
end;
|
|
|
|
if Result then begin
|
|
FieldDefs.Updated := False;
|
|
Open;
|
|
end;
|
|
finally
|
|
if Result then
|
|
EndConnection;
|
|
end;
|
|
end;
|
|
|
|
function TCustomMSDataSet.FindParam(const Value: string): TMSParam;
|
|
begin
|
|
Result := inherited FindParam(GetParamNameWODog(Value)) as TMSParam;
|
|
end;
|
|
|
|
function TCustomMSDataSet.ParamByName(const Value: string): TMSParam;
|
|
begin
|
|
Result := inherited ParamByName(GetParamNameWODog(Value)) as TMSParam;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.CreateProcCall(Name: string);
|
|
begin
|
|
InternalCreateProcCall(Name, True);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.Post;
|
|
begin
|
|
inherited;
|
|
|
|
{$IFNDEF STD}
|
|
if FNeedSmartRefresh then
|
|
DoSmartRefresh;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.Cancel;
|
|
begin
|
|
inherited;
|
|
|
|
{$IFNDEF STD}
|
|
if FNeedSmartRefresh then
|
|
DoSmartRefresh;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomMSDataSet.SQLAddWhere(SQLText, Condition: string): string;
|
|
begin
|
|
Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.AddWhere(SQLText, Condition);
|
|
end;
|
|
|
|
function TCustomMSDataSet.SQLDeleteWhere(SQLText: string): string;
|
|
begin
|
|
Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.DeleteWhere(SQLText);
|
|
end;
|
|
|
|
function TCustomMSDataSet.SQLGetWhere(SQLText: string): string;
|
|
begin
|
|
Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.GetWhere(SQLText);
|
|
end;
|
|
|
|
function TCustomMSDataSet.SQLSetOrderBy(SQLText: string; Fields: string): string;
|
|
begin
|
|
Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.SetOrderBy(SQLText, Fields);
|
|
end;
|
|
|
|
function TCustomMSDataSet.SQLGetOrderBy(SQLText: string): string;
|
|
begin
|
|
Result := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.GetOrderBy(SQLText);
|
|
end;
|
|
|
|
(*procedure TCustomMSDataSet.SetBeforeFetch(Value: TBeforeFetchEvent);
|
|
begin
|
|
inherited;
|
|
FIRecordSet.SetProp(prBeforeFetch, Assigned(BeforeFetch));
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetAfterFetch(Value: TAfterFetchEvent);
|
|
begin
|
|
inherited;
|
|
FIRecordSet.SetProp(prAfterFetch, Assigned(AfterFetch));
|
|
end;*)
|
|
|
|
procedure TCustomMSDataSet.SetRefreshOptions(Value: TRefreshOptions);
|
|
begin
|
|
inherited SetRefreshOptions(Value);
|
|
if FIRecordSet <> nil then
|
|
FIRecordSet.SetProp(prRoAfterUpdate, roAfterUpdate in RefreshOptions);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.WriteFieldXMLDataType(Field: TField; FieldDesc: TFieldDesc;
|
|
const FieldAlias: string; XMLWriter: XMLTextWriter);
|
|
begin
|
|
inherited;
|
|
|
|
if FieldDesc is TOLEDBFieldDesc then begin
|
|
if TOLEDBFieldDesc(FieldDesc).IsAutoIncrement
|
|
and not (Field.Required and not Field.ReadOnly) // Already writed in MemDS
|
|
then
|
|
XmlWriter.WriteAttributeString('rs:maybenull', 'false');
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.WriteFieldXMLAttributeType(Field: TField; FieldDesc: TFieldDesc;
|
|
const FieldAlias: string; XMLWriter: XMLTextWriter);
|
|
begin
|
|
inherited;
|
|
|
|
if FieldDesc is TOLEDBFieldDesc then begin
|
|
if TOLEDBFieldDesc(FieldDesc).BaseCatalogName <> '' then
|
|
XmlWriter.WriteAttributeString('rs:basecatalog', XMLEncode(TOLEDBFieldDesc(FieldDesc).BaseCatalogName));
|
|
|
|
if TOLEDBFieldDesc(FieldDesc).BaseSchemaName <> '' then
|
|
XmlWriter.WriteAttributeString('rs:baseschema', XMLEncode(TOLEDBFieldDesc(FieldDesc).BaseSchemaName));
|
|
|
|
if TOLEDBFieldDesc(FieldDesc).IsTimestamp then
|
|
XmlWriter.WriteAttributeString('rs:rowver', 'true');
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.GetKeyAndDataFields(
|
|
out KeyAndDataFields: TKeyAndDataFields;
|
|
const ForceUseAllKeyFields: boolean);
|
|
|
|
procedure ProcessField(FieldDesc: TOLEDBFieldDesc);
|
|
begin
|
|
if FieldDesc.IsKey or FieldDesc.IsAutoIncrement then begin
|
|
SetLength(KeyAndDataFields.KeyFieldDescs, Length(KeyAndDataFields.KeyFieldDescs) + 1);
|
|
KeyAndDataFields.KeyFieldDescs[High(KeyAndDataFields.KeyFieldDescs)] := FieldDesc;
|
|
end;
|
|
|
|
if not FieldDesc.ReadOnly then begin
|
|
SetLength(KeyAndDataFields.DataFieldDescs, Length(KeyAndDataFields.DataFieldDescs) + 1);
|
|
KeyAndDataFields.DataFieldDescs[High(KeyAndDataFields.DataFieldDescs)] := FieldDesc;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
ByTable: boolean;
|
|
Field: TField;
|
|
FieldDesc: TOLEDBFieldDesc;
|
|
i: integer;
|
|
IsNeedProcessField: boolean;
|
|
|
|
begin
|
|
if (Length(FCachedKeyAndDataFields[ForceUseAllKeyFields].KeyFieldDescs) = 0) and (Length(FCachedKeyAndDataFields[ForceUseAllKeyFields].DataFieldDescs) = 0) then begin
|
|
// Search fields
|
|
|
|
SetLength(KeyAndDataFields.KeyFieldDescs, 0);
|
|
SetLength(KeyAndDataFields.DataFieldDescs, 0);
|
|
|
|
if (Fields.Count = 0) or (FIRecordSet.Fields.Count = 0) then
|
|
Exit;
|
|
|
|
ByTable := False;
|
|
if FUpdatingTableInfoIdx >= 0 then
|
|
if Self is TCustomMSTable then
|
|
ByTable := True
|
|
else
|
|
if not ForceUseAllKeyFields or not Options.FullRefresh then
|
|
ByTable := True;
|
|
|
|
for i := 0 to Fields.Count - 1 do begin
|
|
Field := Fields[i];
|
|
if Field.FieldKind = fkData then begin
|
|
FieldDesc := GetFieldDesc(Field) as TOLEDBFieldDesc;
|
|
if ByTable then
|
|
IsNeedProcessField := (Self is TCustomMSTable) or (FieldDesc.TableInfo = TablesInfo[FUpdatingTableInfoIdx])
|
|
else
|
|
IsNeedProcessField := True;
|
|
if IsNeedProcessField then
|
|
ProcessField(FieldDesc);
|
|
end;
|
|
end;
|
|
|
|
// Cache result
|
|
FCachedKeyAndDataFields[ForceUseAllKeyFields] := KeyAndDataFields;
|
|
end
|
|
else // Get fields from cache
|
|
KeyAndDataFields := FCachedKeyAndDataFields[ForceUseAllKeyFields];
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.BeginConnection(NoConnectCheck: boolean = True);
|
|
begin
|
|
if FIRecordSet.NativeRowset then
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.EndConnection;
|
|
begin
|
|
if FIRecordSet.NativeRowset then
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetNumberRange(FieldDef: TFieldDef);
|
|
var
|
|
Field: TField;
|
|
FieldDesc: TOLEDBFieldDesc;
|
|
{$IFDEF VER6P}
|
|
mv: Extended;
|
|
{$ENDIF}
|
|
AIConnection: TOLEDBConnection;
|
|
ServerVersion: integer;
|
|
begin
|
|
AIConnection := TMSAccessUtils.FIConnection(Connection);
|
|
ServerVersion := 0;
|
|
if AIConnection <> nil then
|
|
ServerVersion := AIConnection.ProviderPrimaryVer;
|
|
Field := FindField(FieldDef.Name);
|
|
if Field <> nil then begin
|
|
FieldDesc := GetFieldDesc(Field) as TOLEDBFieldDesc;
|
|
case FieldDesc.OLEDBType of
|
|
DBTYPE_UI1:
|
|
begin
|
|
Assert(Field is TWordField);
|
|
TWordField(Field).MinValue := 0;
|
|
TWordField(Field).MaxValue := 255;
|
|
end;
|
|
else
|
|
case FieldDesc.DataType of
|
|
dtInt8:
|
|
begin
|
|
TIntegerField(Field).MinValue := -128;
|
|
TIntegerField(Field).MaxValue := 127;
|
|
end;
|
|
dtInt16:
|
|
begin
|
|
if ServerVersion = 3 then begin
|
|
TSmallIntField(Field).MinValue := -32768;
|
|
TSmallIntField(Field).MaxValue := 32767;
|
|
end
|
|
else begin
|
|
TIntegerField(Field).MinValue := -32768;
|
|
TIntegerField(Field).MaxValue := 32767;
|
|
end;
|
|
end;
|
|
dtInt32:
|
|
begin
|
|
TIntegerField(Field).MinValue := -2147483647;
|
|
TIntegerField(Field).MaxValue := 2147483647;
|
|
end;
|
|
dtInt64:
|
|
begin
|
|
TLargeintField(Field).MinValue := -9223372036854775807;
|
|
TLargeintField(Field).MaxValue := 9223372036854775807;
|
|
end;
|
|
dtWord:
|
|
begin
|
|
TWordField(Field).MinValue := 0;
|
|
TWordField(Field).MaxValue := 65535;
|
|
end;
|
|
dtFloat:
|
|
begin
|
|
if FieldDesc.Scale = 255 then begin
|
|
if FieldDesc.Length = 7 then begin
|
|
TFloatField(Field).MinValue := -3.40E38;
|
|
TFloatField(Field).MaxValue := 3.40E38;
|
|
end
|
|
else
|
|
begin
|
|
TFloatField(Field).MinValue := -1.79E308;
|
|
TFloatField(Field).MaxValue := 1.79E308;
|
|
end;
|
|
end
|
|
else
|
|
if (FieldDesc.Length > 0) then begin
|
|
TFloatField(Field).Precision := FieldDesc.Length;
|
|
TFloatField(Field).MaxValue :=
|
|
IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
|
|
IntPower(10, - Integer(FieldDesc.Scale));
|
|
TFloatField(Field).MinValue := -TFloatField(Field).MaxValue;
|
|
end;
|
|
end;
|
|
dtBCD:
|
|
begin
|
|
TBCDField(Field).Precision := FieldDesc.Length;
|
|
if (FieldDesc.Length > 0) and (FieldDesc.Length <= 15) then begin
|
|
TBCDField(Field).MaxValue :=
|
|
IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
|
|
IntPower(10, - Integer(FieldDesc.Scale));
|
|
TBCDField(Field).MinValue := -TBCDField(Field).MaxValue;
|
|
end;
|
|
end;
|
|
{$IFDEF VER6P}
|
|
dtFmtBCD:
|
|
begin
|
|
TFMTBCDField(Field).Precision := FieldDesc.Length;
|
|
if (FieldDesc.Length > 0) and (FieldDesc.Length <= 15) then begin
|
|
mv :=
|
|
IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
|
|
IntPower(10, - Integer(FieldDesc.Scale));
|
|
TFMTBCDField(Field).MaxValue := FloatToStr(mv);
|
|
TFMTBCDField(Field).MinValue := FloatToStr(-mv);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
dtCurrency:
|
|
if ServerVersion <> 3 then begin
|
|
if FieldDesc.Length = 10 then begin
|
|
TFloatField(Field).MinValue := -214748.3648 ;
|
|
TFloatField(Field).MaxValue := 214748.3647;
|
|
end
|
|
else
|
|
if FieldDesc.Length = 19 then begin
|
|
TFloatField(Field).MinValue := -922337203685477.5808;
|
|
TFloatField(Field).MaxValue := 922337203685477.5807;
|
|
end;
|
|
end
|
|
else begin
|
|
TCurrencyField(Field).MinValue := -922337203685477.5808;
|
|
TCurrencyField(Field).MaxValue := 922337203685477.5807;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.DetectIdentityField;
|
|
var
|
|
i: integer;
|
|
Field: TField;
|
|
FieldDesc: TOLEDBFieldDesc;
|
|
begin
|
|
inherited;
|
|
|
|
//Search Identity Field
|
|
for i := FieldCount - 1 downto 0 do begin
|
|
Field := Fields[i];
|
|
|
|
if Field.FieldKind = fkData then begin
|
|
FieldDesc := TOLEDBFieldDesc(GetFieldDesc(Field));
|
|
|
|
if FieldDesc.IsAutoIncrement then begin
|
|
|
|
Assert((FUpdatingTableInfoIdx >= - 1) and (FUpdatingTableInfoIdx < TablesInfo.Count));
|
|
|
|
if (FUpdatingTableInfoIdx >= 0)
|
|
and (FIRecordSet.TablesInfo.IndexByName(GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName, FieldDesc.BaseTableName, Connection.Database)) = FUpdatingTableInfoIdx) then
|
|
FIdentityField := Field;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetOptions(Value: TMSDataSetOptions);
|
|
begin
|
|
Options.Assign(Value);
|
|
end;
|
|
|
|
{
|
|
procedure TCustomMSDataSet.AssignFieldValue(Param: TParam; Field: TField; Old: boolean);
|
|
begin
|
|
inherited;
|
|
if Field.IsNull then
|
|
Param.Clear;
|
|
end;
|
|
}
|
|
|
|
function TCustomMSDataSet.NeedReturnParams: boolean;
|
|
begin
|
|
Result := inherited NeedReturnParams or FOptions.FDMLRefresh;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.AssignFieldValue(Param: TDAParam; Field: TField; Old: boolean);
|
|
var
|
|
FieldDesc: TOLEDBFieldDesc;
|
|
begin
|
|
if TDBAccessUtils.IsObjectDataType(Param, Field.DataType) then begin
|
|
FieldDesc := TOLEDBFieldDesc(GetFieldDesc(Field));
|
|
TMSParam(Param).OLEDBType := FieldDesc.OLEDBType;
|
|
end;
|
|
|
|
inherited AssignFieldValue(Param, Field, Old);
|
|
end;
|
|
|
|
function TCustomMSDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: boolean): TGetResult;
|
|
begin
|
|
Result := grError;
|
|
if (FCursorType = ctDynamic) and (BufferCount > 1) then
|
|
DatabaseError(SBookmarksRequired)
|
|
else
|
|
Result := inherited GetRecord(Buffer, GetMode, DoCheck);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
|
|
begin
|
|
inherited;
|
|
|
|
if (FCursorType in ServerCursorTypes) and (GetBookmarkFlag(Buffer) <> bfInserted) then
|
|
GetRecord(Buffer, gmCurrent, True);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.DoAfterExecute(Result: boolean);
|
|
begin
|
|
inherited;
|
|
{$IFDEF SMART_REFRESH}
|
|
{$IFNDEF STD}
|
|
if (FRefreshServiceBroker <> nil) and (not TMSServiceBroker(FRefreshServiceBroker).Active) then
|
|
TMSServiceBroker(FRefreshServiceBroker).Start;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ Smart Refresh}
|
|
{$IFNDEF STD}
|
|
procedure TCustomMSDataSet.DoSmartRefresh;
|
|
begin
|
|
if State in [dsInsert,dsEdit] then
|
|
FNeedSmartRefresh := True
|
|
else begin
|
|
Refresh;
|
|
if Assigned(FAfterSmartRefresh) then
|
|
FAfterSmartRefresh(Self);
|
|
FNeedSmartRefresh := False;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ Before / After UpdateExecute }
|
|
|
|
function TCustomMSDataSet.AssignedBeforeUpdateExecute: boolean;
|
|
begin
|
|
Result := Assigned(FBeforeUpdateExecute);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.DoBeforeUpdateExecute(Sender: TDataSet; StatementTypes: TStatementTypes;
|
|
Params: TDAParams);
|
|
begin
|
|
if AssignedBeforeUpdateExecute then
|
|
FBeforeUpdateExecute(Sender as TCustomMSDataSet, StatementTypes, Params as TMSParams);
|
|
end;
|
|
|
|
function TCustomMSDataSet.AssignedAfterUpdateExecute: boolean;
|
|
begin
|
|
Result := Assigned(FAfterUpdateExecute);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.DoAfterUpdateExecute(Sender: TDataSet; StatementTypes: TStatementTypes;
|
|
Params: TDAParams);
|
|
begin
|
|
if AssignedAfterUpdateExecute then
|
|
FAfterUpdateExecute(Sender as TCustomMSDataSet, StatementTypes, Params as TMSParams);
|
|
end;
|
|
|
|
function TCustomMSDataSet.GetRecCount: longint;
|
|
function GetCount(const s: string): longint;
|
|
var
|
|
i: integer;
|
|
OldParamCheck: boolean;
|
|
UQ: TCustomMSDataSet;
|
|
AIConnection: TOLEDBConnection;
|
|
begin
|
|
CheckUpdateQuery(stCustom);
|
|
UQ := FUpdateQuery as TCustomMSDataSet;
|
|
|
|
OldParamCheck := UQ.ParamCheck;
|
|
try
|
|
UQ.ParamCheck := ParamCheck;
|
|
UQ.SQL.Text := s;
|
|
if not ParamCheck then
|
|
for i := 0 to Params.Count {without -1!} do
|
|
UQ.Params.Add;
|
|
|
|
if UQ.ParamCount > 0 then begin
|
|
UQ.Params[0].DataType := ftLargeint;
|
|
UQ.Params[0].ParamType := ptOutput;
|
|
end;
|
|
|
|
UQ.Macros.Assign(Macros);
|
|
for i := 0 to Params.Count - 1 do
|
|
UQ.Params[i + 1].Assign(Params[i]);
|
|
|
|
AIConnection := TMSAccessUtils.FIConnection(Connection);
|
|
if (AIConnection <> nil) and (AIConnection.ProviderPrimaryVer <> 3) then begin
|
|
UQ.Execute;
|
|
Result := UQ.Params[0].Value;
|
|
end
|
|
else begin
|
|
UQ.Open;
|
|
Result := UQ.Fields[0].Value;
|
|
end;
|
|
finally
|
|
UQ.ParamCheck := OldParamCheck;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Parser: TMSParser;
|
|
SelectPos: integer;
|
|
FromPos: integer;
|
|
s: string;
|
|
CountParamName: string;
|
|
|
|
begin
|
|
if ((not FetchAll or Options.NonBlocking) and FOptions.QueryRecCount) // Server cursors or DefaultResultSet with FetchAll = False
|
|
and not ((Params.Count > 0) and (Params[0].ParamType = ptResult)) then begin // Current SQL does not have RETURN parameter
|
|
s := FinalSQL;
|
|
s := {$IFDEF CLR}CoreLab.Sdac.{$ENDIF}MSAccess.SetOrderBy(s, '');
|
|
Parser := TMSParser.Create(s);
|
|
Parser.OmitBlank := False;
|
|
Parser.OmitComment := True;
|
|
try
|
|
if Parser.ToLexem(lxSELECT) <> lcEnd then begin
|
|
SelectPos := Parser.CurrPos;
|
|
if Parser.ToLexem(lxFROM) <> lcEnd then begin
|
|
FromPos := Parser.CurrPos;
|
|
|
|
if Connection.Options.Provider <> prCompact then begin
|
|
if ParamCheck then
|
|
CountParamName := ':SDAC_COUNT'
|
|
else
|
|
CountParamName := '?';
|
|
s := 'SET ' + CountParamName + ' = (' + Copy(s, 1, SelectPos) + ' COUNT(*)' + Copy(s, FromPos - 4 {length('FROM')}, MaxInt) + ')';
|
|
end
|
|
else begin
|
|
CountParamName := 'SDAC_COUNT';
|
|
s := Copy(s, 1, SelectPos) + ' COUNT(*) AS ' + CountParamName + ' ' + Copy(s, FromPos - 4 {length('FROM')}, MaxInt);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Parser.Free;
|
|
end;
|
|
|
|
if s <> '' then
|
|
Result := GetCount(s)
|
|
else
|
|
Result := 0;
|
|
end
|
|
else
|
|
Result := inherited GetRecCount;
|
|
end;
|
|
|
|
function TCustomMSDataSet.GetRecordCount: integer;
|
|
begin
|
|
if (not FetchAll or Options.NonBlocking) and FOptions.QueryRecCount then // Server cursors or DefaultResultSet with FetchAll = False
|
|
Result := FRecordCount
|
|
else
|
|
Result := inherited GetRecordCount;
|
|
end;
|
|
|
|
function TCustomMSDataSet.Fetched: boolean;
|
|
begin
|
|
if FCursorType in ServerCursorTypes then
|
|
Result := False
|
|
else
|
|
Result := inherited Fetched;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.DoCursorTypeChanged;
|
|
var
|
|
v: Variant;
|
|
begin
|
|
// Does not need to read ReadOnly property (for changes to static cursor)
|
|
// FIRecordSet.GetProp(prReadOnly, @ReadOnly);
|
|
|
|
FIRecordSet.GetProp(prCursorType, v);
|
|
FCursorType := TMSCursorType(v);
|
|
raise EDAError.Create(0, SCursorTypeChanged);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetFetchAll(Value: boolean);
|
|
begin
|
|
if FetchAll <> Value then
|
|
UnPrepare;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.UpdateExecute(const StatementTypes: TStatementTypes);
|
|
var
|
|
UserSQL, ROnly: boolean;
|
|
IdentityParamIdx: integer;
|
|
UQParams: TDAParams;
|
|
NewIdentityValue: variant;
|
|
AIConnection: TOLEDBConnection;
|
|
begin
|
|
IdentityParamIdx := - 1;
|
|
UQParams := TDBAccessUtils.GetParams(FUpdateQuery);
|
|
AIConnection := TMSAccessUtils.FIConnection(Connection);
|
|
if stInsert in StatementTypes then begin
|
|
if Assigned(UpdateObject) then
|
|
UserSQL := UpdateObject.SQL[DB.ukInsert].Count > 0
|
|
else
|
|
UserSQL := FUpdateSQL[stInsert].Count > 0;
|
|
|
|
if not UserSQL then begin // This is not custom user statement and last parameter is used for Identity
|
|
if Options.QueryIdentity and (FIdentityField <> nil) and (CursorType = ctDefaultResultSet) then begin
|
|
if (AIConnection <> nil) and (AIConnection.ProviderPrimaryVer = 3) then
|
|
IdentityParamIdx := 0
|
|
else begin
|
|
IdentityParamIdx := UQParams.Count - 1;
|
|
Assert(IdentityParamIdx >= 0);
|
|
// UQParams[IdentityParamIdx].ParamType := ptInputOutput; - already setted by AddParam
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
inherited;
|
|
|
|
if (IdentityParamIdx >= 0) and not NeedReturnParams then begin
|
|
ROnly := FIdentityField.ReadOnly;
|
|
if ROnly then begin
|
|
SetTempState(State); // DisableControls
|
|
FIdentityField.ReadOnly := False;
|
|
end;
|
|
if (AIConnection <> nil) and (AIConnection.ProviderPrimaryVer = 3) then begin
|
|
TDBAccessUtils.GetSQL(FUpdateQuery).Text := 'SELECT @@IDENTITY';
|
|
TDBAccessUtils.Open(FUpdateQuery);
|
|
NewIdentityValue := TCustomMSDataSet(FUpdateQuery).Fields[IdentityParamIdx].Value;
|
|
end
|
|
else
|
|
NewIdentityValue := UQParams[IdentityParamIdx].Value;
|
|
|
|
FIdentityField.NewValue := NewIdentityValue;
|
|
|
|
if ROnly then begin
|
|
FIdentityField.ReadOnly := True;
|
|
RestoreState(State);
|
|
end
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.InternalRefreshRecord;
|
|
var
|
|
Bookmark: TBookmark;
|
|
begin
|
|
case FCursorType of
|
|
ctDefaultResultSet:
|
|
inherited;
|
|
ctStatic, ctKeySet:
|
|
begin
|
|
Bookmark := GetBookmark;
|
|
try
|
|
FIRecordSet.SetToBookmark(Bookmark); // ReFetch
|
|
finally
|
|
FreeBookmark(Bookmark);
|
|
end;
|
|
FRowsAffected := 1; // Must be always OK
|
|
end;
|
|
ctDynamic:
|
|
begin
|
|
if FIRecordSet.FetchToBookmarkValue then
|
|
FRowsAffected := 1
|
|
else
|
|
FRowsAffected := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.CheckUpdateQuery(const StatementType: TStatementType);
|
|
var
|
|
UseMSSQL: boolean;
|
|
begin
|
|
FUpdateQuery := FUpdateComponents[StatementType];
|
|
if FUpdateQuery = nil then begin
|
|
if not __UseUpdateOptimization then
|
|
UseMSSQL := False
|
|
else
|
|
case StatementType of
|
|
stInsert, stUpdate:
|
|
UseMSSQL := not Options.DMLRefresh;
|
|
stDelete:
|
|
UseMSSQL := True;
|
|
else
|
|
UseMSSQL := False;
|
|
end;
|
|
if UseMSSQL and (Connection.Options.Provider = prCompact) then
|
|
UseMSSQL := not (Options.QueryIdentity and (FIdentityField <> nil));
|
|
if UseMSSQL then begin
|
|
Assert(UsedConnection <> nil);
|
|
FUpdateQuery := TMSSQL.Create(nil);
|
|
TMSSQL(FUpdateQuery).Connection := TMSConnection(UsedConnection);
|
|
end;
|
|
end;
|
|
FUpdateComponents[StatementType] := FUpdateQuery;
|
|
|
|
inherited;
|
|
|
|
Assert(FUpdateComponents[StatementType] = FUpdateQuery);
|
|
|
|
if FUpdateQuery is TCustomMSDataSet then begin
|
|
TCustomMSDataSet(FUpdateQuery).FetchAll := True;
|
|
TCustomMSDataSet(FUpdateQuery).ReadOnly := True;
|
|
TCustomMSDataSet(FUpdateQuery).Options.FlatBuffers := True;
|
|
TCustomMSDataSet(FUpdateQuery).Options.NumberRange := False;
|
|
TCustomMSDataSet(FUpdateQuery).Options.QueryRecCount := False;
|
|
TCustomMSDataSet(FUpdateQuery).Options.QuoteNames := False;
|
|
TCustomMSDataSet(FUpdateQuery).Options.UniqueRecords := False;
|
|
TCustomMSDataSet(FUpdateQuery).Options.FullRefresh := Options.FullRefresh;
|
|
|
|
TCustomMSDataSet(FUpdateQuery).FIRecordSet.SetProp(prRequestSQLObjects, False);
|
|
end;
|
|
end;
|
|
|
|
function TCustomMSDataSet.UseParamType: boolean;
|
|
begin
|
|
Result := FUseParamType;
|
|
end;
|
|
|
|
function TCustomMSDataSet.PerformSQL(const SQL: string; const StatementTypes: TStatementTypes): boolean;
|
|
begin
|
|
try
|
|
Result := inherited PerformSQL(SQL, StatementTypes);
|
|
finally
|
|
FUseParamType := False;
|
|
end;
|
|
end;
|
|
|
|
function ConvertCRParamTypeToBDE(const Value: TParamDirection): TParamType;
|
|
begin
|
|
case Value of
|
|
pdInput:
|
|
Result := ptInput;
|
|
pdInputOutput:
|
|
Result := ptInputOutput;
|
|
pdResult:
|
|
Result := ptResult;
|
|
else
|
|
Assert(False, 'Invalid value in ConvertCRParamTypeToBDE(const Value: TParamDirection): TParamType');
|
|
Result := ptUnknown; // To prevent compiler warning
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.InternalCreateProcCall(Name: string; NeedDescribe: boolean);
|
|
var
|
|
i: integer;
|
|
ParamDescs: TParamDescs;
|
|
ParamDesc: CRAccess.TParamDesc;
|
|
|
|
Param: TMSParam;
|
|
ParamType: TParamType;
|
|
IsNewParam: boolean;
|
|
ft: TFieldType;
|
|
|
|
ProcCallSQL: string;
|
|
{$IFDEF VER6P}
|
|
EnableFmtBcd: variant;
|
|
{$ENDIF}
|
|
begin
|
|
BeginConnection;
|
|
try
|
|
if not NeedDescribe then
|
|
TMSSQL(FCommand).WriteParams(False);
|
|
|
|
{$IFDEF VER6P}
|
|
EnableFmtBcd := FIRecordSet.GetProp(prEnableFMTBCD, EnableFmtBcd);
|
|
{$ENDIF}
|
|
ProcCallSQL := FICommand.CreateProcCall(Name, NeedDescribe, True, Options.EnableBCD, {$IFDEF VER6P}Boolean(EnableFmtBcd){$ELSE}False{$ENDIF});
|
|
|
|
if NeedDescribe then
|
|
TMSSQL(FCommand).CreateParams;
|
|
|
|
if NeedDescribe and (Params <> nil) then begin
|
|
ParamDescs := TOLEDBCommand(FICommand).Params;
|
|
for i := 0 to ParamDescs.Count - 1 do begin
|
|
ParamDesc := ParamDescs[i];
|
|
ParamType := ConvertCRParamTypeToBDE(ParamDesc.GetParamType);
|
|
|
|
Param := Params.FindParam(ParamDesc.GetName);
|
|
IsNewParam := Param = nil;
|
|
if IsNewParam then
|
|
Param := TMSParam.Create(Params, ParamType);
|
|
|
|
Param.ParamType := ParamType;
|
|
ft := GetFieldType(ParamDesc.GetDataType);
|
|
if ft <> Param.DataType then
|
|
Param.DataType := ft; // To prevent clearing Param.Value on set DataType
|
|
Param.Name := ParamDesc.GetName;
|
|
if IsNewParam then
|
|
Param.Value := ParamDesc.GetValue;
|
|
Param.Size := ParamDesc.GetSize;
|
|
end;
|
|
|
|
FICommand.SetProp(prDisableParamScan, True);
|
|
try
|
|
FCommand.SQL.Text := ProcCallSQL;
|
|
finally
|
|
FICommand.SetProp(prDisableParamScan, False);
|
|
end;
|
|
end;
|
|
finally
|
|
EndConnection;
|
|
end;
|
|
end;
|
|
|
|
function TCustomMSDataSet.IsRefreshQuickField(FieldDesc: TFieldDesc): boolean;
|
|
begin
|
|
Result := TOLEDBFieldDesc(FieldDesc).IsTimestamp;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SaveMaxRefreshQuickValue(FieldDesc: TFieldDesc; const Value: variant);
|
|
var
|
|
Field: TOLEDBFieldDesc;
|
|
Val: Int64;
|
|
{$IFDEF CLR}
|
|
Data: TBytes;
|
|
{$ENDIF}
|
|
begin
|
|
Field := TOLEDBFieldDesc(FIRecordSet.FindField(FieldDesc.Name));
|
|
if (Field <> nil) and Field.IsTimestamp and (Field.TableInfo <> nil) then begin
|
|
{$IFDEF CLR}
|
|
Data := TBytes(Value);
|
|
System.Array.Reverse(Data, 0, SizeOf(Int64));
|
|
Val := BitConverter.ToInt64(Data, 0);
|
|
{$ELSE}
|
|
Val := Int64(TVarData(Value).VArray.Data^);
|
|
Reverse8(@Val);
|
|
{$ENDIF}
|
|
if {$IFDEF VER7P}UInt64{$ENDIF}(TOLEDBTableInfo(Field.TableInfo).MaxTimestamp) < {$IFDEF VER7P}UInt64{$ENDIF}(Val) then
|
|
TOLEDBTableInfo(Field.TableInfo).MaxTimestamp := Val;
|
|
end;
|
|
end;
|
|
|
|
{ TMSUpdateSQL }
|
|
|
|
function TMSUpdateSQL.DataSetClass: TCustomDADataSetClass;
|
|
begin
|
|
Result := TCustomMSDataSet;
|
|
end;
|
|
|
|
function TMSUpdateSQL.SQLClass: TCustomDASQLClass;
|
|
begin
|
|
Result := TMSSQL;
|
|
end;
|
|
|
|
{ TMSQuery }
|
|
|
|
procedure TMSQuery.SetIRecordSet(Value: TData);
|
|
begin
|
|
inherited;
|
|
|
|
FIRecordSet := TOLEDBRecordSet(Value);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetCursorType(const Value: TMSCursorType);
|
|
begin
|
|
if FCursorType <> Value then begin
|
|
CheckInactive;
|
|
FieldDefs.Updated := False;
|
|
FCursorType := Value;
|
|
if FIRecordSet <> nil then
|
|
FIRecordSet.SetProp(prCursorType, Integer(CursorType));
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetCommandTimeout(const Value: integer);
|
|
begin
|
|
if FCommandTimeout <> Value then begin
|
|
FCommandTimeout := Value;
|
|
if FIRecordSet <> nil then
|
|
FIRecordSet.SetProp(prCommandTimeout, FCommandTimeout);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.BreakExec;
|
|
begin
|
|
Assert(FICommand <> nil);
|
|
if FICommand.Executing then
|
|
FICommand.BreakExec;
|
|
FIRecordSet.BreakFetch;
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.RefreshQuick(const CheckDeleted: boolean);
|
|
begin
|
|
InternalRefreshQuick(CheckDeleted);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.CheckInactive;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
function TCustomMSDataSet.GetUpdateObject: TMSUpdateSQL;
|
|
begin
|
|
Result := TMSUpdateSQL(inherited UpdateObject);
|
|
end;
|
|
|
|
procedure TCustomMSDataSet.SetUpdateObject(Value: TMSUpdateSQL);
|
|
begin
|
|
inherited UpdateObject := Value;
|
|
end;
|
|
|
|
{ TMSTable }
|
|
|
|
function TCustomMSTable.PSGetTableName: string;
|
|
begin
|
|
Result := TableName;
|
|
end;
|
|
|
|
procedure TCustomMSTable.PSSetParams(AParams: DB.TParams);
|
|
var
|
|
St: string;
|
|
i: integer;
|
|
begin
|
|
if (Params.Count <> AParams.Count) then begin
|
|
SQL.Text := '';
|
|
St := '';
|
|
|
|
for i := 0 to AParams.count - 1 do begin
|
|
if St <> '' then
|
|
St := St + ' AND ';
|
|
St := AParams[i].Name + ' = :' + AParams[i].Name;
|
|
end;
|
|
|
|
PrepareSQL;
|
|
|
|
if St <> '' then
|
|
AddWhere(St);
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
{$IFDEF VER5P}
|
|
|
|
procedure TCustomMSTable.PSSetCommandText(const CommandText: string);
|
|
begin
|
|
if CommandText <> '' then
|
|
TableName := CommandText;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TCustomMSTable.SetTableName(const Value: string);
|
|
begin
|
|
if not (csReading in ComponentState) then
|
|
Active := False;
|
|
FTableName := UnbracketIfPossible(Trim(Value));
|
|
|
|
SQL.Clear;
|
|
end;
|
|
|
|
procedure TCustomMSTable.SetOrderFields(Value: string);
|
|
var
|
|
OldActive: boolean;
|
|
begin
|
|
Value := Trim(Value);
|
|
if Value <> FOrderFields then begin
|
|
FOrderFields := Value;
|
|
OldActive := Active;
|
|
if not (csLoading in ComponentState) then
|
|
SQL.Text := '';
|
|
|
|
if OldActive then
|
|
Open;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSTable.PrepareSQL;
|
|
var
|
|
St: string;
|
|
MasterPos: integer;
|
|
MasterName: string;
|
|
Param: TDAParam;
|
|
begin
|
|
//WAR TCustomMSStoredProc.PrepareSQL and TCustomMSTable.PrepareSQL is based on different principies and work in different ways
|
|
if TableName = '' then
|
|
DatabaseError(STableNameNotDefined);
|
|
|
|
if SQL.Count = 0 then begin
|
|
St := 'SELECT * FROM ' + BracketIfNeed(TableName);
|
|
|
|
if OrderFields <> '' then
|
|
St := St + ' ORDER BY ' + OrderFields;
|
|
|
|
SQL.Text := St;
|
|
end;
|
|
|
|
// CR 8883
|
|
// for TMSQuery second MD-way is more useful
|
|
if (DataSource <> nil) and (FMasterFields <> '') and (FDetailFields <> '') and not DataSource.DataSet.Active// see TCustomDADataSet.GetFinalSQL
|
|
then begin
|
|
MasterPos := 1;
|
|
while True do begin
|
|
MasterName := ExtractFieldName(FMasterFields, MasterPos);
|
|
if MasterName <> '' then begin
|
|
Param := Params.FindParam(MasterName);
|
|
if Param <> nil then
|
|
Param.DataType := ftString;
|
|
end
|
|
else
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSTable.Prepare;
|
|
begin
|
|
PrepareSQL;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSTable.OpenCursor(InfoQuery: boolean);
|
|
begin
|
|
PrepareSQL;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSTable.Execute;
|
|
begin
|
|
PrepareSQL;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSTable.AssignTo(Dest: TPersistent);
|
|
begin
|
|
inherited;
|
|
|
|
if Dest is TCustomMSTable then begin
|
|
TCustomMSTable(Dest).OrderFields := OrderFields;
|
|
TCustomMSTable(Dest).TableName := TableName;
|
|
TCustomMSTable(Dest).MasterSource := MasterSource;
|
|
TCustomMSTable(Dest).MasterFields := MasterFields;
|
|
TCustomMSTable(Dest).DetailFields := DetailFields;
|
|
end;
|
|
end;
|
|
|
|
{ TCustomMSStoredProc }
|
|
|
|
{$IFDEF VER5P}
|
|
|
|
procedure TCustomMSStoredProc.PSSetCommandText(const CommandText: string);
|
|
begin
|
|
if CommandText <> '' then
|
|
StoredProcName := CommandText;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TCustomMSStoredProc.SetIRecordSet(Value: TData);
|
|
begin
|
|
inherited;
|
|
|
|
if FICommand <> nil then
|
|
FICommand.SetProp(prIsSProc, True);
|
|
end;
|
|
|
|
procedure TCustomMSStoredProc.SetStoredProcName(const Value: string);
|
|
begin
|
|
if Value <> FStoredProcName then begin
|
|
SQL.Text := '';
|
|
|
|
FStoredProcName := Trim(Value);
|
|
|
|
if (Connection <> nil) and Connection.Connected and (FStoredProcName <> '') then
|
|
PrepareSQL;
|
|
|
|
if FICommand <> nil then
|
|
FICommand.SetProp(prIsSProc, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSStoredProc.PrepareSQL;
|
|
begin
|
|
//WAR TCustomMSStoredProc.PrepareSQL and TCustomMSTable.PrepareSQL is based on different principies and work in different ways
|
|
|
|
if SQL.Text = '' then begin
|
|
if StoredProcName = '' then
|
|
DatabaseError(SStoredProcNotDefined);
|
|
|
|
InternalCreateProcCall(StoredProcName, Params.Count = 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSStoredProc.Prepare;
|
|
begin
|
|
PrepareSQL;
|
|
|
|
FIsInPrepare := True;
|
|
try
|
|
inherited;
|
|
finally
|
|
FIsInPrepare := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomMSStoredProc.BeforeExecute;
|
|
begin
|
|
if not Prepared then
|
|
PrepareSQL;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSStoredProc.BeforeOpenCursor(InfoQuery: boolean);
|
|
begin
|
|
PrepareSQL;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSStoredProc.CreateFieldDefs;
|
|
begin
|
|
if not FIsInPrepare then
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomMSStoredProc.ExecProc;
|
|
begin
|
|
Execute;
|
|
end;
|
|
|
|
procedure TCustomMSStoredProc.AssignTo(Dest:TPersistent);
|
|
var
|
|
I: Integer;
|
|
P: TMSParam;
|
|
begin
|
|
inherited;
|
|
|
|
if Dest is TCustomMSStoredProc then begin
|
|
TCustomMSStoredProc(Dest).StoredProcName := FStoredProcName;
|
|
|
|
for I := 0 to Params.Count - 1 do begin
|
|
P := TCustomMSStoredProc(Dest).FindParam(Params[I].Name);
|
|
if (P <> nil) and (P.DataType = Params[I].DataType) then begin
|
|
P.Assign(Params[I]);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TMSMetadata }
|
|
|
|
constructor TMSMetadata.Create(Owner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
Debug := False;
|
|
|
|
ReadOnly := True;
|
|
end;
|
|
|
|
|
|
procedure TMSMetadata.SetDatabaseName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FDatabaseName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetSchemaName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FSchemaName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetObjectType(Value: TMSObjectType);
|
|
begin
|
|
Active := False;
|
|
FieldDefs.Updated := False;
|
|
FObjectType := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetTableName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FTableName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetStoredProcName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FStoredProcName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetColumnName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FColumnName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetIndexName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FIndexName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetConstraintName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FConstraintName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetLinkedServer(Value: string);
|
|
begin
|
|
Active := False;
|
|
FLinkedServer := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetAssemblyName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FAssemblyName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetAssemblyID(Value: integer);
|
|
begin
|
|
Active := False;
|
|
FAssemblyID := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetReferencedAssemblyID(Value: integer);
|
|
begin
|
|
Active := False;
|
|
FReferencedAssemblyID := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetUDTName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FUDTName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetSchemaCollectionName(Value: string);
|
|
begin
|
|
Active := False;
|
|
FSchemaCollectionName := Value;
|
|
end;
|
|
|
|
procedure TMSMetadata.SetTargetNamespaceURI(Value: string);
|
|
begin
|
|
Active := False;
|
|
FTargetNamespaceURI := Value;
|
|
end;
|
|
|
|
function TMSMetadata.RequestIRowset: IRowset;
|
|
function GetTableType: string;
|
|
begin
|
|
case ObjectType of
|
|
otAliases, otAliasesInfo:
|
|
Result := 'ALIAS';
|
|
otTables, otTablesInfo:
|
|
Result := 'TABLE';
|
|
otSynonyms, otSynonymsInfo:
|
|
Result := 'SYNONYM';
|
|
otSystemTables, otSystemTablesInfo:
|
|
Result := 'SYSTEM TABLE';
|
|
otViews, otViewsInfo:
|
|
Result := 'VIEW';
|
|
otGlobalTempTables, otGlobalTempTablesInfo:
|
|
Result := 'GLOBAL TEMPORARY';
|
|
otLocalTempTables, otLocalTempTablesInfo:
|
|
Result := 'LOCAL TEMPORARY';
|
|
otSystemViews, otSystemViewsInfo:
|
|
Result := 'SYSTEM VIEW';
|
|
otExternalTablesInfo:
|
|
Result := 'EXTERNAL TABLE';
|
|
end;
|
|
end;
|
|
|
|
var
|
|
Schema: TGUID;
|
|
rgRestrictions: TRestrictions;
|
|
begin
|
|
BeginConnection;
|
|
try
|
|
case ObjectType of
|
|
otDatabases:
|
|
begin
|
|
SetLength(rgRestrictions, 1);
|
|
Schema := DBSCHEMA_CATALOGS;
|
|
rgRestrictions[0] := DatabaseName;
|
|
end;
|
|
otColumnPrivileges:
|
|
begin
|
|
SetLength(rgRestrictions, 6);
|
|
Schema := DBSCHEMA_COLUMN_PRIVILEGES;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
rgRestrictions[2] := TableName;
|
|
rgRestrictions[4 - 1] := ColumnName;
|
|
end;
|
|
otColumns:
|
|
begin
|
|
SetLength(rgRestrictions, 4);
|
|
Schema := DBSCHEMA_COLUMNS;
|
|
if Connection.Options.Provider <> prCompact then begin
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
end;
|
|
rgRestrictions[2] := TableName;
|
|
rgRestrictions[4 - 1] := ColumnName;
|
|
end;
|
|
otForeignKeys:
|
|
begin
|
|
SetLength(rgRestrictions, 6);
|
|
rgRestrictions[3] := DatabaseName;
|
|
rgRestrictions[4] := SchemaName;
|
|
rgRestrictions[5] := TableName;
|
|
Schema := DBSCHEMA_FOREIGN_KEYS;
|
|
end;
|
|
otPrimaryKeys:
|
|
begin
|
|
if Connection.Options.Provider <> prCompact then begin
|
|
SetLength(rgRestrictions, 3);
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
rgRestrictions[2] := TableName;
|
|
Schema := DBSCHEMA_PRIMARY_KEYS;
|
|
end
|
|
else begin
|
|
SetLength(rgRestrictions, 7);
|
|
rgRestrictions[2] := ConstraintName;
|
|
rgRestrictions[5] := TableName;
|
|
// Other Restriction columns not supported
|
|
Schema := DBSCHEMA_KEY_COLUMN_USAGE;
|
|
end;
|
|
end;
|
|
otIndexes:
|
|
begin
|
|
SetLength(rgRestrictions, 5);
|
|
if Connection.Options.Provider <> prCompact then begin
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
end;
|
|
rgRestrictions[2] := IndexName;
|
|
rgRestrictions[4] := TableName;
|
|
Schema := DBSCHEMA_INDEXES;
|
|
end;
|
|
otServerTypes:
|
|
begin
|
|
SetLength(rgRestrictions, 0);
|
|
Schema := DBSCHEMA_PROVIDER_TYPES;
|
|
end;
|
|
otSchemata:
|
|
begin
|
|
SetLength(rgRestrictions, 2);
|
|
Schema := DBSCHEMA_SCHEMATA;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
end;
|
|
otStatistics:
|
|
begin
|
|
SetLength(rgRestrictions, 3);
|
|
Schema := DBSCHEMA_STATISTICS;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
rgRestrictions[2] := TableName;
|
|
end;
|
|
otStoredProcs:
|
|
begin
|
|
SetLength(rgRestrictions, 3);
|
|
Schema := DBSCHEMA_PROCEDURES;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
rgRestrictions[2] := StoredProcName;
|
|
end;
|
|
otStoredProcParams:
|
|
begin
|
|
SetLength(rgRestrictions, 3);
|
|
Schema := DBSCHEMA_PROCEDURE_PARAMETERS;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
rgRestrictions[2] := StoredProcName;
|
|
end;
|
|
otAliases, otTables, otSynonyms, otSystemTables, otViews, otGlobalTempTables, otLocalTempTables, otSystemViews,
|
|
otAliasesInfo, otTablesInfo, otSynonymsInfo, otSystemTablesInfo, otViewsInfo, otGlobalTempTablesInfo, otLocalTempTablesInfo, otExternalTablesInfo, otSystemViewsInfo:
|
|
begin
|
|
SetLength(rgRestrictions, 4);
|
|
|
|
if ObjectType in [otAliases, otTables, otSynonyms, otSystemTables, otViews, otGlobalTempTables, otLocalTempTables, otSystemViews] then
|
|
Schema := DBSCHEMA_TABLES
|
|
else
|
|
Schema := DBSCHEMA_TABLES_INFO;
|
|
if Connection.Options.Provider <> prCompact then begin
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
end;
|
|
rgRestrictions[2] := TableName;
|
|
rgRestrictions[3] := GetTableType;
|
|
end;
|
|
otTableConstraints:
|
|
begin
|
|
SetLength(rgRestrictions, 6);
|
|
Schema := DBSCHEMA_TABLE_CONSTRAINTS;
|
|
if Connection.Options.Provider <> prCompact then begin
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
end;
|
|
rgRestrictions[2] := ConstraintName;
|
|
rgRestrictions[5] := TableName;
|
|
end;
|
|
otTablePrivileges:
|
|
begin
|
|
SetLength(rgRestrictions, 3);
|
|
Schema := DBSCHEMA_TABLE_PRIVILEGES;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
rgRestrictions[2] := TableName;
|
|
end;
|
|
otLinkedServers: begin
|
|
SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_LINKEDSERVERS{1});
|
|
Schema := DBSCHEMA_LINKEDSERVERS;
|
|
rgRestrictions[0] := LinkedServer;
|
|
end;
|
|
otAssemblies: begin
|
|
SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_SQL_ASSEMBLIES{4});
|
|
Schema := DBSCHEMA_SQL_ASSEMBLIES;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
rgRestrictions[2] := AssemblyName;
|
|
if AssemblyID <> 0 then
|
|
rgRestrictions[3] := AssemblyID;
|
|
end;
|
|
otAssemblyDependencies: begin
|
|
SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_SQL_ASSEMBLY_DEPENDENCIES{4});
|
|
Schema := DBSCHEMA_SQL_ASSEMBLY_DEPENDENCIES;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
if AssemblyID <> 0 then
|
|
rgRestrictions[2] := AssemblyID;
|
|
if ReferencedAssemblyID <> 0 then
|
|
rgRestrictions[3] := ReferencedAssemblyID;
|
|
end;
|
|
otUserTypes: begin
|
|
SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_SQL_USER_TYPES{3});
|
|
Schema := DBSCHEMA_SQL_USER_TYPES;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
rgRestrictions[2] := UDTName;
|
|
end;
|
|
otXMLCollections: begin
|
|
SetLength(rgRestrictions, CRESTRICTIONS_DBSCHEMA_XML_COLLECTIONS{4});
|
|
Schema := DBSCHEMA_XML_COLLECTIONS;
|
|
rgRestrictions[0] := DatabaseName;
|
|
rgRestrictions[1] := SchemaName;
|
|
rgRestrictions[2] := SchemaCollectionName;
|
|
rgRestrictions[3] := TargetNamespaceURI;
|
|
end;
|
|
end;
|
|
|
|
Result := FIRecordSet.GetSchemaRowset(Schema, rgRestrictions);
|
|
finally
|
|
EndConnection;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSMetadata.InternalExecute;
|
|
var
|
|
Rowset: IRowset;
|
|
begin
|
|
Rowset := RequestIRowset;
|
|
FIRecordSet.SetIRowset(Rowset, False);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMSMetadata.OpenCursor(InfoQuery: boolean);
|
|
var
|
|
Rowset: IRowset;
|
|
begin
|
|
Rowset := RequestIRowset;
|
|
FIRecordSet.SetIRowset(Rowset, False);
|
|
inherited;
|
|
end;
|
|
|
|
{ TMSSQL }
|
|
|
|
constructor TMSSQL.Create(Owner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
FAutoCommit := True;
|
|
FCommandTimeout := 0;
|
|
Macros.SetParserClass(TMSParser);
|
|
end;
|
|
|
|
function TMSSQL.GetPermitPrepare: boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TMSSQL.SetPermitPrepare(Value: boolean);
|
|
begin
|
|
end;
|
|
|
|
procedure TMSSQL.CreateICommand;
|
|
begin
|
|
inherited;
|
|
|
|
if FICommand = nil then
|
|
SetICommand(TOLEDBCommand.Create);
|
|
end;
|
|
|
|
procedure TMSSQL.SetICommand(Value: TCRCommand);
|
|
begin
|
|
FICommand := TOLEDBCommand(Value);
|
|
|
|
if FICommand <> nil then begin
|
|
FICommand.SetProp(prCommandTimeout, CommandTimeout);
|
|
FICommand.ReadParams := ReadParams;
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMSSQL.InternalPrepare;
|
|
begin
|
|
if SQL.Count = 0 then
|
|
DatabaseError(SEmptySQLStatement, Self);
|
|
|
|
WriteParams;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMSSQL.InternalExecute(Iters: integer);
|
|
begin
|
|
inherited;
|
|
FICommand.SetCursorState(csInactive); // To prevent blocking execute on second exec
|
|
end;
|
|
|
|
function TMSSQL.GetConnection: TMSConnection;
|
|
begin
|
|
Result := TMSConnection(inherited Connection);
|
|
end;
|
|
|
|
procedure TMSSQL.SetConnection(Value: TMSConnection);
|
|
begin
|
|
inherited Connection := Value;
|
|
end;
|
|
|
|
function TMSSQL.GetParams: TMSParams;
|
|
begin
|
|
Result := TMSParams(inherited Params);
|
|
end;
|
|
|
|
procedure TMSSQL.SetParams(Value: TMSParams);
|
|
begin
|
|
inherited Params := Value;
|
|
end;
|
|
|
|
procedure TMSSQL.AssignTo(Dest: TPersistent);
|
|
begin
|
|
inherited;
|
|
|
|
if Dest is TMSSQL then begin
|
|
TMSSQL(Dest).Params.Assign(Params);
|
|
TMSSQL(Dest).NonBlocking := NonBlocking;
|
|
TMSSQL(Dest).AfterExecute := AfterExecute;
|
|
end;
|
|
end;
|
|
|
|
function TMSSQL.ParseSQL(const SQL: string; Params: TDAParams; RenamePrefix: string = ''): string;
|
|
begin
|
|
{$IFDEF CLR}
|
|
if SQL.IndexOf(Char(':')) = -1 then
|
|
{$ELSE}
|
|
if StrScan(PChar(SQL), ':') = nil then
|
|
{$ENDIF}
|
|
Result := SQL // query without parameters
|
|
else
|
|
Result := inherited ParseSQL(SQL, Params, RenamePrefix);
|
|
end;
|
|
|
|
function TMSSQL.CreateParser(const Text: string): TParser;
|
|
begin
|
|
Result := TMSParser.Create(Text);
|
|
end;
|
|
|
|
procedure TMSSQL.AssembleSQL;
|
|
begin
|
|
if ParamCheck or (csDesigning in ComponentState) then
|
|
inherited
|
|
else begin
|
|
FNativeSQL := SQL.Text;
|
|
FNativeSQL := ParseSQL(nil);
|
|
FICommand.SetSQL(FNativeSQL);
|
|
end;
|
|
end;
|
|
|
|
function TMSSQL.CreateParamsObject: TDAParams;
|
|
begin
|
|
Result := TMSParams.Create(Self);
|
|
end;
|
|
|
|
procedure TMSSQL.CreateParams;
|
|
var
|
|
ParamDesc: TOLEDBParamDesc;
|
|
i: integer;
|
|
begin
|
|
Params.BeginUpdate;
|
|
try
|
|
Params.Clear;
|
|
for i := 0 to FICommand.GetParamCount - 1 do begin
|
|
ParamDesc := FICommand.GetParam(i);
|
|
with Params.Add as TDAParam do begin
|
|
Name := ParamDesc.GetName;
|
|
DataType := GetFieldType(ParamDesc.GetDataType);
|
|
ParamType := TParamType(ParamDesc.GetParamType);
|
|
end;
|
|
end;
|
|
finally
|
|
Params.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSSQL.WriteParams(WriteValue: boolean = True);
|
|
var
|
|
Param: TMSParam;
|
|
ParamDesc: TOLEDBParamDesc;
|
|
dt: word;
|
|
|
|
procedure WriteParamValue;
|
|
var
|
|
Value: Variant;
|
|
{$IFDEF CLR}
|
|
Value1, Value2: TBytes;
|
|
{$ELSE}
|
|
Value1: Variant;
|
|
{$ENDIF}
|
|
i, l: integer;
|
|
s: string;
|
|
CurrentConnection: TMSConnection;
|
|
begin
|
|
if not Param.Bound then
|
|
TOLEDBParamDesc(ParamDesc).SetUseDefaultValue(True);
|
|
|
|
if Param.IsObjectDataType then begin
|
|
ParamDesc.SetNull(Param.IsNull);
|
|
ParamDesc.SetObject(Param.ParamObject);
|
|
Exit;
|
|
end;
|
|
|
|
Value := Param.Value;
|
|
if (Param.DataType = ftDate) and not (VarIsEmpty(Value) or VarIsNull(Value)) then
|
|
Value := Int(Value); // drop time info
|
|
|
|
// SQL Server Everywhere
|
|
CurrentConnection := Connection;
|
|
if (CurrentConnection = nil) and (FDataSet <> nil) then
|
|
CurrentConnection := TMSConnection(FDataSet.Connection);
|
|
|
|
Assert(CurrentConnection <> nil);
|
|
|
|
if (CurrentConnection.Options.Provider = prCompact) and (Param.OLEDBType = DBTYPE_UI1) then
|
|
ParamDesc.SetDataType(dtInt8);
|
|
|
|
// Convert param values if need
|
|
if (dt in [dtBytes, dtVarBytes, dtBlob])
|
|
and (VarType(Value) <> varArray + varByte) then
|
|
case VarType(Value) of
|
|
varEmpty, varNull:;
|
|
varShortInt {1 byte},
|
|
varSmallint {2 bytes},
|
|
varInteger {4 bytes},
|
|
varInt64 {8 bytes},
|
|
varByte {1 byte},
|
|
varWord {2 bytes},
|
|
varLongWord {4 bytes}: begin
|
|
case VarType(Value) of
|
|
varShortInt, varByte:
|
|
l := 1;
|
|
varSmallint, varWord:
|
|
l := 2;
|
|
varInteger, varLongWord:
|
|
l := 4;
|
|
varInt64:
|
|
l := 8;
|
|
else
|
|
begin
|
|
Assert(False);
|
|
l := - 1;
|
|
end;
|
|
end;
|
|
|
|
// reverse bytes order
|
|
{$IFDEF CLR}
|
|
Value1 := BitConverter.GetBytes(Int64(Value));
|
|
//Assert(l = Length(Value1));
|
|
SetLength(Value2, l);
|
|
for i := 0 to l - 1 do
|
|
Value2[i] := Value1[l - 1 - i];
|
|
Value := Value2;
|
|
{$ELSE}
|
|
Value1 := VarArrayCreate([0, l - 1], varByte);
|
|
|
|
for i := 0 to l - 1 do
|
|
PChar(TVarData(Value1).VArray.Data)[i] := PChar(@TVarData(Value).VInteger)[l - 1 - i];
|
|
Value := Unassigned;
|
|
Value := Value1;
|
|
{$ENDIF}
|
|
end;
|
|
varString{$IFDEF CLR}, varChar{$ENDIF}: begin
|
|
s := Value;
|
|
Value := Encoding.Default.GetBytes(s);
|
|
end;
|
|
end;
|
|
ParamDesc.SetValue(Unassigned);
|
|
ParamDesc.SetValue(Value);
|
|
end;
|
|
|
|
var
|
|
ft: TFieldType;
|
|
i, l: integer;
|
|
begin
|
|
for i := 0 to Params.Count - 1 do begin
|
|
Param := Params[i] as TMSParam;
|
|
if i < FICommand.GetParamCount then
|
|
ParamDesc := TOLEDBParamDesc(FICommand.GetParam(i))
|
|
else
|
|
ParamDesc := TOLEDBParamDesc(FICommand.AddParam);
|
|
ParamDesc.SetName(Param.Name);
|
|
|
|
ft := Param.DataType;
|
|
dt := GetDataType(ft);
|
|
if dt = dtUnknown then
|
|
case ft of
|
|
{$IFDEF VER5P}
|
|
ftGuid:
|
|
dt := dtGuid;
|
|
{$ENDIF}
|
|
ftUnknown:
|
|
dt := dtUnknown;
|
|
ftBCD:
|
|
dt := dtBCD;
|
|
ftWideString:
|
|
dt := dtWideString;
|
|
else
|
|
dt := dtString;
|
|
// Assert(False, Format('Invalid Param.DataType - %d', [Integer(ft)]));
|
|
end;
|
|
|
|
Assert(Param is TMSParam, 'Param must be TMSParam');
|
|
l := TMSParam(Param).Size;
|
|
ParamDesc.SetSize(l);
|
|
|
|
ParamDesc.SetDataType(dt);
|
|
ParamDesc.SetParamType(TParamDirection(Param.ParamType));
|
|
ParamDesc.SetOLEDBType(Param.OLEDBType);
|
|
|
|
if WriteValue then
|
|
WriteParamValue;
|
|
end;
|
|
while Params.Count < FICommand.GetParamCount do
|
|
FICommand.DeleteParam(FICommand.GetParamCount - 1);
|
|
end;
|
|
|
|
procedure TMSSQL.ReadParams;
|
|
var
|
|
v: Variant;
|
|
begin
|
|
if FICommand.IUnknownIsNull and FICommand.IMultipleResultsIsNull then begin
|
|
FICommand.GetProp(prCanReadParams, v);
|
|
if Boolean(v) then begin
|
|
inherited;
|
|
FICommand.SetProp(prCanReadParams, False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TMSSQL.FindParam(const Value: string): TMSParam;
|
|
begin
|
|
Result := inherited FindParam(GetParamNameWODog(Value)) as TMSParam;
|
|
end;
|
|
|
|
function TMSSQL.ParamByName(const Value: string): TMSParam;
|
|
begin
|
|
Result := inherited ParamByName(GetParamNameWODog(Value)) as TMSParam;
|
|
end;
|
|
|
|
procedure TMSSQL.SetCommandTimeout(const Value: integer);
|
|
begin
|
|
if FCommandTimeout <> Value then begin
|
|
FCommandTimeout := Value;
|
|
if FICommand <> nil then
|
|
FICommand.SetProp(prCommandTimeout, FCommandTimeout);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSSQL.SetNonBlocking(const Value: boolean);
|
|
begin
|
|
if FNonBlocking <> Value then begin
|
|
FNonBlocking := Value;
|
|
if FICommand <> nil then
|
|
FICommand.SetProp(prNonBlocking, FNonBlocking);
|
|
end;
|
|
end;
|
|
|
|
procedure TMSSQL.Execute(Iters: integer);
|
|
begin
|
|
if NonBlocking and Executing then
|
|
DatabaseError(SAsynchExecuting);
|
|
|
|
inherited Execute(Iters);
|
|
end;
|
|
|
|
procedure TMSSQL.BreakExec;
|
|
begin
|
|
Assert(FICommand <> nil);
|
|
FICommand.BreakExec;
|
|
end;
|
|
|
|
procedure TMSSQL.CreateProcCall(Name: string);
|
|
var
|
|
NeedDescribe: boolean;
|
|
ParamDescs: TParamDescs;
|
|
ParamDesc: CRAccess.TParamDesc;
|
|
|
|
Param: TMSParam;
|
|
ParamType: TParamType;
|
|
IsNewParam: boolean;
|
|
ft: TFieldType;
|
|
i: integer;
|
|
|
|
ProcCallSQL: string;
|
|
begin
|
|
BeginConnection;
|
|
try
|
|
NeedDescribe := Params.Count = 0;
|
|
if NeedDescribe then begin
|
|
ProcCallSQL := FICommand.CreateProcCall(Name, True, True, False, False);
|
|
CreateParams;
|
|
end
|
|
else begin
|
|
WriteParams(False);
|
|
ProcCallSQL := FICommand.CreateProcCall(Name, False, True, False, False);
|
|
end;
|
|
|
|
if NeedDescribe and (Params <> nil) then begin
|
|
ParamDescs := TOLEDBCommand(FICommand).Params;
|
|
for i := 0 to ParamDescs.Count - 1 do begin
|
|
ParamDesc := ParamDescs[i];
|
|
ParamType := ConvertCRParamTypeToBDE(ParamDesc.GetParamType);
|
|
|
|
Param := Params.FindParam(ParamDesc.GetName);
|
|
IsNewParam := Param = nil;
|
|
if IsNewParam then
|
|
Param := TMSParam.Create(Params, ParamType);
|
|
|
|
Param.ParamType := ParamType;
|
|
ft := GetFieldType(ParamDesc.GetDataType);
|
|
if ft <> Param.DataType then
|
|
Param.DataType := ft; // To prevent clearing Param.Value on set DataType
|
|
Param.Name := ParamDesc.GetName;
|
|
if IsNewParam then
|
|
Param.Value := ParamDesc.GetValue;
|
|
Param.Size := ParamDesc.GetSize;
|
|
end;
|
|
|
|
FICommand.SetProp(prDisableParamScan, True);
|
|
try
|
|
SQL.Text := ProcCallSQL;
|
|
finally
|
|
FICommand.SetProp(prDisableParamScan, False);
|
|
end;
|
|
end;
|
|
finally
|
|
EndConnection;
|
|
end;
|
|
end;
|
|
|
|
{ TMSXMLField }
|
|
|
|
constructor TMSXMLField.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
SetDataType(TFieldType(ftMSXML));
|
|
end;
|
|
|
|
procedure TMSXMLField.GetText(var Text: string; DisplayText: Boolean);
|
|
begin
|
|
Text := '(xml)';
|
|
if not GetIsNull then
|
|
Text := AnsiUpperCase(Text);
|
|
end;
|
|
|
|
procedure TMSXMLField.SetSchemaCollection(Name, CatalogName, SchemaName: string);
|
|
begin
|
|
FSchemaCollection.Name := Name;
|
|
FSchemaCollection.CatalogName := CatalogName;
|
|
FSchemaCollection.SchemaName := SchemaName;
|
|
FTyped := (FSchemaCollection.Name <> '') or (FSchemaCollection.CatalogName <> '') or
|
|
(FSchemaCollection.SchemaName <> '');
|
|
end;
|
|
|
|
function TMSXMLField.GetBlobSize: Integer;
|
|
begin
|
|
with DataSet.CreateBlobStream(Self, bmRead) do
|
|
try
|
|
Result := Size;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSXMLField.Clear;
|
|
begin
|
|
DataSet.CreateBlobStream(Self, bmWrite).Free;
|
|
end;
|
|
|
|
class function TMSXMLField.IsBlob: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TMSXMLField.LoadFromFile(const FileName: string);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmOpenRead);
|
|
try
|
|
LoadFromStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSXMLField.LoadFromStream(Stream: TStream);
|
|
begin
|
|
with DataSet.CreateBlobStream(Self, bmWrite) do
|
|
try
|
|
CopyFrom(Stream, 0);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSXMLField.SaveToFile(const FileName: string);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSXMLField.SaveToStream(Stream: TStream);
|
|
var
|
|
BlobStream: TStream;
|
|
begin
|
|
BlobStream := DataSet.CreateBlobStream(Self, bmRead);
|
|
try
|
|
Stream.CopyFrom(BlobStream, 0);
|
|
finally
|
|
BlobStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMSXMLField.SetFieldType(Value: TFieldType);
|
|
begin
|
|
SetDataType(Value);
|
|
end;
|
|
|
|
{ TMSAccessUtils }
|
|
|
|
class procedure TMSAccessUtils.GetKeyAndDataFields(
|
|
Obj: TCustomMSDataSet;
|
|
out KeyAndDataFields: TKeyAndDataFields;
|
|
const ForceUseAllKeyFields: boolean);
|
|
begin
|
|
Obj.GetKeyAndDataFields(KeyAndDataFields, ForceUseAllKeyFields);
|
|
end;
|
|
|
|
class procedure TMSAccessUtils.SetDesigning(Obj: TCustomMSDataSet; Value: Boolean; SetChildren: Boolean = True);
|
|
begin
|
|
Obj.SetDesigning(Value, SetChildren);
|
|
end;
|
|
|
|
class procedure TMSAccessUtils.SetLockLoginPromt(Obj: TMSConnection; Value: Boolean);
|
|
begin
|
|
Obj.FLockLoginPrompt := Value;
|
|
end;
|
|
|
|
class function TMSAccessUtils.FIConnection(Obj: TMSConnection): TOLEDBConnection;
|
|
begin
|
|
Result := Obj.IConnection;
|
|
end;
|
|
|
|
class function TMSAccessUtils.FIRecordSet(Obj: TCustomMSDataSet): TOLEDBRecordSet;
|
|
begin
|
|
Result := Obj.FIRecordSet;
|
|
end;
|
|
|
|
class function TMSAccessUtils.GetOLEDBSQL(Obj: TCustomMSDataSet): string;
|
|
begin
|
|
Result := Obj.FICommand.SQL;
|
|
end;
|
|
|
|
class function TMSAccessUtils.GetOLEDBSQL(Obj: TMSSQL): string;
|
|
begin
|
|
Result := Obj.FICommand.SQL;
|
|
end;
|
|
|
|
type
|
|
_TOLEDBConnection = class(TOLEDBConnection);
|
|
|
|
class function TMSAccessUtils.FIDBCreateSession(Obj: TOLEDBConnection): IDBCreateSession;
|
|
begin
|
|
Result := _TOLEDBConnection(Obj).FIDBCreateSession;
|
|
end;
|
|
|
|
class procedure TMSAccessUtils.DoError(Obj: TMSConnection; E: Exception; var Fail: boolean);
|
|
begin
|
|
Assert(Obj.IConnection <> nil);
|
|
_TOLEDBConnection(Obj.IConnection).DoError(E, Fail);
|
|
end;
|
|
|
|
initialization
|
|
__UseUpdateOptimization := True;
|
|
|
|
try
|
|
TMSConnectionPoolManager.Clear;
|
|
except
|
|
end;
|
|
|
|
if
|
|
{$IFDEF CLR}
|
|
CompareText(Assembly.GetCallingAssembly.GetName.Name, 'CoreLab.Sdac') = 0
|
|
{$ELSE}
|
|
not IsLibrary
|
|
{$ENDIF}
|
|
then
|
|
Classes.RegisterClass(TMSXMLField);
|
|
|
|
finalization
|
|
|
|
end.
|