

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

{$IFNDEF CLR}

{$I Sdac.inc}

unit MSServicesUni;

{$ENDIF}

interface

uses
  SysUtils, Classes, DB, Math, Registry, Windows, ActiveX,
{$IFNDEF BCB}{$IFNDEF FPC}
  {$NOINCLUDE ActiveX}
{$ENDIF}{$ENDIF}
{$IFDEF CLR}
  System.Runtime.InteropServices, System.Text, System.XML,
{$ELSE}
  CLRClasses, CRXml,
{$ENDIF}
{$IFDEF VER6P}
  Variants,
{$ENDIF}
  CRTypes, MemData, {$IFDEF FPC}MemDataSet{$ELSE}MemDS{$ENDIF}, CRAccess,
  DBAccess, DADump, DASQLGenerator,
{$IFNDEF UNIDACPRO}
  OLEDBAccess, MSSQLGenerator;
{$ELSE}
  OLEDBAccessUni, MSSQLGeneratorUni;
{$ENDIF}

const
  prQueryIdentity      = 101;
  prCheckRowVersion    = 102;
  prLockType           = 103;
  prLockObject         = 104;
  prIdentityInsert     = 105;
  prDisableConstraints = 106;

type
  TCustomMSDataSetService = class;

  TCustomMSFieldTypeMap = class(TDAFieldTypeMap)
  public
    class function GetFieldType(DataType: Word): TFieldType; override;
    class function GetDataType(FieldType: TFieldType): integer; override;
  end;

  TCustomMSDataSetUpdater = class(TDADataSetUpdater)
  protected
    FDataSetService: TCustomMSDataSetService;

    function GetIRecordSet: TOLEDBRecordSet;
    function UseParamType(Param: TDAParam): boolean; override;
    procedure SetDefaultParamType(Param: TDAParam); override;

    procedure SetRowsAffected(Value: Integer);

    function GetIdentityFieldValue(out Value: variant): boolean; override;

    procedure CheckUpdateQuery(const StatementType: TStatementType); override;
    procedure SetUpdateQueryOptions(const StatementType: TStatementType); override;

    function SavepointAllowed: boolean; override;

  { RefreshQuick}
    function IsRefreshQuickField(FieldDesc: TFieldDesc): boolean; override;
    procedure SaveMaxRefreshQuickValue(FieldDesc: TFieldDesc; const Value: variant); override;

    procedure PrepareUpdate; override;
    function PerformRefreshRecord: boolean; override;

    function LockCompare(const Value1, Value2: variant): boolean; override;
  public
    constructor Create(AOwner: TDataSetService); override;

    function GetDefaultExpressionValue(DefExpr: string; out Value: variant): boolean; override;
  end;

  TCustomMSDataSetService = class(TDADataSetService)
  protected
    FUpdater: TCustomMSDataSetUpdater;

    procedure CreateDataSetUpdater; override;
    procedure SetDataSetUpdater(Value: TDataSetUpdater); override;
    procedure CreateSQLGenerator; override;

    function GetIConnection: TOLEDBConnection;
    function GetOLEDBProvider: TOLEDBProvider;
    function GetDatabase: string;
    function GetCursorType: TMSCursorType;
    function GetCursorUpdate: boolean;

    procedure InitCursor; override;
    procedure CloseCursor; override;

    procedure SetFieldOrigin(Field: TField; FieldDesc: TCRFieldDesc); override;

    function DetectCanModify: boolean; override;    

    procedure FillFieldsDefaultValues; override;
    function GetRecCount: integer; override;

    procedure SetNumberRange(FieldDef: TFieldDef); override;

    procedure InitMasterParams(Params: TDAParams); 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(AOwner: TMemDataSet); override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;

    function OpenNext: boolean; override;

    procedure GetFilestreamContext(const FieldName: string;
      var PathName: WideString; var FSTrContext: variant);
  end;

  TMSServerEnumerator = class (TCRServerEnumerator)
  private
    FProvider: TOLEDBProvider;
  public
    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; var Value: variant): boolean; override;
  
    procedure GetServerList(List: TStrings); override;
  end;

  TCustomMSDumpProcessor = class(TDADumpProcessor)
  protected
    FIdentityInsert: boolean;
    FDisableConstraints: boolean;

    function CreateQuery: TCustomDADataSet; override;
    procedure BackupObjects(const Query: string); override;

  public
    constructor Create(Owner: TDADump); override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; var Value: variant): boolean; override;
  end;

implementation

uses
  MemUtils, CRFunctions, DAConsts, DASQLMonitor, CRParser,
{$IFDEF VER7P}
  StrUtils,
{$ENDIF}
{$IFDEF FPC}
  Sockets,
{$ENDIF}
{$IFNDEF CLR}
  {$IFNDEF BCB}
  {$NOINCLUDE winsock}
  {$HPPEMIT '#include <winsock2.h>'}
  {$ENDIF}
  WinSock,
{$ENDIF}
{$IFNDEF UNIDACPRO}
  OLEDBC, OLEDBIntf, MSConsts;
{$ELSE}
  OLEDBCUni, OLEDBIntfUni, MSConstsUni;
{$ENDIF}

{$IFDEF WIN32}
var
  WsaData: TWSAData; // on windows winsock
{$ENDIF}

{ TCustomMSFieldTypeMap }

class function TCustomMSFieldTypeMap.GetFieldType(DataType: Word): TFieldType;
begin
  case DataType of
    dtMSXML:
      Result := {$IFDEF VER10P}ftWideMemo;{$ELSE}ftMemo;{$ENDIF}
  {$IFDEF VER6P}{$IFNDEF FPC}
    dtSQLTimeStamp:
      Result := ftTimeStamp;
  {$ENDIF}{$ENDIF}
  else
    Result := inherited GetFieldType(DataType);
  end;
end;

class function TCustomMSFieldTypeMap.GetDataType(FieldType: TFieldType): integer;
begin
  if FieldType = ftFmtMemo then
    Result := dtString
{$IFDEF VER6P}{$IFNDEF FPC}
  else
  if FieldType = ftTimeStamp then
    Result := dtSQLTimeStamp
{$ENDIF}{$ENDIF}
  else
    Result := inherited GetDataType(FieldType);
end;

{ TCustomMSDataSetUpdater }

constructor TCustomMSDataSetUpdater.Create(AOwner: TDataSetService);
begin
  inherited;

  FDataSetService := TCustomMSDataSetService(AOwner);
end;

function TCustomMSDataSetUpdater.GetIRecordSet: TOLEDBRecordSet;
begin
  Result := TOLEDBRecordSet(inherited GetIRecordSet);
end;

function TCustomMSDataSetUpdater.UseParamType(Param: TDAParam): boolean;
begin
  Result := TCustomMSSQLGenerator(FDataSetService.SQLGenerator).UseParamType or (Param.ParamType = ptResult);
end;

