myservicesuni.pas

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

        if Byte(Def[1]) = Byte('-') then
          Res := - IntAt(1, i - 1) / HoursPerDay - Res
        else
          Res :=   IntAt(0, i)     / HoursPerDay + Res;
      end;
      FIELD_TYPE_DATETIME: // YYYY-MM-DD HH:MM:SS
      begin
        Result := TryEncodeDate(IntAt(0, 4), IntAt(5, 2), IntAt(8, 2), Res);
        if Result then begin
          Result := TryEncodeTime(IntAt(11, 2), IntAt(14, 2), IntAt(17, 2), 0, t);
          if Res > 0 then
            Res := Res + t
          else
            Res := Res - t;
        end;
      end;
    end;
  end;

var
  MetaData: TDAMetaData;
  TableName, Schema: string;
  p: integer;
  NameField, DefField: TField;
  Field: TField;
  FieldDesc: TMySQLFieldDesc;
  Def: string;
  dt: TDateTime;
begin
  if not FDataSet.Options.DefaultValues or (FDataSet.Fields.Count = 0) or (FUpdatingTableInfoIdx = - 1) then
    Exit;

  TableName := GetTablesInfo[FUpdatingTableInfoIdx].TableNameFull;
  p := Pos('.', TableName);
  if p > 0 then begin
    Schema := Copy(TableName, 1, p - 1);
    TableName := Copy(TableName, p + 1, Length(TableName));
  end
  else
    Schema := '';

  MetaData := UsedConnection.CreateMetaData;
  try
    MetaData.MetaDataKind := 'Columns';
    MetaData.Restrictions.Text := 'table_schema=' + Schema +
      #13#10'table_name=' + TableName;

    MetaData.Open;
    NameField := MetaData.FieldByName('COLUMN_NAME');
    DefField := MetaData.FieldByName('DEFAULT_VALUE');
    while not MetaData.Eof do begin
      Field := FDataSet.FindField(NameField.AsString);
      if (Field <> nil) and not DefField.IsNull then begin
        Def := DefField.AsString;
        if DefaultExpressionOldBehavior then begin
          FieldDesc := FDataSet.GetFieldDesc(Field) as TMySQLFieldDesc;
          case Field.DataType of
            ftBoolean:
              Field.DefaultExpression := BoolToStr(Def <> '0', True);
            ftFloat, ftBCD{$IFDEF VER6P}, ftFMTBCD{$ENDIF}:
              Field.DefaultExpression := StringReplace(Def, '.', DecimalSeparator, [rfReplaceAll]);
            ftDateTime:
              if (Def <> '') and DateTimeFromStr(Def, FieldDesc, dt) then
                Field.DefaultExpression := DateTimeToStr(dt);
            ftDate:
              if (Def <> '') and DateTimeFromStr(Def, FieldDesc, dt) then
                Field.DefaultExpression := DateToStr(dt);
            ftTime:
              if (Def <> '') and DateTimeFromStr(Def, FieldDesc, dt) then
                Field.DefaultExpression := TimeToStr(dt);
            else
              Field.DefaultExpression := Def;
          end;
        end
        else begin
          if Def <> 'CURRENT_TIMESTAMP' then
            Def := AnsiQuotedStr(Def, '''');
          Field.DefaultExpression := Def;
        end;
      end;
      MetaData.Next;
    end;
  finally
    MetaData.Free;
  end;
end;

function TCustomMyDataSetService.GetRecCount: integer;
  function GetCount(const s: string): longint;
  var
    UQ: TCustomDADataSet;
    i: integer;
    MonitorClass: TDASQLMonitorClass;
    MessageID: cardinal;
  begin
    FUpdater.CheckUpdateQuery(stCustom);
    UQ := FUpdater.UpdateQuery as TCustomDADataSet;
    UQ.SQL.Text := s;

    UQ.Macros.Assign(FDataSet.Macros);
    for i := 0 to FDataSet.Params.Count - 1 do
      UQ.Params[i].Assign(FDataSet.Params[i]);

    MonitorClass := TDASQLMonitorClass(TDBAccessUtils.SQLMonitorClass(UsedConnection));
    if not TDBAccessUtils.GetLockDebug(FDataSet) and (MonitorClass.HasMonitor or FDataSet.Debug) then
      MonitorClass.SQLExecute(FDataSet, s, UQ.Params, 'Get RecCount', MessageID, True);

    UQ.Execute;
    Result := UQ.Fields[0].AsInteger;

    if not TDBAccessUtils.GetLockDebug(FDataSet) and (MonitorClass.HasMonitor or FDataSet.Debug) then
      MonitorClass.SQLExecute(FDataSet, s, UQ.Params, 'Get RecCount', MessageID, False);
  end;

var
  Parser: TMyParser;
  SelectPos: integer;
  FromPos: integer;
  s: string;
  Lexem: integer;
  DelimiterPos: integer;
  HaveDistinct: boolean;

begin
  Result := 0;
  if (not IsFetchAll and FDataSet.Options.QueryRecCount) // 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
    s := FDataSet.FinalSQL;
    s := {$IFDEF CLR}CoreLab.Dac.{$ENDIF}DBAccess._SetOrderBy(s, '', TMyParser);
    Parser := TMyParser.Create(s);
    Parser.OmitBlank := True;
    Parser.OmitComment := True;
    try
      if Parser.ToLexem(lxSELECT) <> lcEnd then begin
        SelectPos := Parser.CurrPos;
        Lexem := Parser.GetNextCode;
        HaveDistinct := (Lexem = lxDISTINCT) or (Lexem = lxDISTINCTROW);

        if Parser.ToLexem(lxFROM) <> lcEnd then begin
          FromPos := Parser.CurrPos;

          if Parser.ToLexem(lxLIMIT) <> lcEnd then begin
            if Parser.ToLexem(7) <> lcEnd then // ';'
              DelimiterPos := Parser.CurrPos
            else
              DelimiterPos := MaxInt;
            s := Copy(s, 1, SelectPos) + ' COUNT(*) FROM (SELECT ' + Copy(s, SelectPos + 1, DelimiterPos - 1 - SelectPos) + ') q' + Copy(s, DelimiterPos, MaxInt);
          end
          else
          if HaveDistinct then
            s := Copy(s, 1, SelectPos) + ' COUNT(' + Copy(s, SelectPos + 1, FromPos - 4 - SelectPos) + ')' + Copy(s, FromPos - 4 {length('FROM')}, MaxInt)
          else
            s := Copy(s, 1, SelectPos) + ' COUNT(*)' + Copy(s, FromPos - 4 {length('FROM')}, MaxInt);

          Result := GetCount(s);
        end;
      end;
    finally
      Parser.Free;
    end;
  end
  else
    Result := inherited GetRecCount;
end;

procedure TCustomMyDataSetService.SetNumberRange(FieldDef: TFieldDef);
var
  Field: TField;
  FieldDesc: TMySQLFieldDesc;
{$IFDEF VER6P}
  e: Extended;
{$ENDIF}

begin
  Field := FDataSet.FindField(FieldDef.Name);
  if (Field <> nil)
    and (Field is TNumericField) then begin
    FieldDesc := TMySQLFieldDesc(FDataSet.GetFieldDesc(Field));
    case FieldDesc.MySQLType of // Must be sync with ConvertMySQLTypeToInternalFormat
      // Integer fields
      FIELD_TYPE_DECIMAL, FIELD_TYPE_NEWDECIMAL: begin // DECIMAL
        if Field is TFloatField then begin
          TFloatField(Field).MaxValue :=
            IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
            IntPower(10, - Integer(FieldDesc.Scale));
          TFloatField(Field).MinValue := - TFloatField(Field).MaxValue;
        end
        else
        if Field is TBCDField then begin
          TBCDField(Field).MaxValue :=
            IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
            IntPower(10, - Integer(FieldDesc.Scale));
          TBCDField(Field).MinValue := - TBCDField(Field).MaxValue;
        end
        else
      {$IFDEF VER6P}
        if Field is TFMTBCDField then begin
          e :=
            IntPower(10, FieldDesc.Length - FieldDesc.Scale) -
            IntPower(10, - Integer(FieldDesc.Scale));
          TFMTBCDField(Field).MaxValue := FloatToStr(e);
          TFMTBCDField(Field).MinValue := FloatToStr(- e);
        end
        else
      {$ENDIF}
          Assert(False, Field.ClassName);
      end;
      FIELD_TYPE_TINY: // TINYINT
        if FieldDesc.IsUnsigned then
        begin
          TIntegerField(Field).MinValue := 0;
          TIntegerField(Field).MaxValue := 255;
        end
        else
        begin
          TIntegerField(Field).MinValue := -128;
          TIntegerField(Field).MaxValue := 127;
        end;

      FIELD_TYPE_SHORT: // SMALLINT
        if FieldDesc.IsUnsigned then
        begin
          TIntegerField(Field).MinValue := 0;
          TIntegerField(Field).MaxValue := 65535;
        end
        else
        begin
          TIntegerField(Field).MinValue := -32768;
          TIntegerField(Field).MaxValue := 32767;
        end;

      FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG: // INT
        if Field is TIntegerField then
          if FieldDesc.IsUnsigned then
          begin
            TIntegerField(Field).MinValue := 0;
            TIntegerField(Field).MaxValue := 0; // 4294967295; - not supported by Delphi
          end
          else
          begin
            TIntegerField(Field).MinValue := -2147483647;
            TIntegerField(Field).MaxValue := 2147483647;
          end;

      // FIELD_TYPE_LONGLONG:; // BIGINT - does not need to set bounds

      FIELD_TYPE_INT24: begin// MEDIUMINT
        // ??? Error in Delphi? Does not set range value
        // May be d5/d6?

        Assert(Field is TIntegerField);
        if FieldDesc.IsUnsigned then
        begin
          TIntegerField(Field).MinValue := 0;
          TIntegerField(Field).MaxValue := 16777215;
        end
        else
        begin
          TIntegerField(Field).MinValue := -8388608;
          TIntegerField(Field).MaxValue := 8388607;
        end;
      end;

      // Float fields
      FIELD_TYPE_FLOAT: // FLOAT
      begin
        TFloatField(Field).Precision := FieldDesc.Length;
        TFloatField(Field).MinValue := -3.402823466E+38;
        TFloatField(Field).MaxValue :=  3.402823466E+38;
      end;
      FIELD_TYPE_DOUBLE: // DOUBLE
      begin
        TFloatField(Field).Precision := FieldDesc.Length;
        TFloatField(Field).MinValue := -1.7976931348623157E+308;
        TFloatField(Field).MaxValue :=  1.7976931348623157E+308;
      end;

      FIELD_TYPE_YEAR:
      begin
        Assert(Field is TIntegerField);
        case FieldDesc.Length of
          2: begin
            TIntegerField(Field).MinValue := 0;
            TIntegerField(Field).MaxValue := 99;
          end;
          4: begin
            TIntegerField(Field).MinValue := 0;
            TIntegerField(Field).MaxValue := 255;
          end;
          else
            Assert(False);
        end;
      end;
    end;
  end;
end;

function TCustomMyDataSetService.QuoteName(const AName: string): string;
begin
  Result := QuoteName(AName, FLeftQuote, FRightQuote);
end;

function TCustomMyDataSetService.QuoteName(const AName: string; const LeftQuote, RightQuote: string): string;
begin
  Result := TMyTableInfo.NormalizeName(AName, LeftQuote[1], RightQuote[1], FDataSet.Options.QuoteNames);
end;

function TCustomMyDataSetService.UnQuoteName(const AName: string): string;
begin
  Result := UnbracketIfPossible(AName);
end;

function TCustomMyDataSetService.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prCheckRowVersion:
      FCheckRowVersion := Value;
    prLockType:
      FLockType := TLockRecordTypeI(Value);
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

// Open next rowset in statement. if rowset not returne theh OpenNext return False. If statement has error, then raised exception
function TCustomMyDataSetService.OpenNext: boolean;
var
  v: variant;
begin
  if not FDataSet.Active then begin
    FDataSet.Open;
    Result := True;
  end
  else begin
    BeginConnection;
    try
      if FDataSet.Prepared then
        DatabaseError(SOpenNextPreparedSQL);
      if IsFetchAll then
        DatabaseError(SOpenNextVsFetchAll);

      FDataSet.Close;
      FDataSet.Unprepare;

      GetIRecordSet.GetProp(prIsCanOpenNext, v);
      Result := v;

      if Result then
        try
          GetIRecordSet.SetProp(prOpenNext, True);
          FDataSet.FieldDefs.Updated := False;
          FDataSet.Open;
        finally
          GetIRecordSet.SetProp(prOpenNext, False);
        end;
    finally
      EndConnection;
    end;
  end;
end;

function TCustomMyDataSetService.GetIConnection: TMySQLConnection;
begin
  Result := TMySQLConnection(TDBAccessUtils.GetIConnection(UsedConnection));
  Assert(Result <> nil); //upd should be error
end;

function TCustomMyDataSetService.GetIRecordSet: TMySQLRecordSet;
begin
  Result := TMySQLRecordSet(inherited GetIRecordSet);
end;

function TCustomMyDataSetService.IsFullRefresh: boolean;
begin
  Result := inherited IsFullRefresh;
end;

{ TCustomMyDataTypesMap }

class function TCustomMyDataTypesMap.GetDataType(FieldType: TFieldType): integer;
begin
{$IFNDEF VER10P}
  if Integer(FieldType) = Integer(ftFixedWideChar) then
    FieldType := ftWideString;
{$ENDIF}

  Result := inherited GetDataType(FieldType);
end;

class function TCustomMyDataTypesMap.GetFieldType(DataType: Word): TFieldType;
begin
  case DataType of
    dtInt8:
      Result := ftSmallint;
    dtInt16:
      Result := ftSmallint;
    dtInt64:
      Result := ftLargeInt;
    dtWord:
      Result := ftWord;
    dtBoolean:
      Result := ftBoolean;
    dtCurrency:
      Result := ftCurrency;
  else
    Result := inherited GetFieldType(DataType);
  end;
end;

{ TMyServerEnumerator }

function TMyServerEnumerator.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := inherited SetProp(Prop, Value);
end;

function TMyServerEnumerator.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := inherited GetProp(Prop, Value);
end;

procedure TMyServerEnumerator.GetServerList(List: TStrings);
begin
{$IFDEF MSWINDOWS}
  CRNetManager.GetServerList(List, 'mysql');
{$ENDIF}
end;

end.