
//////////////////////////////////////////////////
//  Universal Data Access Components
//  Copyright © 1998-2014 Devart. All right reserved.
//////////////////////////////////////////////////

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

interface

uses
  SysUtils, Windows, Classes, Variants, DB, CRAccess, CRConnectionPool,
  MemData, DBAccess, CRFunctions,
  {$IFDEF FPC}MemDataSet{$ELSE}MemDS{$ENDIF},
  CRTypes, CRParser, DAScript, DADump, UniProvider, CRDataTypeMap,
{$IFNDEF UNIDACPRO}
  OLEDBAccess;
{$ELSE}
  OLEDBAccessUni;
{$ENDIF}

type

{$IFDEF VER16P}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
  TSQLServerUniProvider = class(TUniProvider)
  public
    class function GetProviderName: string; override;

    function IsDatabaseSupported: boolean; override;
    function IsPortSupported: boolean; override;

    function GetParserClass: TSQLParserClass; 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 GetLoaderClass: TCRLoaderClass; override;
    function GetDumpProcessorClass: TDADumpProcessorClass; override;
    function GetMetaDataClass: TCRMetaDataClass; override;
    function GetConnectDialogServiceClass: TConnectDialogServiceClass; override;
    function GetFieldTypeMapClass: TDAFieldTypeMapClass; override;
    function GetSqlFormatterClass: TUniSqlFormatterClass; override;
    function GetConverterManagerClass: TConverterManagerClass; override;
    function CheckParamName(const ParamName: string): string; 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;
    function GetLoaderOptions: TOptionsList; override;
    function GetDumpOptions: TOptionsList; override;
    function DefaultTableSchema: string; override;
  end;

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

  TMSSqlFormatter = class(TUniSqlFormatter)
  protected
    function LeftQuote: Char; override;
    function RightQuote: Char; override;
    function IsServerKeywordLexem(Parser: TSQLParser; const Lexem: string): Boolean; override;
  public
    constructor Create; override;
  end;

{$IFNDEF FPC}
procedure RegisterComponent;
{$ELSE}
procedure Register;
{$ENDIF}

implementation

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

var
  MSFunctions, MSMacros: TStrValueStringList;

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

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

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

function TSQLServerUniProvider.GetParserClass: TSQLParserClass;
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.GetLoaderClass: TCRLoaderClass;
begin
  Result := TOLEDBLoader;
end;

function TSQLServerUniProvider.GetDumpProcessorClass: TDADumpProcessorClass;
begin
  Result := TCustomMSDumpProcessor;
end;

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

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

function TSQLServerUniProvider.GetFieldTypeMapClass: TDAFieldTypeMapClass;
begin
  Result := TCustomMSFieldTypeMap;
end;

function TSQLServerUniProvider.GetSqlFormatterClass: TUniSqlFormatterClass;
begin
  Result := TMSSqlFormatter;
end;

function TSQLServerUniProvider.GetConverterManagerClass: TConverterManagerClass;
begin
  Result := TMSConverterManager;
end;

function TSQLServerUniProvider.CheckParamName(const ParamName: string): string;
begin
  Result := GetParamNameWODog(ParamName);
end;