procedure TCustomMSDataSetUpdater.SetDefaultParamType(Param: TDAParam);
var
  ParamName: string;
begin
  if Param.ParamType = ptUnknown then
    if not TDBAccessUtils.IsBlobDataType(Param) then begin
      ParamName := AnsiUpperCase(Param.Name);
      if Pos('IDENTITY', ParamName) > 0 then
        Param.ParamType := ptInputOutput
      else
      if ParamName = 'RETURN_VALUE' then
        Param.ParamType := ptResult
      else
        Param.ParamType := ptInput
    end
    else
      Param.ParamType := ptInput;
end;

procedure TCustomMSDataSetUpdater.SetRowsAffected(Value: Integer);
begin
  inherited SetRowsAffected(Value);
end;

function TCustomMSDataSetUpdater.GetIdentityFieldValue(out Value: variant): boolean;
var
  UserSQL: boolean;
  IdentityParamIdx: integer;
  UQParams: TDAParams;
begin
  Result := False;             

  BeginConnection; // for Pooling
  try
    IdentityParamIdx := - 1;
    UQParams := TDBAccessUtils.GetParams(FUpdateQuery);

    if GetUpdateObject <> nil then
      UserSQL := GetUpdateObject.SQL[DB.ukInsert].Count > 0
    else
      UserSQL := Length(GetUpdateSQL(stInsert)) > 0;

    if not UserSQL then begin // This is not custom user statement and last parameter is used for Identity
      if TCustomMSSQLGenerator(FDataSetService.SQLGenerator).QueryIdentity and (FDataSetService.IdentityField <> nil) and
        (FDataSetService.GetCursorType in [ctDefaultResultSet, ctBaseTable]) then begin
        if IsCompactEdition(FDataSetService.GetIConnection.ProviderPrimaryVer) then
          IdentityParamIdx := 0
        else begin
          IdentityParamIdx := UQParams.Count - 1;
          Assert(IdentityParamIdx >= 0);
          // UQParams[IdentityParamIdx].ParamType := ptInputOutput; - already setted by AddParam
        end;
      end;
    end;

    if (IdentityParamIdx >= 0) and not NeedReturnParams then begin
      if IsCompactEdition(FDataSetService.GetIConnection.ProviderPrimaryVer) then begin
        TDBAccessUtils.GetSQL(FUpdateQuery).Text := 'SELECT @@IDENTITY';
        TDBAccessUtils.Open(FUpdateQuery);
        Value := TCustomDADataSet(FUpdateQuery).Fields[IdentityParamIdx].Value;
      end
      else
        Value := UQParams[IdentityParamIdx].Value;
      Result := True;
    end;
  finally
    EndConnection;
  end;
end;

procedure TCustomMSDataSetUpdater.CheckUpdateQuery(const StatementType: TStatementType);
begin
  inherited;
end;

procedure TCustomMSDataSetUpdater.SetUpdateQueryOptions(const StatementType: TStatementType);
begin
  if IsClass(FUpdateQuery, TCustomDADataSet) then
    with TDBAccessUtils.GetIRecordSet(FUpdateQuery as TCustomDADataSet) do begin
      SetProp(prFetchAll, True);
      SetProp(prReadOnly, True);
      SetProp(prUniqueRecords, False);
      SetProp(prRequestSQLObjects, False);
    end;
end;

function TCustomMSDataSetUpdater.SavepointAllowed: boolean;
begin
  Result := FDataSetService.GetOLEDBProvider <> prCompact;
end;

function TCustomMSDataSetUpdater.GetDefaultExpressionValue(DefExpr: string; out Value: variant): boolean;
begin
  Result := True;
  DefExpr := UpperCase(Trim(DefExpr));
  if (DefExpr = '(NEWSEQUENTIALID())') then
    Value := Null
  else
    Result := inherited GetDefaultExpressionValue(DefExpr, Value);
end;

function TCustomMSDataSetUpdater.IsRefreshQuickField(FieldDesc: TFieldDesc): boolean;
begin
  Result := TOLEDBFieldDesc(FieldDesc).IsTimestamp;
end;

procedure TCustomMSDataSetUpdater.SaveMaxRefreshQuickValue(FieldDesc: TFieldDesc; const Value: variant);
var
  Field: TOLEDBFieldDesc;
  Val: Int64;
  MaxTimestamp: Int64;
{$IFDEF CLR}
  Data: TBytes;
{$ENDIF}
begin
  Field := TOLEDBFieldDesc(GetIRecordSet.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}
    MaxTimestamp := TOLEDBTableInfo(Field.TableInfo).MaxTimestamp;
    if {$IFDEF VER7P}UInt64{$ENDIF}(MaxTimestamp) < {$IFDEF VER7P}UInt64{$ENDIF}(Val) then
      TOLEDBTableInfo(Field.TableInfo).MaxTimestamp := Val;
  end;
end;

procedure TCustomMSDataSetUpdater.PrepareUpdate;
var
  CursorType: Variant;
begin
  inherited;

  if roBeforeEdit in FDataSet.RefreshOptions then begin
    GetIRecordSet.GetProp(prCursorType, CursorType);
    if TMSCursorType(Integer(CursorType)) in ServerCursorTypes then
      FDataSet.Resync([]); // CR 9097
  end;
end;

function TCustomMSDataSetUpdater.PerformRefreshRecord: boolean;
var
  Bookmark: TBookmark;
begin
  Result := True;
  case FDataSetService.GetCursorType of
    ctDefaultResultSet:
      Result := inherited PerformRefreshRecord;
    ctStatic, ctKeySet: begin
      Bookmark := FDataSet.GetBookmark;
      try
        GetIRecordSet.SetToBookmark(IntPtr(Bookmark)); // ReFetch
      finally
        FDataSet.FreeBookmark(Bookmark);
      end;
      SetRowsAffected(1); // Must be always OK
    end;
    ctDynamic: begin
      if GetIRecordSet.FetchToBookmarkValue then
        SetRowsAffected(1)
      else
        SetRowsAffected(0);
    end;
    ctBaseTable: begin
      if FDataSetService.GetCursorUpdate and not FDataSet.ReadOnly then begin // as for ctDynamic
        if GetIRecordSet.FetchToBookmarkValue then
          SetRowsAffected(1)
        else
          SetRowsAffected(0);
      end
      else // as for ctDefaultResultSet
        Result := inherited PerformRefreshRecord;
    end;
  end;
end;

function TCustomMSDataSetUpdater.LockCompare(const Value1, Value2: variant): boolean;
var
  DateTime1, DateTime2: TDateTime;
  Hour, Min, Sec1, MSec1, Sec2, MSec2: Word;
