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

interface

uses
{$IFDEF CLR}
  System.Runtime.InteropServices, System.Text, Variants,
{$ELSE}
  CLRClasses,
{$ENDIF}
  SysUtils, Classes, CRTypes, DASQLGenerator, MemData, CRAccess,
{$IFNDEF UNIDACPRO}
  OLEDBAccess;
{$ELSE}
  OLEDBAccessUni;
{$ENDIF}

type
  TMSLockTypeI = (iltUpdate, iltExclusive);
  TMSLockObjectI = (iloRow, iloTable);

  TCustomMSSQLGenerator = class(TDASQLGenerator)
  private
    FQueryIdentity: boolean;
    FCheckRowVersion: boolean;
    FLockType: TMSLockTypeI;
    FLockObject: TMSLockObjectI;

    FCountIsParam: boolean;
    FUseParamType: boolean;
    function GetCursorType: TMSCursorType;
    function GetOLEDBProvider: TOLEDBProvider;
    function GetDatabase: string;
    function IsUniqueRecords: boolean;

  protected
    procedure Clear; 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); override;

    procedure AddFieldToCondition(SB: StringBuilder; FieldDesc: TCRFieldDesc;
      const StatementType: _TStatementType; const Index: integer = -1); override;
    procedure GenerateConditions(
      SB: StringBuilder; const StatementType: _TStatementType;
      const KeyAndDataFields: TKeyAndDataFields; const Index: integer = -1); override;
    procedure GenerateLockSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const Index: integer = -1); override;

  public
    constructor Create(ServiceClass: TSQLGeneratorServiceClass); override;

    function GenerateRecCountSQL(UseBaseSQL: boolean = False): string; override;
    function GenerateSelectFilestreamContextSQL(const FieldName: string): string;

    property CountIsParam: boolean read FCountIsParam;
    property UseParamType: boolean read FUseParamType;
    property QueryIdentity: boolean read FQueryIdentity write FQueryIdentity;

    property CheckRowVersion: boolean write FCheckRowVersion;
    property LockType: TMSLockTypeI write FLockType;
    property LockObject: TMSLockObjectI write FLockObject;
  end;

implementation

uses
  DAConsts, CRParser,
{$IFNDEF UNIDACPRO}
  MSConsts, MSParser;
{$ELSE}
  MSConstsUni, MSParserUni;
{$ENDIF}

{ TCustomMSSQLGenerator }

constructor TCustomMSSQLGenerator.Create(ServiceClass: TSQLGeneratorServiceClass);
begin
  inherited;

  FQueryIdentity := True;
end;

procedure TCustomMSSQLGenerator.Clear;
begin
  inherited;

  FUseParamType := False;
end;

function TCustomMSSQLGenerator.IsUniqueRecords: boolean;
var
  Value: Variant;
begin
  Assert(FIRecordSet <> nil);
  FIRecordSet.GetProp(prUniqueRecords, Value);
  Result := Value;
end;

function TCustomMSSQLGenerator.GetCursorType: TMSCursorType;
var
  Value: Variant;
begin
  Assert(FIRecordSet <> nil);
  FIRecordSet.GetProp(prCursorType, Value);
  Result := TMSCursorType(Value);
end;

function TCustomMSSQLGenerator.GetOLEDBProvider: TOLEDBProvider;
var
  Value: Variant;
begin
  GetIConnection.GetProp(prProvider, Value);
  Result := TOLEDBProvider(Value);
end;

function TCustomMSSQLGenerator.GetDatabase: string;
var
  Value: Variant;
begin
  GetIConnection.GetProp(prDatabase, Value);
  Result := Value;
end;

procedure TCustomMSSQLGenerator.GenerateInsertSQL(
  const KeyAndDataFields: TKeyAndDataFields;
  const ModifiedFieldsOnly: boolean;
  const Index: integer = -1);
var
  FieldDesc, IdentityField: TCRFieldDesc;
  i: integer;
  IsFirstParam: boolean;