procedure TSQLServerUniProvider.SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean);
begin
  if Obj is TOLEDBConnection then begin
    TOLEDBConnection(Obj).SetProp(prSetLockTimeout, True);
  end
  else
  if Obj is TOLEDBCommand then begin
    TOLEDBCommand(Obj).SetProp(prSensibleBCDMapping, True);
  end
  else
  if Obj is TOLEDBRecordSet then begin
    TOLEDBREcordSet(Obj).GetCommand.SetProp(prSensibleBCDMapping, True);
  end;

  inherited;
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, True));
    FConnectionOptions.Add(TEnumeratorOption.Create('OLEDBProvider', prProvider, [TOLEDBConnection, TMSConnectionParameters, TMSServerEnumerator, TMSConnectDialogService], Variant(prAuto), TypeInfo(TOLEDBProvider), True));
    FConnectionOptions.Add(TEnumeratorOption.Create('NativeClientVersion', prNativeClientVersion, [TOLEDBConnection, TMSConnectionParameters], Variant(ncAuto), TypeInfo(TNativeClientVersion)));
    FConnectionOptions.Add(TBooleanOption.Create('ForceCreateDatabase', prForceCreateDatabase, [TOLEDBConnection, TMSConnectionParameters], DefValForceCreateDatabase, True));

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

    // TCompactConnection options
    FConnectionOptions.Add(TEnumeratorOption.Create('CompactInitMode', prInitMode, [TOLEDBConnection], Variant(imReadWrite), TypeInfo(TMSInitMode), True));
    FConnectionOptions.Add(TIntegerOption.Create('CompactLocaleIdentifier', prLocaleIdentifier, [TOLEDBConnection], GetSystemDefaultLCID, True));
    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, True));
    FConnectionOptions.Add(TIntegerOption.Create('CompactMaxBufferSize', prMaxBufferSize, [TOLEDBConnection], 640, True));
    FConnectionOptions.Add(TStringOption.Create('CompactTempFileDirectory', prTempFileDirectory, [TOLEDBConnection], '', True));
    FConnectionOptions.Add(TIntegerOption.Create('CompactTempFileMaxSize', prTempFileMaxSize, [TOLEDBConnection], 128, True));
    FConnectionOptions.Add(TIntegerOption.Create('CompactDefaultLockEscalation', prDefaultLockEscalation, [TOLEDBConnection], 100, True));
    FConnectionOptions.Add(TIntegerOption.Create('CompactAutoShrinkThreshold', prAutoShrinkThreshold, [TOLEDBConnection], 60, True));
    FConnectionOptions.Add(TIntegerOption.Create('CompactFlushInterval', prFlushInterval, [TOLEDBConnection], 10, True));
    FConnectionOptions.Add(TEnumeratorOption.Create('CompactVersion', prCompactVersion, [TOLEDBConnection], Variant(cvAuto), TypeInfo(TCompactVersion), True));
  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));
    FSQLOptions.Add(TBooleanOption.Create('DescribeParams', prUseDescribeParams, [TOLEDBCommand], False));
  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], True));
    FDataSetOptions.Add(TBooleanOption.Create('HideSystemUniqueFields', prHideSystemUniqueFields, [TOLEDBRecordSet], True));
    FDataSetOptions.Add(TBooleanOption.Create('CursorUpdate', prCursorUpdate, [TOLEDBRecordSet], True));
    FDataSetOptions.Add(TBooleanOption.Create('QueryIdentity', prQueryIdentity, [TCustomMSDataSetService], True));
    FDataSetOptions.Add(TBooleanOption.Create('CheckRowVersion', prCheckRowVersion, [TCustomMSDataSetService], False));
    FDataSetOptions.Add(TBooleanOption.Create('DisableMultipleResults', prDisableMultipleResults, [TOLEDBRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('DescribeParams', prUseDescribeParams, [TOLEDBCommand], False));
    FDataSetOptions.Add(TEnumeratorOption.Create('CursorType', prCursorType, [TOLEDBRecordSet], Variant(ctDefaultResultSet), TypeInfo(TMSCursorType)));
  end;
  Result := FDataSetOptions;
end;

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

function TSQLServerUniProvider.GetLoaderOptions: TOptionsList;
begin
  if FLoaderOptions = nil then begin
    FLoaderOptions := TOptionsList.Create(GetProviderName);
    FLoaderOptions.Add(TBooleanOption.Create('KeepIdentity', prKeepIdentity, [TOLEDBLoader], False));
    FLoaderOptions.Add(TBooleanOption.Create('KeepNulls', prKeepNulls, [TOLEDBLoader], False));
    FLoaderOptions.Add(TIntegerOption.Create('RowsPerBatch', prRowsPerBatch, [TOLEDBLoader], 0));
    FLoaderOptions.Add(TIntegerOption.Create('KilobytesPerBatch', prKilobytesPerBatch, [TOLEDBLoader], 0));
    FLoaderOptions.Add(TBooleanOption.Create('LockTable', prLockTable, [TOLEDBLoader], False));
    FLoaderOptions.Add(TBooleanOption.Create('CheckConstraints', prCheckConstraints, [TOLEDBLoader], False));
  end;
  Result := FLoaderOptions;
end;

function TSQLServerUniProvider.GetDumpOptions: TOptionsList;
begin
  if FDumpOptions = nil then begin
    FDumpOptions := TOptionsList.Create(GetProviderName);
    FDumpOptions.Add(TBooleanOption.Create('IdentityInsert', prIdentityInsert, [TCustomMSDumpProcessor], False));
  end;
  Result := FDumpOptions;
end;

function TSQLServerUniProvider.DefaultTableSchema: string;
begin
  Result := DefaultSDACSchema;
end;

{ TMSConnectDialogService }

function TMSConnectDialogService.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prProvider:
      FProvider := TOLEDBProvider(Value);
    prAuthentication:
      FAuthentication := TMSAuthentication(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) and (FAuthentication <> auWindows);
end;

function TMSConnectDialogService.PasswordEnabled: boolean;
begin
  Result := (FProvider = prCompact) or (FAuthentication <> auWindows);
end;

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

function TMSConnectDialogService.PortEnabled: boolean;
begin
  Result := FProvider <> prCompact;
end;

{ TMSSqlFormatter }

constructor TMSSqlFormatter.Create;
begin
  inherited;

  FFunctions := MSFunctions;
  FPredefinedMacros := MSMacros;
end;

function TMSSqlFormatter.LeftQuote: Char;
begin
  Result := '[';
end;

function TMSSqlFormatter.RightQuote: Char;
begin
  Result := ']';
end;

function TMSSqlFormatter.IsServerKeywordLexem(Parser: TSQLParser; const Lexem: string): Boolean;
var
  St: string;
begin
  if Lexem = ':' then begin
    Parser.GetNext(St);
    Parser.Back;
    Result := UpperCase(St) = 'RETURN_VALUE';
  end
  else
    Result := False;
end;

{$IFNDEF FPC}
procedure RegisterComponent;
{$ELSE}
procedure Register;
{$ENDIF}
begin
  RegisterComponents('UniDAC Providers', [TSQLServerUniProvider]);
end;

initialization
  UniProviders.RegisterProvider(TSQLServerUniProvider);

  MSFunctions := TStrValueStringList.Create;
  MSFunctions.Add('USER', 'USER');
  MSFunctions.Add('CHAR_LENGTH', 'LEN(%s)');
  MSFunctions.Add('LOCATE', 'CHARINDEX(%s, %s)');
  MSFunctions.Add('SUBSTRING', 'SUBSTRING(%s, %s, %s)');
  MSFunctions.Add('CONCAT', '%s + %s');
  MSFunctions.Add('CHAR', 'CHAR(%s)');
  MSFunctions.Add('TRIM', 'LTRIM(RTRIM(%s))');
  MSFunctions.Add('TRUNCATE', 'ROUND(%s, %s, 1)');
  MSFunctions.Add('CEILING', 'CEILING(%s)');
  // Date-time
  MSFunctions.Add('CURRENT_DATE', 'GETDATE()');
  MSFunctions.Add('YEAR', 'YEAR(%s)');
  MSFunctions.Add('MONTH', 'MONTH(%s)');
  MSFunctions.Add('DAY', 'DAY(%s)');
  MSFunctions.Add('DATEDIFF', 'DATEDIFF(%s, %s, %s)');
  MSFunctions.Add('DATEADD', 'DATEADD(%s, %s, %s)');
  // Date-time literals
  MSFunctions.Add('__DATE_TIME_LITERAL', 'CONVERT(DATETIME, %s)');
  MSFunctions.Add('__DATE_LITERAL', 'CONVERT(DATE, %s)');
  MSFunctions.Add('__TIME_LITERAL', 'CONVERT(TIME, %s)');
  // CONVERT functions
  MSFunctions.Add('TODATE', 'CONVERT(DATETIME, %s)');
  MSFunctions.Add('TONUMBER', 'CONVERT(FLOAT(53), %s)');
  MSFunctions.Add('TOCHAR', 'CONVERT(VARCHAR, %s, 20)');

  MSMacros := TStrValueStringList.Create;
  MSMacros.Add('PROVIDER', 'SQL Server');
  MSMacros.Add('SQLSERVER', '');
  MSMacros.Add('SQL SERVER', '');
  // DataType macros
  MSMacros.Add('DATETIME', 'DATETIME');
  MSMacros.Add('DOUBLE', 'FLOAT(53)');
  MSMacros.Add('VARCHAR', 'VARCHAR');

finalization
  UniProviders.UnRegisterProvider(TSQLServerUniProvider);

  MSFunctions.Free;
  MSMacros.Free;

end.