begin
  Result := inherited LockCompare(Value1, Value2);
  if not Result and (VarType(Value1) = varDate) and (VarType(Value2) = varDate) then begin
    DateTime1 := Value1;
    DecodeTime(DateTime1, Hour, Min, Sec1, MSec1);
    ReplaceTime(DateTime1, EncodeTime(Hour, Min, 0, 0));
    DateTime2 := Value2;
    DecodeTime(DateTime2, Hour, Min, Sec2, MSec2);
    ReplaceTime(DateTime2, EncodeTime(Hour, Min, 0, 0));
    Result := (DateTime1 = DateTime2) and (Abs(Sec1 * 1000 + MSec1 - (Sec2 * 1000 + MSec2)) < 1000);
  end;
end;

{ TCustomMSDataSetService }

constructor TCustomMSDataSetService.Create(AOwner: TMemDataSet);
begin
  inherited;
end;

procedure TCustomMSDataSetService.CreateDataSetUpdater;
begin
  SetDataSetUpdater(TCustomMSDataSetUpdater.Create(Self));
end;

procedure TCustomMSDataSetService.SetDataSetUpdater(Value: TDataSetUpdater);
begin
  inherited;

  FUpdater := TCustomMSDataSetUpdater(Value);
end;

procedure TCustomMSDataSetService.CreateSQLGenerator;
begin
  SetSQLGenerator(TCustomMSSQLGenerator.Create(TDASQLGeneratorService));
end;

function TCustomMSDataSetService.DetectCanModify: boolean;
begin
  Result := inherited DetectCanModify or
    not (FDataSet.ReadOnly or FDataSet.UniDirectional) and
    (FIsAnyFieldCanBeModified or  //upd1
    (FDataSet.SQLInsert.Count > 0) or
    (FDataSet.SQLUpdate.Count > 0) or
    (FDataSet.SQLDelete.Count > 0));
end;

procedure TCustomMSDataSetService.InitCursor;
var
  i: integer;
  Field: TField;
  FieldDesc: TFieldDesc;
begin
  inherited;

  // Set right precision for TFloatField
  for i := 0 to FDataSet.Fields.Count - 1 do begin
    Field := FDataSet.Fields[i];
    FieldDesc := FDataSet.GetFieldDesc(Field);
    if (Field is TFloatField)
      and (TFloatField(Field).Precision = 15 {Default})
      and (Field.FieldKind = fkData)
    then begin
      case FieldDesc.DataType of
        dtFloat, dtCurrency: // Precision cannot be greater then 15
          TFloatField(Field).Precision := FieldDesc.Length;
      end;
    end;
  end;  
end;

procedure TCustomMSDataSetService.CloseCursor;
begin
  inherited;
end;

procedure TCustomMSDataSetService.SetFieldOrigin(Field: TField; FieldDesc: TCRFieldDesc);
var
  TableName: string;
  OLEDBFieldDesc: TOLEDBFieldDesc;
begin
  if Field.FieldKind = fkData then begin
    OLEDBFieldDesc := TOLEDBFieldDesc(FieldDesc);

    TableName := GenerateTableName(OLEDBFieldDesc.BaseCatalogName, OLEDBFieldDesc.BaseSchemaName,
      OLEDBFieldDesc.BaseTableName, GetDatabase);
    Field.Origin := TableName + '.' + OLEDBSQLInfo.NormalizeName(OLEDBFieldDesc.ActualName);
  end;
end;

procedure TCustomMSDataSetService.FillFieldsDefaultValues;
var
  MetaData: TDAMetadata;
  Field: TField;
  FieldDesc: TFieldDesc;
  DefValue, DatabaseName, SchemaName, TableName: string;
  FldName: string;
