myservicesuni.pas

来自「CrLab UniDAC 1.0 include sources」· PAS 代码 · 共 1,295 行 · 第 1/3 页

{$IFNDEF CLR}
{$I MyDac.inc}
unit MyServicesUni;
{$ENDIF}

interface

uses
{$IFDEF VER6P}
  Variants, DateUtils,
{$ENDIF}
{$IFNDEF CLR}
  CLRClasses,
{$ELSE}
  System.Text,
{$ENDIF}
  SysUtils, Classes, DB, MemDS, MemData, DBAccess, CRAccess,
{$IFNDEF UNIDACPRO}
  MyCall, MyClasses;
{$ELSE}
  MyCallUni, MyClassesUni;
{$ENDIF}

const
  prCheckRowVersion = 101;
  prLockType        = 102;

type
  TCustomMyDataSetService = class;

  TLockRecordTypeI = (ilrImmediately, ilrDelayed);
  TLockTypeI = (iltRead, iltReadLocal, iltWrite, iltWriteLowPriority);

  TCustomMySQLGenerator = class(TDASQLGenerator)
  protected
    FDataSetService: TCustomMyDataSetService;

    FLimit: integer;
    FOffset: integer;
    FUseHandler: boolean;
    FHandlerIndex: string;

    function GetParamInfoClass: TDAParamInfoClass; override;
    procedure AddFieldToCondition(SB: StringBuilder;
      FieldDesc: TCRFieldDesc;
      const StatementType: TStatementType;
      const ModifiedFieldsOnly: boolean;
      const Index: integer = -1); override;
    procedure AddParam(SB: StringBuilder; FieldDesc: TFieldDesc;
      const StatementType: TStatementType;
      const ParamType: TParamType;
      Index: integer = -1;
      Old: boolean = False); override;

    procedure GenerateConditions(SB: StringBuilder;
      const StatementType: TStatementType;
      const ModifiedFieldsOnly: boolean;
      const KeyAndDataFields: TKeyAndDataFields;
      const Index: integer = -1); override;

    procedure GenerateLockSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const Index: integer = -1); override;

    function GetActualFieldName(FldDesc: TCRFieldDesc; IsRefresh: boolean): string; override;

  public
    constructor Create(AOwner: TDADataSetService); override;
    function GetParamOffset(const Index: integer): integer;

    function GenerateTableSQL(const TableName, OrderFields: string): string; override;

    property Limit: integer read FLimit write FLimit;
    property Offset: integer read FOffset write FOffset;
    property UseHandler: boolean read FUseHandler write FUseHandler;
    property HandlerIndex: string read FHandlerIndex write FHandlerIndex;
  end;

  TCustomMyDataSetUpdater = class(TDADataSetUpdater)
  protected
    FDataSetService: TCustomMyDataSetService;

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

    procedure CheckUpdateQuery(const StatementType: TStatementType); override;
    procedure SetUpdateQueryOptions(const StatementType: TStatementType); override;
    procedure CheckUpdateSQL(const SQL: string; const StatementTypes: TStatementTypes;
      out ParamsInfo: TDAParamsInfo; UseGenerator: boolean = True); override;

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

    procedure PrepareUpdate; override;
    function PerformLock: boolean; override;

  public
    constructor Create(AOwner: TDataSetService); override;
  end;

  TCustomMyDataSetService = class(TDADataSetService)
  protected
    FUpdater: TCustomMyDataSetUpdater;

    FCheckRowVersion: boolean;
    FLockType: TLockRecordTypeI; // for GenerateLockSQL only
    FTimestampField: TMySQLFieldDesc;

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

    function GetIConnection: TMySQLConnection;
    function GetIRecordSet: TMySQLRecordSet;
    function IsFullRefresh: boolean;

    function DetectCanModify: boolean; override;
    function DetectIdentityField: TField; override;
    procedure CloseCursor; override;

    function CanUseAllKeyFields: boolean; override;
    procedure FillFieldDescs(out FieldDescs: TFieldDescArray; FillKeyFieldDescs, ForceUseAllFields: boolean);
    procedure FillKeyFieldDescs(out KeyFieldDescs: TFieldDescArray; ForceUseAllKeyFields: boolean); override;
    procedure FillDataFieldDescs(out DataFieldDescs: TFieldDescArray; ForceUseAllKeyFields: boolean); override;

    procedure InitCursor; override;
    procedure FillFieldsOrigin; override;
    procedure FillFieldsDefaultValues; override;

    function GetRecCount: integer; override;

    procedure SetNumberRange(FieldDef: TFieldDef); override;

  public
    constructor Create(AOwner: TMemDataSet); override;

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

    function OpenNext: boolean; override;

    function QuoteName(const AName: string): string; overload; override;
    function QuoteName(const AName: string; const LeftQuote, RightQuote: string): string; reintroduce; overload;
    function UnQuoteName(const AName: string): string; override;

    property TimestampField: TMySQLFieldDesc read FTimestampField;
  end;

  TMyServerEnumerator = class (TCRServerEnumerator)
  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;

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

