sqlserveruniprovider.pas

来自「CrLab UniDAC 1.0 include sources」· PAS 代码 · 共 290 行

{$IFNDEF CLR}
{$I Sdac.inc}
unit SQLServerUniProvider;
{$ENDIF}

interface

uses
  SysUtils, Classes, Variants, DB, CRAccess, CRConnectionPool, MemData, MemDS, DBAccess,
  CRParser, DAScript, UniProvider,
{$IFNDEF UNIDACPRO}
  OLEDBAccess;
{$ELSE}
  OLEDBAccessUni;
{$ENDIF}

type
  TSQLServerUniProvider = class(TUniProvider)
  public
    class function GetProviderName: string; override;

    function IsDatabaseSupported: boolean; override;

    function GetParserClass: TParserClass; override;
    function GetConnectionParametersClass: TCRConnectionParametersClass; override;
    function GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass; override;
    function GetConnectionClass: TCRConnectionClass; override;
    function GetServerEnumeratorClass: TCRServerEnumeratorClass; override;    
    function GetTransactionClass: TCRTransactionClass; override;
    function GetCommandClass: TCRCommandClass; override;
    function GetRecordSetClass: TCRRecordSetClass; override;
    function GetDataSetServiceClass: TDADataSetServiceClass; override;
    function GetScriptProcessorClass: TDAScriptProcessorClass; override;
    function GetMetaDataClass: TCRMetaDataClass; override;
    function GetConnectDialogServiceClass: TConnectDialogServiceClass; override;
    function GetDataTypesMap: TDataTypesMapClass; override;

    procedure SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean); override;

    function GetConnectionOptions: TOptionsList; override;
    function GetSQLOptions: TOptionsList; override;
    function GetDataSetOptions: TOptionsList; override;
    function GetScriptOptions: TOptionsList; override;
  end;

  TMSConnectDialogService = class (TConnectDialogService)
  private
    FProvider: TOLEDBProvider;
  public
    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function UseDatabaseHistory: boolean; override;
    function UsernameEnabled: boolean; override;
    function ServerEnabled: boolean; override;
  end;

procedure RegisterComponent;

implementation

uses
  TypInfo,
{$IFNDEF UNIDACPRO}
  MSParser, MSConnectionPool, MSServices, MSScriptProcessor;
{$ELSE}
  MSParserUni, MSConnectionPoolUni, MSServicesUni, MSScriptProcessorUni;
{$ENDIF}

class function TSQLServerUniProvider.GetProviderName: string;
begin
  Result := 'SQL Server';
end;

function TSQLServerUniProvider.IsDatabaseSupported: boolean;
begin
  Result := True;
end;

function TSQLServerUniProvider.GetParserClass: TParserClass;
begin
  Result := TMSParser;
end;

function TSQLServerUniProvider.GetConnectionParametersClass: TCRConnectionParametersClass;
begin
  Result := TMSConnectionParameters;
end;

function TSQLServerUniProvider.GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass;
begin
  Result := TMSConnectionPoolManager;
end;

function TSQLServerUniProvider.GetConnectionClass: TCRConnectionClass;
begin
  Result := TOLEDBConnection;
end;

function TSQLServerUniProvider.GetServerEnumeratorClass: TCRServerEnumeratorClass;
begin
  Result := TMSServerEnumerator;
end;

function TSQLServerUniProvider.GetTransactionClass: TCRTransactionClass;
begin
  Result := TOLEDBTransaction;
end;

function TSQLServerUniProvider.GetCommandClass: TCRCommandClass;
begin
  Result := TOLEDBCommand;
end;

function TSQLServerUniProvider.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TOLEDBRecordSet;
end;

function TSQLServerUniProvider.GetDataSetServiceClass: TDADataSetServiceClass;
begin
  Result := TCustomMSDataSetService;
end;

function TSQLServerUniProvider.GetScriptProcessorClass: TDAScriptProcessorClass;
begin
  Result := TMSScriptProcessor;
end;

function TSQLServerUniProvider.GetMetaDataClass: TCRMetaDataClass;
begin
  Result := TOLEDBMetaData;
end;

function TSQLServerUniProvider.GetConnectDialogServiceClass: TConnectDialogServiceClass;
begin
  Result := TMSConnectDialogService;
end;

function TSQLServerUniProvider.GetDataTypesMap: TDataTypesMapClass;
begin
  Result := TCustomMSDataTypesMap;
end;