begin
  inherited;

  if FFldSB.Length = 0 then begin
    if not IsCompactEdition(TOLEDBConnection(GetIConnection).ProviderPrimaryVer) then begin
      Clear;
      FHeaderSB.Append('INSERT INTO ');
      FHeaderSB.Append(SQLInfo.NormalizeName(FTableInfo.TableNameFull, QuoteNames));
      FHeaderSB.Append(' DEFAULT VALUES');
    end
    else begin
      for i := 0 to High(KeyAndDataFields.DataFieldDescs) do begin
        FieldDesc := KeyAndDataFields.DataFieldDescs[i];
        if not FieldDesc.ReadOnly then begin
          if FFldSB.Length > 0 then begin
            FFldSB.Append(', ');
            FFldParamSB.Append(', ');
          end;
          FFldSB.Append(FieldDesc.ActualNameQuoted(SQLInfo, QuoteNames));
          FFldParamSB.Append('DEFAULT');
        end;
      end;
    end;
  end;

  if GetCursorType in [ctDefaultResultSet, ctBaseTable] then begin
    { Getting Identity value }
    if FQueryIdentity and
      not IsCompactEdition(TOLEDBConnection(GetIConnection).DBMSPrimaryVer) then begin
      IdentityField := FIRecordSet.IdentityField;
      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 ');
        FUseParamType := True;
        AddParam(FFooterSB, IdentityField, _stInsert, _ptInputOutput);

        if TOLEDBConnection(GetIConnection).DBMSPrimaryVer > 7 then
          FFooterSB.Append(' = SCOPE_IDENTITY()')
        else
          FFooterSB.Append(' = @@Identity');
      end;
    end;

    { DMLRefresh }
    if FDMLRefresh then begin
      IsFirstParam := True;
      for i := 0 to High(KeyAndDataFields.DataFieldDescs) do begin
        FieldDesc := KeyAndDataFields.DataFieldDescs[i];
        if not (FieldDesc.ReadOnly or FieldDesc.IsBlob) then begin
          if not IsFirstParam then
            FFooterSB.Append(', ')
          else
            FFooterSB.Append(SLLineSeparator + 'SELECT ');
          IsFirstParam := False;
          FUseParamType := True;
          AddParam(FFooterSB, FieldDesc, _stInsert, _ptInputOutput);
          FFooterSB.Append(' = ' + FieldDesc.ActualNameQuoted(SQLInfo, QuoteNames));
        end;
      end;
      if not IsFirstParam then begin
        FFooterSB.Append(' FROM ' + SQLInfo.NormalizeName(FTableInfo.TableNameFull, QuoteNames) +
          SLLineSeparator + 'WHERE' + SLLineSeparator + '  ');
        GenerateConditions(FCondSB, _stInsert, KeyAndDataFields);
        FFooterSB.Append(FCondSB.ToString);
        FCondSB.Length := 0;
      end;
    end;
  end;
end;

procedure TCustomMSSQLGenerator.GenerateUpdateSQL(
  const KeyAndDataFields: TKeyAndDataFields;
  const ModifiedFieldsOnly: boolean;
  const Index: integer = -1);
var
  FieldDesc: TCRFieldDesc;
  i: integer;
  IsFirstParam: boolean;
  OldCondSB: StringBuilder;
begin
  inherited;

  if GetCursorType in [ctDefaultResultSet, ctBaseTable] then begin
    { DMLRefresh }
    if (FFldSB.Length > 0) and FDMLRefresh then begin
      FFooterSB.Append(SLLineSeparator);
      FFooterSB.Append('SELECT ');
      IsFirstParam := True;
      for i := 0 to High(KeyAndDataFields.DataFieldDescs) do begin
        FieldDesc := KeyAndDataFields.DataFieldDescs[i];
        if not (FieldDesc.ReadOnly or FieldDesc.IsBlob) then begin
          if not IsFirstParam then
            FFooterSB.Append(', ');
          IsFirstParam := False;
          FUseParamType := True;
          AddParam(FFooterSB, FieldDesc, _stUpdate, _ptInputOutput);
          FFooterSB.Append(' = ' + FieldDesc.ActualNameQuoted(SQLInfo, QuoteNames));
        end;
      end;
      FFooterSB.Append(' FROM ');
      FFooterSB.Append(SQLInfo.NormalizeName(FTableInfo.TableNameFull, QuoteNames));
      FFooterSB.Append(SLLineSeparator);
      FFooterSB.Append('WHERE');
      FFooterSB.Append(SLLineSeparator);
      FFooterSB.Append('  ');
      OldCondSB := FCondSB;
      try
        FCondSB := StringBuilder.Create;
        try
          GenerateConditions(FCondSB, _stUpdate, KeyAndDataFields);
          FFooterSB.Append(FCondSB.ToString);
        finally
          FCondSB.Free;
        end;
      finally
        FCondSB := OldCondSB;
      end;
    end;
  end;