implementation

uses
  Math, DAConsts, CRParser, MemUtils, DASQLMonitor,
{$IFNDEF UNIDACPRO}
  MyConsts, MyParser;
{$ELSE}
  MyConstsUni, MyParserUni;
{$ENDIF}

{ TCustomMySQLGenerator }

type
  TMyParamInfo = class (TDAParamInfo)
  public
    SB: StringBuilder;
    Offset: integer;
  end;

constructor TCustomMySQLGenerator.Create(AOwner: TDADataSetService);
begin
  inherited;

  FDataSetService := TCustomMyDataSetService(AOwner);
  FLimit := -1;
end;

function TCustomMySQLGenerator.GetParamInfoClass: TDAParamInfoClass;
begin
  Result := TMyParamInfo;
end;

procedure TCustomMySQLGenerator.AddFieldToCondition(
  SB: StringBuilder;
  FieldDesc: TCRFieldDesc;
  const StatementType: TStatementType;
  const ModifiedFieldsOnly: boolean;
  const Index: integer = -1);

var
  ActualName: string;
begin
  Assert(FieldDesc is TMySQLFieldDesc);

  if not Assigned(FieldDesc.TableInfo) then
    Exit;

  if ModifiedFieldsOnly
    and (StatementType = stRefresh)
    and FieldIsNull(FieldDesc, True)
    and (TMySQLFieldDesc(FieldDesc).MySQLType = FIELD_TYPE_TIMESTAMP) then begin // Not 'IS NULL'. Must be compared with '00000000'

    ActualName := GetActualFieldName(FieldDesc, StatementType = stRefresh);
    if SB.Length > 0 then
      SB.Append(' AND ');
    SB.Append(ActualName);
    SB.Append(' = ''00000000''');
    Exit;
  end;

  inherited;
end;

procedure TCustomMySQLGenerator.AddParam(SB: StringBuilder; FieldDesc: TFieldDesc;
      const StatementType: TStatementType;
      const ParamType: TParamType;
      Index: integer = -1;
      Old: boolean = False);
var
  ParamInfo: TMyParamInfo;
begin
  inherited;

  if FParams <> nil then begin
    ParamInfo := TMyParamInfo(FParamsInfo.Items[FParamsInfo.Count - 1]);
    ParamInfo.Offset := SB.Length - 1;
    ParamInfo.SB := SB;
  end;
end;

procedure TCustomMySQLGenerator.GenerateConditions(SB: StringBuilder;
      const StatementType: TStatementType;
      const ModifiedFieldsOnly: boolean;
      const KeyAndDataFields: TKeyAndDataFields;
      const Index: integer = -1);