procedure TSQLServerUniProvider.SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean);
begin
  if Obj.ClassType = TOLEDBConnection then begin
    TOLEDBConnection(Obj).SetProp(prSetLockTimeout, True);    
    GetConnectionOptions.ImportOptions(Options, Obj, TOLEDBConnection(Obj).SetProp, SetAllProps)
  end  
  else
  if Obj.ClassType = TMSConnectionParameters then
    GetConnectionOptions.ImportOptions(Options, Obj, TMSConnectionParameters(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TMSServerEnumerator then
    GetConnectionOptions.ImportOptions(Options, Obj, TMSServerEnumerator(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TMSConnectDialogService then
    GetConnectionOptions.ImportOptions(Options, Obj, TMSConnectDialogService(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TOLEDBCommand then begin
    TOLEDBCommand(Obj).SetProp(prSensibleBCDMapping, True);    
    GetSQLOptions.ImportOptions(Options, Obj, TOLEDBCommand(Obj).SetProp, SetAllProps);
  end
  else
  if Obj.ClassType = TOLEDBRecordSet then begin
    TOLEDBREcordSet(Obj).GetCommand.SetProp(prSensibleBCDMapping, True);       
    GetDataSetOptions.ImportOptions(Options, Obj, TOLEDBRecordSet(Obj).SetProp, SetAllProps);
    GetDataSetOptions.ImportOptions(Options, TOLEDBRecordSet(Obj).GetCommand, TOLEDBRecordSet(Obj).GetCommand.SetProp, SetAllProps);
  end
  else
  if Obj.ClassType = TCustomMSDataSetService then
    GetDataSetOptions.ImportOptions(Options, Obj, TCustomMSDataSetService(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TMSScriptProcessor then
    GetScriptOptions.ImportOptions(Options, Obj, TMSScriptProcessor(Obj).SetProp, SetAllProps); 
end;

function TSQLServerUniProvider.GetConnectionOptions: TOptionsList;
begin
  if FConnectionOptions = nil then begin

    FConnectionOptions := TOptionsList.Create(GetProviderName);
    FConnectionOptions.Add(TBooleanOption.Create('QuotedIdentifier', prQuotedIdentifier, [TOLEDBConnection, TMSConnectionParameters], True));
    FConnectionOptions.Add(TBooleanOption.Create('Encrypt', prEncrypt, [TOLEDBConnection, TMSConnectionParameters], False));
    FConnectionOptions.Add(TEnumeratorOption.Create('OLEDBProvider', prProvider, [TOLEDBConnection, TMSConnectionParameters, TMSServerEnumerator, TMSConnectDialogService], Variant(prAuto), TypeInfo(TOLEDBProvider)));

    // TMSConnection options
    FConnectionOptions.Add(TEnumeratorOption.Create('Authentication', prAuthentication, [TOLEDBConnection, TMSConnectionParameters], Variant(auServer), TypeInfo(TMSAuthentication)));
    FConnectionOptions.Add(TIntegerOption.Create('ConnectionTimeout', prConnectionTimeout, [TOLEDBConnection], 15));
    FConnectionOptions.Add(TStringOption.Create('Language', prLanguage, [TOLEDBConnection, TMSConnectionParameters], ''));
    FConnectionOptions.Add(TBooleanOption.Create('PersistSecurityInfo', prPersistSecurityInfo, [TOLEDBConnection, TMSConnectionParameters], False));
    FConnectionOptions.Add(TBooleanOption.Create('AutoTranslate', prAutoTranslate, [TOLEDBConnection, TMSConnectionParameters], True));
    FConnectionOptions.Add(TStringOption.Create('NetworkLibrary', prNetworkLibrary, [TOLEDBConnection, TMSConnectionParameters], ''));
    FConnectionOptions.Add(TStringOption.Create('ApplicationName', prApplicationName, [TOLEDBConnection, TMSConnectionParameters], ''));
    FConnectionOptions.Add(TStringOption.Create('WorkstationID', prWorkstationID, [TOLEDBConnection, TMSConnectionParameters], ''));
    FConnectionOptions.Add(TIntegerOption.Create('PacketSize', prPacketSize, [TOLEDBConnection, TMSConnectionParameters], 4096));
    FConnectionOptions.Add(TStringOption.Create('InitialFileName', prInitialFileName, [TOLEDBConnection], ''));
    FConnectionOptions.Add(TBooleanOption.Create('MultipleActiveResultSets', prMARS, [TOLEDBConnection], False));
    FConnectionOptions.Add(TStringOption.Create('FailoverPartner', prFailoverPartner, [TOLEDBConnection], ''));
    FConnectionOptions.Add(TBooleanOption.Create('TrustServerCertificate', prTrustServerCertificate, [TOLEDBConnection], False));
    FConnectionOptions.Add(TIntegerOption.Create('LockTimeout', prDefaultLockTimeout, [TOLEDBConnection], DefaultDefaultLockTimeout));

    // TCompactConnection options
    FConnectionOptions.Add(TEnumeratorOption.Create('CompactInitMode', prInitMode, [TOLEDBConnection], Variant(imReadWrite), TypeInfo(TMSInitMode)));
    FConnectionOptions.Add(TIntegerOption.Create('CompactLockEscalation', prLockEscalation, [TOLEDBConnection], 100));
    FConnectionOptions.Add(TEnumeratorOption.Create('CompactTransactionCommitMode', prTransactionCommitMode, [TOLEDBConnection], Variant(cmAsynchCommit), TypeInfo(TCompactCommitMode)));
    FConnectionOptions.Add(TIntegerOption.Create('CompactMaxDatabaseSize', prMaxDatabaseSize, [TOLEDBConnection], 128));
    FConnectionOptions.Add(TIntegerOption.Create('CompactMaxBufferSize', prMaxBufferSize, [TOLEDBConnection], 640));
    FConnectionOptions.Add(TStringOption.Create('CompactTempFileDirectory', prTempFileDirectory, [TOLEDBConnection], ''));
    FConnectionOptions.Add(TIntegerOption.Create('CompactTempFileMaxSize', prTempFileMaxSize, [TOLEDBConnection], 128));
    FConnectionOptions.Add(TIntegerOption.Create('CompactDefaultLockEscalation', prDefaultLockEscalation, [TOLEDBConnection], 100));
    FConnectionOptions.Add(TIntegerOption.Create('CompactAutoShrinkThreshold', prAutoShrinkThreshold, [TOLEDBConnection], 60));
    FConnectionOptions.Add(TIntegerOption.Create('CompactFlushInterval', prFlushInterval, [TOLEDBConnection], 10));
    FConnectionOptions.Add(TEnumeratorOption.Create('CompactVersion', prCompactVersion, [TOLEDBConnection], Variant(cvAuto), TypeInfo(TCompactVersion)));
  end;
  Result := FConnectionOptions;
end;

function TSQLServerUniProvider.GetSQLOptions: TOptionsList;
begin
  if FSQLOptions = nil then begin
    FSQLOptions := TOptionsList.Create(GetProviderName);
    FSQLOptions.Add(TIntegerOption.Create('CommandTimeout', prCommandTimeout, [TOLEDBCommand], 0));
  end;
  Result := FSQLOptions;
end;

function TSQLServerUniProvider.GetDataSetOptions: TOptionsList;
begin
  if FDataSetOptions = nil then begin
    FDataSetOptions := TOptionsList.Create(GetProviderName);

    FDataSetOptions.Add(TBooleanOption.Create('FetchAll', prFetchAll, [TOLEDBRecordSet], True));
    FDataSetOptions.Add(TIntegerOption.Create('CommandTimeout', prCommandTimeout, [TOLEDBRecordSet], 0));
    FDataSetOptions.Add(TBooleanOption.Create('UniqueRecords', prUniqueRecords, [TOLEDBRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('CursorUpdate', prCursorUpdate, [TOLEDBRecordSet], True));
    FDataSetOptions.Add(TBooleanOption.Create('QueryIdentity', prQueryIdentity, [TCustomMSDataSetService], True));
    FDataSetOptions.Add(TBooleanOption.Create('CheckRowVersion', prCheckRowVersion, [TCustomMSDataSetService], False));
  end;
  Result := FDataSetOptions;
end;

function TSQLServerUniProvider.GetScriptOptions: TOptionsList;
begin
  if FScriptOptions = nil then begin
    FScriptOptions := TOptionsList.Create(GetProviderName);
  end;
  Result := FScriptOptions;
end;

{ TMSConnectDialogService }

function TMSConnectDialogService.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prProvider:
      FPRovider := TOLEDBProvider(Value);
  else
    Result := inherited SetProp(Prop, Value);    
  end;  
end;

function TMSConnectDialogService.UseDatabaseHistory: boolean;
begin
  Result := FPRovider = prCompact;
end;

function TMSConnectDialogService.UsernameEnabled: boolean;
begin
  Result := FPRovider <> prCompact;
end;

function TMSConnectDialogService.ServerEnabled: boolean;
begin
  Result := FPRovider <> prCompact;
end;

procedure RegisterComponent;
begin
  RegisterComponents('UniDAC', [TSQLServerUniProvider]);
end;

initialization
  UniProviders.RegisterProvider(TSQLServerUniProvider);

finalization
  UniProviders.UnRegisterProvider(TSQLServerUniProvider);

end.