end;

procedure TCustomMSSQLGenerator.GenerateRefreshSQLSelectPart(const KeyAndDataFields: TKeyAndDataFields);
var
  FieldDesc: TCRFieldDesc;
  UseDataFields: boolean;
  FieldArrHigh: integer;
begin
  inherited;

  if TOLEDBRecordSet(FIRecordSet).TimestampField <> 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(', ');
    FieldDesc := TOLEDBRecordSet(FIRecordSet).TimestampField;
    FFldSB.Append(FieldDesc.ActualNameQuoted(SQLInfo, QuoteNames));

    if not FDesignMode then
      FFldSB.Append(' AS ' + GenerateIndexName(IntToStr(FIRecordSet.Fields.IndexOf(FieldDesc))));
  end;
end;

procedure TCustomMSSQLGenerator.GenerateRefreshSQL(const KeyAndDataFields: TKeyAndDataFields);

  procedure GenerateSPFullRefreshSQL;
  var
    i: integer;
    FieldDescs: TFieldDescs;
    FieldDesc: TOLEDBFieldDesc;
    TableName: string;
    TblNames: TStringList;
  begin
    TblNames := TStringList.Create;
    try
      // SELECT ... FROM ... WHERE ... {WITH NOLOCK}
      // Add SELECT section
      FHeaderSB.Append('SELECT ');
      FieldDescs := FIRecordSet.Fields;
      for i := 0 to FieldDescs.Count - 1 do begin
        FieldDesc := TOLEDBFieldDesc(FieldDescs[i]);
        if FieldDesc.FieldDescKind = fdkData then begin
          if FieldDesc.TableInfo <> nil then begin
            TableName := GenerateTableName(FieldDesc.BaseCatalogName, FieldDesc.BaseSchemaName,
              FieldDesc.BaseTableName, GetDatabase);
            if TblNames.IndexOf(TableName) = - 1 then
              TblNames.Add(TableName);

            FHeaderSB.Append(TableName + '.' + FieldDesc.Name);
            if not FDesignMode then
              FHeaderSB.Append(' AS _' + IntToStr(FIRecordSet.Fields.IndexOf(FieldDesc)));
            FHeaderSB.Append(', ');
          end;
        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, KeyAndDataFields);
      if FCondSB.Length > 0 then
        FMiddleSB.Append(' WHERE ');
    finally
      TblNames.Free;
    end;
  end;

var
  IsSPProc: variant;
begin
  FIRecordSet.GetCommand.GetProp(prIsStoredProc, IsSPProc);
  if IsSPProc and FullRefresh then
    GenerateSPFullRefreshSQL
  else
  if FullRefresh or (ReadOnly and not IsUniqueRecords) then begin
    GenerateConditions(FCondSB, _stRefresh, KeyAndDataFields);
    if FCondSB.Length = 0 then
      FHeaderSB.Append(FService.FinalSQL)
    else begin
      FHeaderSB.Append(SQLAddWhere(FService.BaseSQL, FCondSB.ToString));
      FCondSB.Length := 0; // WHERE clause already added to FHeaderSB
    end;
  end
  else
    inherited;
end;

procedure TCustomMSSQLGenerator.AddFieldToCondition(SB: StringBuilder; FieldDesc: TCRFieldDesc;
  const StatementType: _TStatementType; const Index: integer = -1);
begin
  Assert(FieldDesc <> nil);

  if (StatementType = _stInsert) and (FieldDesc = FIRecordSet.IdentityField) then begin
    FCondSB.Append(FieldDesc.ActualNameQuoted(SQLInfo, QuoteNames));
    FCondSB.Append(' = ');
    if TOLEDBConnection(GetIConnection).DBMSPrimaryVer > 7 then
      FCondSB.Append('SCOPE_IDENTITY()')
    else
      FCondSB.Append('@@Identity');
  end
  else
    inherited;
end;