var
  Major: integer;

  function GetTimestampField: TCRFieldDesc;
  var
    i: integer;
  begin
    Result := nil;
    for i := 0 to High(KeyAndDataFields.DataFieldDescs) do
      if TMySQLFieldDesc(KeyAndDataFields.DataFieldDescs[i]).MySQLType = FIELD_TYPE_TIMESTAMP then begin
        Result := KeyAndDataFields.DataFieldDescs[i];
        Break;
      end;
  end;

  procedure GenerateCondForRQ(TimestampFieldDesc: TFieldDesc);
  var
    TimestampField: TField;
  begin
    if TimestampFieldDesc = nil then
      DatabaseError(STimestampFieldRequired);
    TimestampField := FDataSet.GetField(TimestampFieldDesc);
    if TimestampField = nil then
      DatabaseError(STimestampFieldRequired);

    FCondSB.Append(GetActualFieldName(FDataSet.GetFieldDesc(TimestampField) as TCRFieldDesc, True) + ' >= ' + ValueToSQL(dtDateTime, TMyTableInfo(TMySQLFieldDesc(TimestampFieldDesc).TableInfo).MaxTimestamp, False, False{$IFDEF HAVE_COMPRESS}, False{$ENDIF}, Major));
  end;

var
  i: integer;
  FldUsed: set of byte;
  TimestampField: TField;
  TimestampFieldDesc: TCRFieldDesc;
begin
  Major := FDataSetService.GetIConnection.ServerPrimaryVer;

  if StatementType = stRefreshQuick then
    GenerateCondForRQ(GetTimestampField)
  else
    if FDataSetService.FCheckRowVersion and ((StatementType = stUpdate) or (StatementType = stDelete)) then begin
      FldUsed := [];
      if Length(KeyAndDataFields.KeyFieldDescs) > 0 then
        for i := 0 to High(KeyAndDataFields.KeyFieldDescs) do begin
          AddFieldToCondition(SB, KeyAndDataFields.KeyFieldDescs[i], StatementType, ModifiedFieldsOnly, Index);
          FldUsed := FldUsed + [KeyAndDataFields.KeyFieldDescs[i].FieldNo];
        end;

      TimestampFieldDesc := GetTimestampField;
      if TimestampFieldDesc = nil then
        TimestampField := nil
      else
        TimestampField := FDataSet.GetField(TimestampFieldDesc);

      // TimestampField may be nil and TimestampField.Value may be unassigned too
      if (TimestampField <> nil) and not TimestampField.IsNull then
        AddFieldToCondition(SB, TimestampFieldDesc, StatementType, ModifiedFieldsOnly, Index)
      else
      begin
        Assert(Length(KeyAndDataFields.DataFieldDescs) > 0);
        for i := 0 to High(KeyAndDataFields.DataFieldDescs) do
          if not IsBlobDataType(KeyAndDataFields.DataFieldDescs[i].DataType) // not "text", or "blob"
            and not (KeyAndDataFields.DataFieldDescs[i].FieldNo in FldUsed) then
            AddFieldToCondition(SB, KeyAndDataFields.DataFieldDescs[i], StatementType, ModifiedFieldsOnly, Index);
      end;
    end
    else
      inherited;
end;

function TCustomMySQLGenerator.GetParamOffset(const Index: integer): integer;
var
  ParamInfo: TMyParamInfo;
begin
  ParamInfo := TMyParamInfo(ParamsInfo.Items[Index]);
  Result := 0;
  if ParamInfo.SB = FFldSB then
    Result := FHeaderSB.Length
  else
  if ParamInfo.SB = FFldParamSB then
    Result := FHeaderSB.Length + FFldSB.Length + FMiddleSB.Length
  else
  if ParamInfo.SB = FCondSB then
    Result := FHeaderSB.Length + FFldSB.Length + FMiddleSB.Length + FFldParamSB.Length
  else
    Assert(False);
  Result := Result + ParamInfo.Offset + 1;
end;