begin
  if not FDataSet.Options.DefaultValues or (GetIRecordSet.UpdatingTableInfo = nil) then
    Exit;

  MetaData := TDAMetadata.Create(nil);
  try
    MetaData.Connection := UsedConnection;
    MetaData.MetaDataKind := 'columns';
    OLEDBSQLInfo.SplitObjectName(GetIRecordSet.UpdatingTableInfo.TableName, DatabaseName, SchemaName, TableName);
    if SchemaName = '' then
      SchemaName := 'dbo';
    MetaData.Restrictions.Values['TABLE_CATALOG'] := DatabaseName;
    MetaData.Restrictions.Values['TABLE_SCHEMA'] := SchemaName;
    MetaData.Restrictions.Values['TABLE_NAME'] := TableName;
    MetaData.Open;
    while not MetaData.EOF do begin
      if not MetaData.FieldByName('DEFAULT_VALUE').IsNull then begin
        FldName := MetaData.FieldByName('COLUMN_NAME').AsString;
        FieldDesc := GetIRecordSet.FindField(FldName);

        if FieldDesc <> nil then begin
          Field := FDataSet.GetField(FieldDesc);
          if Field <> nil then begin
            DefValue := MetaData.FieldByName('DEFAULT_VALUE').AsString;
            if (Field.DataType = ftGuid) and (Pos('{', DefValue) = 0) then begin
              DefValue := StringReplace(DefValue, '(''', '(''{', []);
              DefValue := StringReplace(DefValue, ''')', '}'')', []);
            end;
            if DefaultExpressionOldBehavior then
              case Field.DataType of
                ftBoolean:
                  Field.DefaultExpression := BoolToStr((DefValue <> '0') and (DefValue <> '((0))'), True);
                ftFloat, ftBCD{$IFDEF VER6P}, ftFMTBCD{$ENDIF}:
                  Field.DefaultExpression := StringReplace(DefValue, '.', {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator, [rfReplaceAll]);
                else
                  Field.DefaultExpression := DefValue;
              end
            else
              Field.DefaultExpression := DefValue;
          end;
        end;
      end;
      MetaData.Next;
    end;
  finally
    MetaData.Free;
  end;
end;

function TCustomMSDataSetService.GetRecCount: integer;
var
  i: integer;
  OldParamCheck: boolean;
  UQ: TCustomDADataSet;
  MonitorClass: TDASQLMonitorClass;
  MessageID: cardinal;
  NonBlocking: variant;
  SQL: string;
  CountIsParam: boolean;
begin
  Result := 0;
  GetIRecordSet.GetProp(prNonBlocking, NonBlocking);
  if ((not IsFetchAll or NonBlocking) and FDataSet.Options.QueryRecCount) // Server cursors or DefaultResultSet with FetchAll = False
    and not ((FDataSet.Params.Count > 0) and (FDataSet.Params[0].ParamType = ptResult)) then begin // Current SQL does not have RETURN parameter
    SQL := Trim(FDataSet.SQLRecCount.Text);
    CountIsParam := False;
    if SQL = '' then begin
      SQL := FSQLGenerator.GenerateRecCountSQL;
      CountIsParam := TCustomMSSQLGenerator(FSQLGenerator).CountIsParam;
    end;
    if SQL = '' then
      Exit;

    FUpdater.CheckUpdateQuery(stCustom);
    UQ := FUpdater.UpdateQuery as TCustomDADataSet;
    OldParamCheck := UQ.ParamCheck;
    try
      UQ.ParamCheck := FDataSet.ParamCheck;
      UQ.SQL.Text := SQL;
      UQ.Macros.Assign(FDataSet.Macros);

      if CountIsParam then begin
        if not FDataSet.ParamCheck then
          UQ.Params.Add;

        UQ.Params[0].DataType := ftLargeint;
        UQ.Params[0].ParamType := ptOutput;
      end;

      for i := 0 to FDataSet.Params.Count - 1 do begin
        if not FDataSet.ParamCheck then
          UQ.Params.Add;
        if CountIsParam then
          UQ.Params[i + 1].Assign(FDataSet.Params[i])
        else
          UQ.Params[i].Assign(FDataSet.Params[i]);
      end;

      MonitorClass := TDASQLMonitorClass(TDBAccessUtils.SQLMonitorClass(UsedConnection));
      if MonitorClass.HasMonitor or FDataSet.Debug then
        MonitorClass.SQLExecute(FDataSet, SQL, UQ.Params, 'Get RecordCount', MessageID, True);

      if CountIsParam then begin
        UQ.Execute;
        Result := UQ.Params[0].Value;
      end
      else begin
        UQ.Open;
        Result := UQ.Fields[0].Value;
      end;

      if MonitorClass.HasMonitor or FDataSet.Debug then
        MonitorClass.SQLExecute(FDataSet, SQL, UQ.Params, 'Get RecordCount', MessageID, False);
    finally
      UQ.ParamCheck := OldParamCheck;
    end;
  end
  else
    Result := inherited GetRecCount;
end;

procedure TCustomMSDataSetService.SetNumberRange(FieldDef: TFieldDef);
var
  Field: TField;
  FieldDesc: TOLEDBFieldDesc;
{$IFDEF VER6P}
  mv: Extended;
{$ENDIF}
  ServerVersion: integer;
begin
  ServerVersion := GetIConnection.ProviderPrimaryVer;
  Field := FDataSet.FindField(FieldDef.Name);
  if Field <> nil then begin
    FieldDesc := FDataSet.GetFieldDesc(Field) as TOLEDBFieldDesc;
    case FieldDesc.DataType of
      dtInt8: begin
        TIntegerField(Field).MinValue := -128;
        TIntegerField(Field).MaxValue := 127;
      end;
      dtUInt8: begin
        TIntegerField(Field).MinValue := 0;
        TIntegerField(Field).MaxValue := 255;
      end;
      dtInt16: begin
        TIntegerField(Field).MinValue := -32768;
        TIntegerField(Field).MaxValue := 32767;
      end;
      dtInt32: begin
        TIntegerField(Field).MinValue := -2147483647;
        TIntegerField(Field).MaxValue := 2147483647;
      end;
      dtInt64: begin
        TLargeintField(Field).MinValue := -9223372036854775807;
        TLargeintField(Field).MaxValue := 9223372036854775807;
      end;
      dtUInt64: begin
        TLargeintField(Field).MinValue := 0;
        TLargeintField(Field).MaxValue := 9223372036854775807;
      end;
      dtWord: begin
        TWordField(Field).MinValue := 0;
        TWordField(Field).MaxValue := 65535;
      end;
      dtSingle: begin
      {$IFDEF VER14P}
        TSingleField(Field).MinValue := -3.40E38;
        TSingleField(Field).MaxValue := 3.40E38;
      {$ELSE}
        TFloatField(Field).MinValue := -3.40E38;
        TFloatField(Field).MaxValue := 3.40E38;
      {$ENDIF}
      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}
    {$IFNDEF FPC}
      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}
    {$ENDIF}
      dtCurrency: begin
        if IsCompactEdition(ServerVersion) then begin
          TCurrencyField(Field).MinValue := -922337203685477.5808;
          TCurrencyField(Field).MaxValue := 922337203685477.5807;
        end
        else 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;
      end;
    end;
  end;
end;

function TCustomMSDataSetService.OpenNext: boolean;
var
  MaintainConnection: boolean;
begin
  // InternalClose and FIsInInitFieldDefs. Workaround for FiedDefs.Update has
  // been removed because it was duplicated by TOLEDBRecordSet.InternalInitFields
  // method

  // UnPrepare. Code concerning OpenNext has been removed because it was duplicated
  // by internal layer

  if FDataSet.Prepared then
    DatabaseError(SOpenNextPreparedSQL);

  if not FDataSet.Active then begin
    FDataSet.Open;
    Result := True;
  end
  else begin
    MaintainConnection := UsedConnection.Connected;

    if MaintainConnection then
      BeginConnection;

    try
      Assert(GetIRecordSet <> nil);
      GetIRecordSet.SetProp(prLockClearMultipleResults, True);
      try
        FDataSet.Close;
        FDataSet.UnPrepare;
      finally
        GetIRecordSet.SetProp(prLockClearMultipleResults, False);
      end;

      Result := not TOLEDBCommand(GetIRecordSet.GetCommand).IUnknownNextIsNull;

      if Result then begin
        FDataSet.FieldDefs.Updated := False;
        FDataSet.Open;
      end;
    finally
      if MaintainConnection then 
        EndConnection;
    end;
  end;
end;

procedure TCustomMSDataSetService.InitMasterParams(Params: TDAParams);
var
  MasterPos: integer;
  MasterName: string;
  Param: TDAParam;
begin
  if (FDataSet.DataSource <> nil) and
    (FDataSet.MasterFields <> '') and (FDataSet.DetailFields <> '') and
    not ((FDataSet.DataSource.DataSet <> nil) and FDataSet.DataSource.DataSet.Active)
    and not FDataSet.Options.LocalMasterDetail and not FDataSet.Prepared
  then begin
    MasterPos := 1;
    while True do begin
      MasterName := ExtractFieldName(FDataSet.MasterFields, MasterPos);
      if MasterName <> '' then begin
        Param := Params.FindParam(MasterName);
        if (Param <> nil) and (Param.DataType = ftUnknown) then
          Param.DataType := ftString;
      end
      else
        break;
    end;
  end;
end;

function TCustomMSDataSetService.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prLockType:
      TCustomMSSQLGenerator(SQLGenerator).LockType := TMSLockTypeI(Value);
    prLockObject:
      TCustomMSSQLGenerator(SQLGenerator).LockObject := TMSLockObjectI(Value);
    prQueryIdentity:
      TCustomMSSQLGenerator(SQLGenerator).QueryIdentity := Value;
    prCheckRowVersion:
      TCustomMSSQLGenerator(SQLGenerator).CheckRowVersion := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TCustomMSDataSetService.GetIConnection: TOLEDBConnection;
begin
  Result := TOLEDBConnection(TDBAccessUtils.GetIConnection(UsedConnection));
  Assert(Result <> nil); //upd1 should be error
end;

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

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

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

function TCustomMSDataSetService.GetCursorUpdate: boolean;
var
  Value: Variant;
begin
  GetIRecordSet.GetProp(prCursorUpdate, Value);
  Result := Value;
end;

procedure TCustomMSDataSetService.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 TCustomMSDataSetService.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', TOLEDBFieldDesc(FieldDesc).BaseCatalogName);

    if TOLEDBFieldDesc(FieldDesc).BaseSchemaName <> '' then
      XmlWriter.WriteAttributeString('rs:baseschema', TOLEDBFieldDesc(FieldDesc).BaseSchemaName);

    if TOLEDBFieldDesc(FieldDesc).IsTimestamp then
      XmlWriter.WriteAttributeString('rs:rowver', 'true');
  end;
end;

procedure TCustomMSDataSetService.GetFilestreamContext(const FieldName: string;
  var PathName: WideString; var FSTrContext: variant);
var
  MonitorClass: TDASQLMonitorClass;
  MessageID: cardinal;
  UpdateQuery: TCustomDADataSet;
  ParamInfo: TDAParamInfo;
  Param: TDAParam;
  SQL: string;
  i: integer;
begin
  FUpdater.CheckUpdateQuery(stCustom);
  UpdateQuery := FUpdater.UpdateQuery as TCustomDADataSet;

  SQL := TCustomMSSQLGenerator(FSQLGenerator).GenerateSelectFilestreamContextSQL(FieldName);
  UpdateQuery.Params.BeginUpdate;
  try
    UpdateQuery.Params.Clear;

    for i := 0 to FSQLGenerator.ParamsInfo.Count - 1 do begin
      ParamInfo := FSQLGenerator.ParamsInfo[i];
      Param := TDAParam(UpdateQuery.Params.Add);
      Param.Name := ParamInfo.ParamName;
      Param.ParamType := TParamType(ParamInfo.ParamType);
    end;
  finally
    UpdateQuery.Params.EndUpdate;
    RecreateParamsRef(UpdateQuery.Params);
  end;

  TDBAccessUtils.SetSQLText(UpdateQuery, SQL, True, True);
  FUpdater.WriteUQParams(FSQLGenerator.ParamsInfo, [stCustom]);

  BeginConnection;
  try
    MonitorClass := TDASQLMonitorClass(TDBAccessUtils.SQLMonitorClass(UsedConnection));
    if not TDBAccessUtils.GetLockDebug(FDataSet) and (MonitorClass.HasMonitor or FDataSet.Debug) then
      MonitorClass.SQLExecute(FDataSet, SQL, UpdateQuery.Params, 'Get filestream context', MessageID, True);

    UpdateQuery.Open;

    if not TDBAccessUtils.GetLockDebug(FDataSet) and (MonitorClass.HasMonitor or FDataSet.Debug) then
      MonitorClass.SQLExecute(FDataSet, SQL, UpdateQuery.Params, 'Get filestream context', MessageID, False);

    try
      if UpdateQuery.Fields[0].IsNull then
        raise Exception.CreateFmt(SWrongBlob, [FieldName]);
      if UpdateQuery.Fields[1].IsNull then
        raise Exception.Create(SEmptyFSTransactionContext);

      PathName := VarToWideStr(UpdateQuery.Fields[0].Value);
      FSTrContext := UpdateQuery.Fields[1].Value;
    finally
      UpdateQuery.Close;
    end;
  finally
    EndConnection;
  end;
end;

{ TMSServerEnumerator }

function TMSServerEnumerator.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 TMSServerEnumerator.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := inherited GetProp(Prop, Value);
end;

procedure TMSServerEnumerator.GetServerList(List: TStrings);

  var
    ServerList: TStringList;

  procedure GetServerListByReg;

   procedure AddComputerName(sl: TStringList);
    var
      CompName: string;
    {$IFDEF CLR}
      sb: StringBuilder;
    {$ENDIF}
      Size: cardinal;
      i: integer;
    begin
      if sl.Count < 1 then
        Exit;
      Size := MAX_COMPUTERNAME_LENGTH;
      SetLength(CompName, Size);

    {$IFDEF CLR}
      sb := StringBuilder.Create(Size);
      try
        GetComputerName(sb, Size);
        CompName := sb.ToString;
      finally
        sb.Free;
      end;
    {$ELSE}
      GetComputerName(PChar(CompName), Size);
      SetLength(CompName, Size);
    {$ENDIF}

      for i := 0 to sl.Count - 1 do
        if AnsiUpperCase(sl[i]) = 'MSSQLSERVER' then
          sl[i] := CompName                  // not named instance
        else
          sl[i] := CompName + '\' + sl[i];   // named instance
    end;

  var
    Reg: TRegistry;
    i: integer;
    Value: string;
    sl: TStringList;
  begin
    Reg := TRegistry.Create;
    sl := TStringList.Create;
    try
      // get server list to which Enterprise Manager was connected
      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;
        ServerList.AddStrings(sl);
        Reg.CloseKey;
      end;

      // get local SQL Server instances
      if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Microsoft SQL Server\Instance Names\SQL') then begin
        Reg.GetValueNames(sl);

        AddComputerName(sl);
        ServerList.AddStrings(sl);
      end;

    finally
      Reg.Free;
      sl.Free;
    end;
  end;

  procedure GetServerListByOleDBEnum;
  var
    SourcesRowset: ISourcesRowset;
    Rowset: IRowset;
    ds: TOLEDBRecordSet;
    iu: IUnknown;
    RecBuf, FieldBuf: IntPtr;
    IsBlank: boolean;
    Field: TFieldDesc;
  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 := TOLEDBRecordSet.Create;
    try
       ds.SetIRowset(Rowset);
       ds.Open;

       Field := ds.Fields[0];
       ds.AllocRecBuf(RecBuf);
       FieldBuf := Marshal.AllocHGlobal(Field.Size + 1);
       try
         while True do begin
           ds.GetNextRecord(RecBuf);
           if ds.Eof then
             Break;

           ds.GetField(Field, RecBuf, FieldBuf, False, IsBlank);
           if IsBlank then
             Continue;

           if Field.DataType = dtWideString then
             ServerList.Add(Marshal.PtrToStringUni(FieldBuf))
           else
             ServerList.Add(string(Marshal.PtrToStringAnsi(FieldBuf)));
         end;
       finally
         ds.Close;
         Marshal.FreeHGlobal(RecBuf);
         Marshal.FreeHGlobal(FieldBuf);
       end;
    finally
      ds.Free;
    end;
  end;

{$IFDEF WIN32}
  procedure GetServerListBySocket;
  var
    r: integer;
    FSd: longint;
    SndBuf, Nodelay, Broadcast, Timeout: longint;
    sock_addr: TSockAddr;
    buf: Byte;
    Buffer: array[0..8191] of Byte;
    Count: Integer;
    AnsiStr: AnsiString;
    str: string;
    pLexem, p1, p2: Integer;
    ServerName, InstanceName: string;
  begin
    if WsaData.wVersion = 0 then begin // not initialized
      r := WSAStartup($0101, WsaData);
      if r <> 0 then
        raise Exception.CreateFmt(SSocketError, [r]);
    end;

    FSd := socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
    if FSd = SOCKET_ERROR then
      raise Exception.CreateFmt(SSocketError, [FSd]);

    try
      SndBuf := 0;
      setsockopt(FSd, SOL_SOCKET, SO_SNDBUF, PAnsiChar(@SndBuf), sizeof(SndBuf));
      Nodelay := 1;
      setsockopt(FSd, SOL_SOCKET, TCP_NODELAY, PAnsiChar(@Nodelay), sizeof(Nodelay));
      Broadcast := 1;
      setsockopt(FSd, SOL_SOCKET, SO_BROADCAST, PAnsiChar(@Broadcast), sizeof(Broadcast));
      Timeout := 500;
      setsockopt(FSd, SOL_SOCKET, SO_RCVTIMEO, PAnsiChar(@Timeout), sizeof(Timeout));
      sock_addr.sin_family := AF_INET;
      sock_addr.sin_addr.s_addr := -1; // inet_addr(PChar('255.255.255.255'))
      sock_addr.sin_port := htons(1434);

      buf := 3; //ping
      sendto(FSd, buf, 1, 0, sock_addr, sizeof(sock_addr));

      while True do begin
        Count := recv(FSd, Buffer, sizeof(Buffer), 0);
        if Count <= 0 then
          Break;
          
        SetLength(AnsiStr, Count - 3);
        Move(Buffer[3], AnsiStr[1], Length(AnsiStr));
        str := string(AnsiStr);
        
        pLexem := Pos('ServerName', str);
        while pLexem > 0 do begin
          p1 := PosEx(';', str, pLexem + 10{Length('ServerName')});
          if p1 = 0 then
            raise Exception.Create(SInvalidValue);
          p2 := PosEx(';', str, p1 + 1);
          if p2 = 0 then
            raise Exception.Create(SInvalidValue);
          ServerName := Copy(str, p1 + 1, p2 - p1 - 1);
          
          pLexem := PosEx('InstanceName', str, p2 + 1);
          p1 := PosEx(';', str, pLexem + 12{Length('InstanceName')});
          if p1 = 0 then
            raise Exception.Create(SInvalidValue);
          p2 := PosEx(';', str, p1 + 1);
          if p2 = 0 then
            raise Exception.Create(SInvalidValue);
          InstanceName := Copy(str, p1 + 1, p2 - p1 - 1);
          if AnsiUpperCase(InstanceName) <> 'MSSQLSERVER' then
            ServerName := ServerName + '\' + InstanceName;

          ServerList.Add(ServerName);
          pLexem := PosEx('ServerName', str, p2 + 1);
        end;
      end;

    finally
      closesocket(FSd);
    end;
  end;
{$ENDIF}

  procedure OrderList;
  var
    i: integer;
  begin
    ServerList.Sort;
    // delete duplicates
    i := 0;
    while i < ServerList.Count - 1 do
      if AnsiUpperCase(ServerList[i]) = AnsiUpperCase(ServerList[i + 1]) then
        ServerList.Delete(i + 1)
      else
        inc(i);
  end;

begin
  List.Clear;

  if FProvider = prCompact then
    Exit;

  ServerList := TStringList.Create;
  try
    GetServerListByOleDBEnum;
    GetServerListByReg;
  {$IFDEF WIN32}
    GetServerListBySocket;
  {$ENDIF}
    OrderList;
    List.AddStrings(ServerList);
  finally
    ServerList.Free;
  end;

end;

{ TCustomMSDumpProcessor }

{$IFNDEF CLR}
type
  StringBuilderHelper = class (StringBuilder);
{$ENDIF}

constructor TCustomMSDumpProcessor.Create(Owner: TDADump);
begin
  inherited;
end;

function TCustomMSDumpProcessor.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prIdentityInsert:
      FIdentityInsert := Value;
    prDisableConstraints:
      FDisableConstraints := Value;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

function TCustomMSDumpProcessor.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prIdentityInsert:
      Value := FIdentityInsert;
    prDisableConstraints:
      Value := FDisableConstraints;
  else
    Assert(False, IntToStr(Prop));
    Result := False;
  end;
end;

function TCustomMSDumpProcessor.CreateQuery: TCustomDADataSet;
begin
  Result := GetConnection.CreateDataSet;
  TDBAccessUtils.CheckConnection(Result);
  Result.ReadOnly := False;
  //Result.FetchAll := True;
  Result.UniDirectional := True;
  Result.Options.SetFieldsReadOnly := True;
  Result.Options.QueryRecCount := False;
end;

procedure TCustomMSDumpProcessor.BackupObjects(const Query: string);
var
  TableCount: integer;
  AlterTableSQL: TStringList;

  procedure VarToMSSQL(Field: TField; FieldDesc: TOLEDBFieldDesc; sb: StringBuilder);
  var
    dt: TDateTime;
    Blob: TBlob;
    Piece: PPieceHeader;
    Value: Variant;
    Data: TBytes;
  {$IFNDEF VER6P}
    pValueData: PVarData;
  {$ENDIF}
  {$IFDEF CLR}
    Bytes: TBytes;
  {$ELSE}
    sbOffset: integer;
  {$ENDIF}
  begin
    SetLength(Data, 0); // To avoid Hint from compiler
    case FieldDesc.DataType of
      dtBoolean:
        sb.Append(BoolToStr(Field.AsBoolean));
      dtUnknown, dtString, dtMemo, dtWideMemo, dtExtString, dtWideString, dtExtWideString, dtGuid{$IFDEF VER5P}, dtVariant{$ENDIF}:
        sb.Append(QuotedStr(Field.AsString));
      dtInt8, dtInt16, dtInt32, dtInt64,
      dtUInt8, dtUInt16, dtUInt32, dtUInt64: begin
      {$IFNDEF VER6P}
        Value := Field.AsVariant;
        pValueData := @TVarData(Value);
        if pValueData.VType = varDecimal then
          sb.Append(IntToStr(PInt64(@pValueData.VInteger)^))
        else
      {$ENDIF}
          sb.Append(Field.AsString);
      end;
      dtFloat, dtCurrency, dtSingle:
        sb.Append(ChangeDecimalSeparator(Field.AsString));
      dtDate, dtTime, dtDateTime: begin
        dt := Field.AsDateTime;
        if dt = 0 then
          sb.Append(QuotedStr('1900-01-01 00:00:00'))
        else
          sb.Append(QuotedStr(FormatDateTime('YYYY-MM-DD HH:NN:SS', dt)));
      end;
      dtBlob, dtMSXML: begin
        sb.Append('0x');
        Blob := FQuery.GetBlob(Field.FieldName);
        Piece := Blob.FirstPiece;

      {$IFDEF CLR}
        while IntPtr(Piece) <> nil do begin
          SetLength(Data, Piece.Used);
          Marshal.Copy(PtrOffset(Piece, sizeof(TPieceHeader)), Data, 0, Piece.Used);
          SetLength(Bytes, Length(Data) * 2);
          BinToHex(Data, 0, Bytes, 0, Length(Data));
          sb.Append(Encoding.Default.GetString(Bytes));
          Piece := Piece.Next;
        end;
      {$ELSE}
        sbOffset := sb.Length;
        sb.Length := sb.Length + Integer(Blob.GetData.GetDataSize) * 2;
        while Piece <> nil do begin
          BinToHex(pchar(PtrOffset(Piece, sizeof(TPieceHeader))),
            PChar(@StringBuilderHelper(sb).FString[sbOffset]), Piece.Used);
          sbOffset := sbOffset + Integer(Piece.Used) * 2;
          Piece := Piece.Next;
        end;
      {$ENDIF}
      end;
      dtBytes, dtVarBytes, dtExtVarBytes: begin
        sb.Append('0x');
        Value := Field.Value;
        Data := Value;
      {$IFDEF CLR}
        SetLength(Bytes, Length(Data) * 2);
        BinToHex(Data, 0, Bytes, 0, Length(Data));
        sb.Append(Encoding.Default.GetString(Bytes));
      {$ELSE}
        sbOffset := sb.Length;
        sb.Length := sb.Length + Length(Data) * 2;
        BinToHex(@Data[0],
          PChar(@StringBuilderHelper(sb).FString[sbOffset]), Length(Data));
      {$ENDIF}
      end;
      else
        Assert(False, 'Unknown datatype (' + IntToStr(FieldDesc.DataType) + ')');
    end;
  end;

  procedure BackupTablesAndData;

    function FieldIsIdentity(Field: TField): boolean;
    var
      FieldDesc: TOLEDBFieldDesc;
    begin
      FieldDesc := FQuery.GetFieldDesc(Field) as TOLEDBFieldDesc;
      Result := FieldDesc.IsAutoIncrement;
    end;

    procedure BackupTable(TableName: string; TableNum: integer);
    var
      KeyAndDataFields: TKeyAndDataFields;

      procedure GetCurrentRow(sb: StringBuilder);
      var
        sbOldLen: integer;

        procedure ProcessField(FieldDesc: TOLEDBFieldDesc);
        var
          Value: Variant;
          Field: TField;
        begin
          if sbOldLen <> sb.Length then
            sb.Append(', ');

          Field := FQuery.GetField(FieldDesc);
          Value := Field.AsVariant;
          if VarIsEmpty(Value) or VarIsNull(Value) or Field.IsNull then
            sb.Append('NULL')
          else
            VarToMSSQL(Field, FieldDesc, sb);
        end;

      var
        i: integer;
      begin
        sbOldLen := sb.Length;

        if Length(KeyAndDataFields.DataFieldDescs) = 0 then begin
          for i := 0 to FQuery.FieldCount - 1 do
            if not (FieldIsIdentity(FQuery.Fields[i]) and not FIdentityInsert) then
              ProcessField(TOLEDBFieldDesc(FQuery.GetFieldDesc(FQuery.Fields[i])));
        end
        else
        begin
          if (TDBAccessUtils.GetIdentityField(FQuery) <> nil) and FIdentityInsert then
            ProcessField(TOLEDBFieldDesc(TDBAccessUtils.GetIdentityField(FQuery)));
          for i := 0 to Length(KeyAndDataFields.DataFieldDescs) - 1 do
            ProcessField(TOLEDBFieldDesc(KeyAndDataFields.DataFieldDescs[i]));
        end;
      end;

    var
      RecordCount: integer;
      InsHeader: string;
      FieldList: string;
      i: integer;
      SQLSelect1: string;
      sb: StringBuilder;
      IdentityInsertUsed: Boolean;

    begin
      FieldList := '';
      if Query = '' then
        SQLSelect1 := 'SELECT * FROM ' + TableName
      else
        SQLSelect1 := Query;

      FQuery.SQL.Text := SQLSelect1;
      FQuery.AddWhere('0=1');
      try
        FQuery.Open;

        if (TableName = '')
          and (TDBAccessUtils.GetTablesInfo(FQuery).Count > 0) then
          TableName := TDBAccessUtils.GetTablesInfo(FQuery)[0].TableName;

        if (TDBAccessUtils.GetIdentityField(FQuery) <> nil) and FIdentityInsert then
          FieldList := QuoteName(TDBAccessUtils.GetIdentityField(FQuery).Name);

        TDBAccessUtils.GetKeyAndDataFields(FQuery, KeyAndDataFields, False);
        for i := 0 to Length(KeyAndDataFields.DataFieldDescs) - 1 do
          if not (TOLEDBFieldDesc(KeyAndDataFields.DataFieldDescs[i]).IsAutoIncrement and not FIdentityInsert) then
            if FieldList = '' then
              FieldList := QuoteName(KeyAndDataFields.DataFieldDescs[i].Name)
            else
              FieldList := FieldList + ', ' + QuoteName(KeyAndDataFields.DataFieldDescs[i].Name);
      finally
        FQuery.Close;
      end;

      if True {(doData in Objects)} then begin
        if FOwner.Options.GenerateHeader then
          AddLineToSQL(SBHTableData, [TableName]);

        if FOwner.Options.AddDrop {and not (doTables in Objects)} then
          Add('TRUNCATE TABLE ' + TableName + ';');

        FQuery.SQL.Text := 'SELECT COUNT(*) FROM ' + TableName;
        FQuery.Execute;
        RecordCount := FQuery.Fields[0].AsInteger;

        DoBackupProgress(TableName, TableNum, TableCount, 0);

        IdentityInsertUsed := False;

        if RecordCount > 0 then begin
          if FieldList = '' then
            InsHeader := TableName
          else
            InsHeader := TableName + '(' + FieldList + ')';

          InsHeader := 'INSERT INTO ' + InsHeader + ' VALUES';

          FQuery.SQL.Text := SQLSelect1;
          FQuery.Open;
          if FieldList <> '' then
            TDBAccessUtils.GetKeyAndDataFields(FQuery, KeyAndDataFields, False);

          if FIdentityInsert then
            for i := 0 to FQuery.FieldCount - 1 do
              if FieldIsIdentity(FQuery.Fields[i]) then begin
                Add(Format('SET IDENTITY_INSERT %s ON;', [TableName]));
                IdentityInsertUsed := True;
                break;
              end;

          sb := StringBuilder.Create;
          try
            while not FQuery.Eof do begin
              DoBackupProgress(TableName, TableNum, TableCount, Trunc((FQuery.RecNo / RecordCount) * 100));

              sb.Length := 0;
              sb.Append(InsHeader);
              sb.Append(' (');
              GetCurrentRow(sb);
              sb.Append(');');
              Add(sb.ToString);
              FQuery.Next;
            end;
          finally
            sb.Free;
          end;
        end;
        if IdentityInsertUsed then
          Add(Format('SET IDENTITY_INSERT %s OFF;', [TableName]));
      end;
    end;

    procedure BackupConstraint(const TableName, Schema: string);
    const
      NO_ACTION = 'NO ACTION';
    var
      ConstraintName: string;
      Columns, RefTableName, RefColumns: string;
      UpdateRule, DeleteRule: string;
      Replication: string;
      SQL: string;
    begin
      FQuery.ParamByName('Table_Schema').AsString := Schema;
      FQuery.ParamByName('Table_Name').AsString := TableName;
      FQuery.Open;

      while not FQuery.Eof do begin
        ConstraintName := FQuery.FieldByName('CONSTRAINT_NAME').AsString;
        UpdateRule := FQuery.FieldByName('UPDATE_RULE').AsString;
        DeleteRule := FQuery.FieldByName('DELETE_RULE').AsString;
        RefTableName := QuoteName(FQuery.FieldByName('RK_TABLE_SCHEMA').AsString) +
          '.' + QuoteName(FQuery.FieldByName('RK_TABLE_NAME').AsString);
        Columns := '';
        RefColumns := '';
        if FQuery.FieldByName('is_not_for_replication').AsBoolean then
          Replication := ' NOT FOR REPLICATION;'
        else
          Replication := ';';

        repeat
          if Columns <> '' then
            Columns := Columns + ', ';
          Columns := Columns + QuoteName(FQuery.FieldByName('FK_COLUMN_NAME').AsString);

          if RefColumns <> '' then
            RefColumns := RefColumns + ', ';
          RefColumns := RefColumns + QuoteName(FQuery.FieldByName('RK_COLUMN_NAME').AsString);

          FQuery.Next;
        until FQuery.Eof or (ConstraintName <> FQuery.FieldByName('CONSTRAINT_NAME').AsString);

        if FOwner.Options.GenerateHeader and (AlterTableSQL.Count = 0) then
          AddLineToSQL(SBHDropConstraints);

        SQL := 'ALTER TABLE ' + QuoteName(Schema) + '.' + QuoteName(TableName) +
          ' DROP CONSTRAINT ' + QuoteName(ConstraintName) + ';';
        AddLineToSQL(SQL);
        Add('');

        SQL := 'ALTER TABLE ' + QuoteName(Schema) + '.' + QuoteName(TableName) +
          ' WITH CHECK ADD CONSTRAINT ' + QuoteName(ConstraintName) +
          ' FOREIGN KEY(' + Columns + ')' + SLLineSeparator +
          'REFERENCES ' + RefTableName + ' (' + RefColumns + ')';

        if (UpdateRule <> NO_ACTION) or (DeleteRule <> NO_ACTION) then
          SQL := SQL + SLLineSeparator +
            'ON UPDATE ' + UpdateRule + ' ON DELETE ' + DeleteRule;
        SQL := SQL + Replication;

        AlterTableSQL.Add(SQL);
        AlterTableSQL.Add('');
      end;

      FQuery.Close;
    end;

  const
    QUERY_CONSTRAINT =
      'SELECT RC.CONSTRAINT_NAME, RC.UPDATE_RULE, RC.DELETE_RULE,' + DALineSeparator +
      '  FK.TABLE_SCHEMA FK_TABLE_SCHEMA, FK.TABLE_NAME FK_TABLE_NAME, FK.COLUMN_NAME FK_COLUMN_NAME,' + DALineSeparator +
      '  RK.TABLE_SCHEMA RK_TABLE_SCHEMA, RK.TABLE_NAME RK_TABLE_NAME, RK.COLUMN_NAME RK_COLUMN_NAME,' + DALineSeparator +
      '  sys_fk.is_not_for_replication' + DALineSeparator +
      'FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS RC LEFT JOIN' + DALineSeparator +
      '  INFORMATION_SCHEMA.KEY_COLUMN_USAGE FK ON RC.CONSTRAINT_NAME = FK.CONSTRAINT_NAME LEFT JOIN' + DALineSeparator +
      '  INFORMATION_SCHEMA.KEY_COLUMN_USAGE RK ON (RC.UNIQUE_CONSTRAINT_NAME = RK.CONSTRAINT_NAME AND FK.ORDINAL_POSITION = RK.ORDINAL_POSITION) LEFT JOIN' + DALineSeparator +
      '  sys.foreign_keys sys_fk ON RC.CONSTRAINT_NAME = sys_fk.name' + DALineSeparator +
      'WHERE FK.TABLE_SCHEMA = :Table_Schema' + DALineSeparator +
      '  AND FK.TABLE_NAME = :Table_Name' + DALineSeparator +
      'ORDER BY RC.CONSTRAINT_NAME, FK.ORDINAL_POSITION';

  var
    i: integer;
    TablesList: TStringList;
    TableName, Db, Schema: string;
    ExactNames: boolean;

  begin
    if Query = '' then begin
      TablesList := nil;
      try
        TablesList := TStringList.Create;
        AlterTableSQL := TStringList.Create;

        if GetTables.Count = 0 then begin
          GetConnection.GetTableNames(TablesList, False, True);
          ExactNames := True;
        end
        else begin
          TablesList.Assign(GetTables);
          ExactNames := False;
        end;

        if FDisableConstraints then begin
          FQuery.SQL.Text := QUERY_CONSTRAINT;
          FQuery.Prepare;

          for i := 0 to TablesList.Count - 1 do begin
            if ExactNames then begin
              TableName := TablesList[i];
              Schema := '';
            end
            else begin
              OLEDBSQLInfo.SplitObjectName(TablesList[i], Db, Schema, TableName);
              Schema := SQLInfo.NormalizeName(Schema, False, True);
              TableName := SQLInfo.NormalizeName(TableName, False, True);
            end;

            if Schema = '' then
              Schema := 'dbo';

            BackupConstraint(TableName, Schema);
          end;
        end;

        for i := 0 to TablesList.Count - 1 do begin
          if ExactNames then
            TableName := TablesList[i]
          else
            TableName := SQLInfo.NormalizeName(TablesList[i], FOwner.Options.QuoteNames);

          DoBackupProgress(TableName, i, TablesList.Count, 0);

          TableCount := TablesList.Count;
          BackupTable(TableName, i);
          Add('');
        end;

        if FOwner.Options.GenerateHeader and (AlterTableSQL.Count > 0) then
          AddLineToSQL(SBHAddConstraints);
        Add(AlterTableSQL);
      finally
        TablesList.Free;
        AlterTableSQL.Free;
      end;
    end
    else
    begin
      if GetTables.Count = 1 then
        TableName := SQLInfo.NormalizeName(GetTables[0], FOwner.Options.QuoteNames)
      else
        TableName := '';

      DoBackupProgress(TableName, 0, 1, 0);

      TableCount := 1;
      BackupTable(TableName, 0);
      Add('');
    end;
  end;

begin
  CheckQuery;
  //if doData in Objects then
    BackupTablesAndData;
end;

end.