procedure TCustomMSSQLGenerator.GenerateConditions(
  SB: StringBuilder; const StatementType: _TStatementType;
  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
    MaxTimestamp: Int64;
    FieldDesc: TCRFieldDesc;
  begin
    FieldDesc := TOLEDBRecordSet(FIRecordSet).TimestampField;
    if FieldDesc = nil then
      FService.RaiseError(STimestampFieldRequired);

    MaxTimestamp := TOLEDBTableInfo(FieldDesc.TableInfo).MaxTimestamp;
    FCondSB.Append(GetActualFieldName(FieldDesc, True) + ' > ' + '0x' + IntToHex(MaxTimestamp, SizeOf(MaxTimestamp) * 2));
  end;

var
  i: integer;
  FldUsed: set of byte;
  TestChanges: boolean;
begin
  FCondSB.Length := 0;

  if StatementType = _stRefreshQuick then
    GenerateCondForRQ
  else begin
    TestChanges := (StatementType in [_stInsert, _stUpdate]) and FDMLRefresh and
      (GetCursorType in [ctDefaultResultSet, ctBaseTable]) and FCheckRowVersion;

    if not TestChanges then
      inherited
    else begin
      if (TOLEDBRecordSet(FIRecordSet).TimestampField <> nil) and not FieldIsNull(TOLEDBRecordSet(FIRecordSet).TimestampField, False) then
        AddFieldToCondition(FCondSB, TOLEDBRecordSet(FIRecordSet).TimestampField, StatementType, 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, Index);
            FldUsed := FldUsed + [KeyAndDataFields.KeyFieldDescs[i].FieldNo];
          end;

        if Length(KeyAndDataFields.DataFieldDescs) = 0 then
          FService.RaiseError(SNoKeyFields);
        for i := 0 to High(KeyAndDataFields.DataFieldDescs) do
          if not KeyAndDataFields.DataFieldDescs[i].IsBlob // not "text", "ntext", "image"
            and not (KeyAndDataFields.DataFieldDescs[i].FieldNo in FldUsed) then
            AddFieldToCondition(FCondSB, KeyAndDataFields.DataFieldDescs[i], StatementType, Index);
      end;
    end;
  end;
end;

procedure TCustomMSSQLGenerator.GenerateLockSQL(const KeyAndDataFields: TKeyAndDataFields; const Index: integer = -1);
begin
  FHeaderSB.Append('SELECT * FROM ');
  FHeaderSB.Append(FTableInfo.TableName);
  FHeaderSB.Append(SLLineSeparator);

  (* MSDN: Table Hint (Transact-SQL)
    HOLDLOCK     Makes shared locks more restrictive by holding them until a transaction is completed
    ROWLOCK      Specifies that row locks are taken when page or table locks are ordinarily taken.
    ROWLOCK      Specifies that row locks are taken when page or table locks are ordinarily taken.
    TABLOCK      Specifies that a shared lock is taken on the table held until the end-of-statement. If HOLDLOCK is also specified, the shared table lock is held until the end of the transaction.
    TABLOCKX     Specifies that an exclusive lock is taken on the table. If HOLDOCK is also specified, the lock is held until the transaction completes.
    UPDLOCK      Specifies that update locks are to be taken and held until the transaction completes.
    XLOCK        Specifies that exclusive locks are to be taken and held until the transaction completes.

    ltUpdate:    ROWLOCK, UPDLOCK, HOLDLOCK
    ltExclusive: ROWLOCK, XLOCK
  *)
  case FLockType of
    iltUpdate:
      case FLockObject of
        iloRow:
          FMiddleSB.Append('WITH (UPDLOCK, ROWLOCK, HOLDLOCK)');
        iloTable:
          FMiddleSB.Append('WITH (UPDLOCK, TABLOCK, HOLDLOCK)');
      end;
    iltExclusive:
      case FLockObject of
        iloRow:
          FMiddleSB.Append('WITH (ROWLOCK, XLOCK)');
        iloTable:
          FMiddleSB.Append('WITH (TABLOCKX, HOLDLOCK)');
      end;
  end;
  FMiddleSB.Append(SLLineSeparator);
  FMiddleSB.Append('WHERE');
  FMiddleSB.Append(SLLineSeparator);
  FMiddleSB.Append('  ');
  case FLockObject of
    iloRow:
      GenerateConditions(FCondSB, _stLock, KeyAndDataFields, Index);
    iloTable:
      FCondSB.Append('1 = 0');
  end;
end;

function TCustomMSSQLGenerator.GenerateSelectFilestreamContextSQL(const FieldName: string): string;
var
  KeyAndDataFields: TKeyAndDataFields;
begin
  Assert(FIRecordSet <> nil);

  FIRecordSet.GetKeyAndDataFields(KeyAndDataFields, False);
  if (FIRecordSet.UpdatingTableInfo = nil) or (FIRecordSet.UpdatingTableInfo.TableName = '') then
    FService.RaiseError(SBadTableInfoName);
  if FieldName = '' then
    FService.RaiseError(SFieldNameNotDefined);

  Clear;
  FParamsInfo.Clear;

  FHeaderSB.Append('SELECT ');
  FHeaderSB.Append(SQLInfo.NormalizeName(FieldName, QuoteNames));
  FHeaderSB.Append('.PathName(), GET_FILESTREAM_TRANSACTION_CONTEXT()');
  FHeaderSB.Append(SLLineSeparator);
  FMiddleSB.Append('FROM ');
  FMiddleSB.Append(SQLInfo.NormalizeName(FIRecordSet.UpdatingTableInfo.TableNameFull, QuoteNames));
  FMiddleSB.Append(SLLineSeparator);
  FMiddleSB.Append('WHERE ');
  // Append FParamSB
  GenerateConditions(FCondSB, _stCustom, KeyAndDataFields);

  Result := AssembleSB();
end;

function TCustomMSSQLGenerator.GenerateRecCountSQL(UseBaseSQL: boolean): string;
var
  Parser: TMSParser;
  Code, SelectPos, FromPos, DelimiterPos: integer;
  s: string;
  CountParamName: string;
  WithLexemUsed, IsSelectModifier: boolean;
begin
  Result := '';
  Clear;
  FCountIsParam := False;

  if UseBaseSQL then
    s := FService.BaseSQL
  else
    s := FService.FinalSQL;
  s := SQLSetOrderBy(s, '');
  CountParamName := '';

  Parser := TMSParser.Create(s);
  try
    Parser.OmitBlank := False;
    Parser.OmitComment := True;
    IsSelectModifier := False;

    Code := Parser.ToLexem([lxWITH, lxSELECT]);
    WithLexemUsed := Code = lxWITH;
    if Code = lxWITH then
      Code := Parser.ToLexem(lxSELECT, True);

    if Code <> lcEnd then begin
      SelectPos := Parser.CurrPos;
      repeat
        Code := Parser.ToLexem([lxALL, lxDISTINCT, lxTOP, lxFROM, lxSELECT]);
        case Code of
          lxSELECT:
            SelectPos := Parser.CurrPos;
          lxALL, lxDISTINCT, lxTOP:
            IsSelectModifier := True;
        end;
      until (Code = lcEnd) or (Code = lxFROM);

      if Code = lxFROM then
        FromPos := Parser.CurrPos
      else
        FromPos := 0;

      repeat
        Code := Parser.ToLexem([lxUNION, lxGROUP, 7{';'}]);
        if (Code = lxUNION) or (Code = lxGROUP) then
          IsSelectModifier := True;
      until (Code = 7{';'}) or (Code = lcEnd);

      if Code = 7 then // ';'
        DelimiterPos := Parser.CurrPos
      else
        DelimiterPos := MaxInt;

      if (FromPos > 0) and not IsSelectModifier then begin
        if (GetOLEDBProvider = prCompact) or WithLexemUsed then begin
          s := Copy(s, 1, SelectPos) + ' COUNT(*) AS FCOUNT ' + Copy(s, FromPos - 4{length('FROM')}, MaxInt);
        end
        else begin
          if ScanParams then
            CountParamName := ':PCOUNT'
          else
            CountParamName := '?';
          s := Copy(s, 1, SelectPos - 6{length('SELECT')}) +
            'SET ' + CountParamName + ' = (SELECT COUNT(*)' + Copy(s, FromPos - 4{length('FROM')}, MaxInt) + ')';
        end;
      end
      else
        if IsSelectModifier then
          s := Copy(s, 1, SelectPos) + ' COUNT(*) AS FCOUNT FROM (SELECT ' + Copy(s, SelectPos + 1, DelimiterPos - 1 - SelectPos) + ') q'
        else
          s := Copy(s, 1, SelectPos) + ' COUNT(*) AS FCOUNT FROM (SELECT ' + Copy(s, SelectPos + 1, DelimiterPos - 1 - SelectPos) + ' f) q';
    end;
  finally
    Parser.Free;
  end;

  if s <> '' then begin
    Result := s;
    FHeaderSB.Append(Result);
    FCountIsParam := CountParamName <> '';
  end;
end;

end.