procedure TCustomMySQLGenerator.GenerateLockSQL(
  const KeyAndDataFields: TKeyAndDataFields;
  const Index: integer = -1);
begin
  FHeaderSB.Append('SELECT * FROM ');
  FHeaderSB.Append(FTableInfo.TableName);
  FMiddleSB.Append(SLLineSeparator);
  FMiddleSB.Append('WHERE');
  FMiddleSB.Append(SLLineSeparator);
  FMiddleSB.Append('  ');
  GenerateConditions(FCondSB, stLock, False, KeyAndDataFields, Index);
  FFooterSB.Append(SLLineSeparator);
  case FDataSetService.FLockType of
    ilrImmediately:
      FFooterSB.Append('FOR UPDATE');
    ilrDelayed:
      FFooterSB.Append('LOCK IN SHARE MODE');
  end;
end;

function TCustomMySQLGenerator.GetActualFieldName(FldDesc: TCRFieldDesc; IsRefresh: boolean): string;
var
  SQLObjName: string;
  SQLObjIdx: integer;
begin
  if not IsRefresh then begin
    Result := FldDesc.Name;
    if Result = '' then
      Result := FldDesc.ActualName;
    Result := QuoteName(Result);
    Exit;
  end;

  SQLObjName := GenerateTableName(FldDesc);

  if SQLObjName <> '' then begin // All
    SQLObjIdx := TMySQLRecordset(FDataSetService.GetIRecordSet).GetSQLObjectIndex(SQLObjName);
    Assert(SQLObjIdx <> - 1);

    if TDBAccessUtils.GetTablesInfo(FDataSet)[SQLObjIdx].TableAlias <> '' then
      Result := TDBAccessUtils.GetTablesInfo(FDataSet)[SQLObjIdx].TableAlias + '.' + QuoteName(FldDesc.ActualName)
    else
      Result := TDBAccessUtils.GetTablesInfo(FDataSet)[SQLObjIdx].TableName + '.' + QuoteName(FldDesc.ActualName);
  end
  else
    Result := QuoteName(FldDesc.ActualName);
end;

function TCustomMySQLGenerator.GenerateTableSQL(const TableName, OrderFields: string): string;
var
  Limit: integer;
  BatchedHandler: boolean;
  Parser: TMyParser;
  Lexem: string;
  QTableName: string;
begin
  QTableName := QuoteName(TableName);

  if not FUseHandler then begin
    Result := 'SELECT * FROM ' + QTableName;

    if OrderFields <> '' then
      Result := Result + ' ORDER BY ' + OrderFields;

    if (FLimit <> -1) or (FOffset <> 0) then
      Result := Result + ' LIMIT ' + IntToStr(FOffset) + ', ' + IntToStr(FLimit);
  end
  else begin
    BatchedHandler := FDataSetService.GetIConnection.IsClient41 and FDataSetService.GetIConnection.IsServer41;
    Result := '';
    if BatchedHandler then
      Result := 'HANDLER ' + QTableName + ' OPEN; ';

    Result := Result + 'HANDLER ' + QTableName + ' READ';

    FHandlerIndex := Trim(FHandlerIndex);
    if FHandlerIndex <> '' then begin
      Result := Result + ' ' + FHandlerIndex;
      Parser := TMyParser.Create(FHandlerIndex);
      try
        Parser.OmitBlank := True;
        Parser.OmitComment := True;
        Parser.GetNextCode;
        Parser.GetNext(Lexem); //+++ char instead of string
        if (Lexem <> '=') and (Lexem <> '<') and (Lexem <> '>') then
          Result := Result + ' FIRST';
      finally
        Parser.Free;
      end;
    end
    else
      Result := Result + ' FIRST';

    if FDataSet.FilterSQL <> '' then
      Result := Result + ' WHERE ' + FDataSet.FilterSQL;

    if FLimit = -1 then
      Limit := MaxInt
    else