dbutilseh.pas

最新的 DBGRIDEH4.0

      if VarIsArray(v) then
        FExpression.Operator2 := foIn
      else if FExpression.ExpressionType = botString then
        FExpression.Operator2 := foLike
      else
        FExpression.Operator2 := foEqual;
      FExpression.Operand2 := v;
    end
    else if (op = foNon) and (Length(Exp) <> 0) then
      raise Exception.Create(SErrorInExpressionEh + Exp)
    else
    begin
      if op in [foIn, foNotIn] then
        PreferCommaForList := True;
      p := SkipBlanks(Exp, p);
      v := GetLexeme(Exp, p, op1, PreferCommaForList);
      FExpression.Operator2 := op;
      if op1 = foNull then
        if op = foEqual then
          FExpression.Operator2 := foNull
        else if op = foNotEqual then
          FExpression.Operator2 := foNotNull
        else
          raise Exception.Create(SUnexpectedExpressionBeforeNullEh + Exp)
      else if op1 <> foValue then
        raise Exception.Create(SUnexpectedExpressionAfterOperatorEh + Exp);
      FExpression.Operand2 := v;
      ResetPreferCommaForList;
    end;
    Result := True;
    Break;
  end;

  if FExpression.Operator1 in [foEqual..foNotIn] then
    ConvertVarStrValues(FExpression.Operand1, FExpression.ExpressionType)
  else
    FExpression.Operand1 := Null;

  if FExpression.Operator2 in [foEqual..foNotIn] then
    ConvertVarStrValues(FExpression.Operand2, FExpression.ExpressionType)
  else
    FExpression.Operand2 := Null;
end;

function GetExpressionAsFilterString(AGrid: TCustomDBGridEh;
  OneExpressionProc: TOneExpressionFilterStringProcEh;
  DateValueToSQLStringProc: TDateValueToSQLStringProcEh;
  UseFieldOrigin: Boolean = False;
  SupportsLocalLike: Boolean = False): String;

  function GetExpressionAsString(Column: TColumnEh): String;
  var
    FieldName: String;
  begin
    if Column.Field = nil then
      FieldName := ''
    else if UseFieldOrigin and (Column.Field.Origin <> '') and (Column.STFilter.DataField = '') then
      FieldName := Column.Field.Origin
//    else if (Column.STFilter.ListSource <> nil) or (Column.Filter.DataField <> '') then
//      FieldName := Column.Filter.DataField
    else
//      FieldName := Column. Field.FieldName;
      FieldName := Column.STFilter.GetFilterFieldName;
    Result := '';
    with Column.STFilter do
    begin
      if (Expression.ExpressionType = botNon) or (Column.Field = nil) or (Expression.Operator1 = foNon) then
        Exit;
//      if KeyField <> '' then
//        Result := OneExpressionProc(Expression.Operator1, FKeyValues, FieldName, AGrid.DataSource.DataSet, DateValueToSQLStringProc)
//      else
      begin
        Result := OneExpressionProc(Expression.Operator1, GetOperand1, FieldName,
          AGrid.DataSource.DataSet, DateValueToSQLStringProc, SupportsLocalLike);
        if Expression.Relation <> foNon then
        begin
          Result := Result + ' ' + STFilterOperatorsSQLStrMapEh[Expression.Relation];
          Result := Result + OneExpressionProc(Expression.Operator2, GetOperand2,
            FieldName, AGrid.DataSource.DataSet, DateValueToSQLStringProc, SupportsLocalLike);
        end
      end;
      if Expression.Relation = foOR then
        Result := '(' + Result + ')';
    end;
  end;
var
  i: Integer;
  s: String;
begin
  Result := '';
  if (AGrid.DataSource <> nil) and (AGrid.DataSource.DataSet <> nil) and
    AGrid.DataSource.DataSet.Active then
  begin
    for i := 0 to AGrid.Columns.Count - 1 do
    begin
      s := GetExpressionAsString(TColumnEh(AGrid.Columns[i]));
      if s <> '' then
        Result := Result + s + ' AND ';
    end;
    Delete(Result, Length(Result) - 3, 4);
  end;
end;

function GetOneExpressionAsLocalFilterString(O: TSTFilterOperatorEh; v: Variant;
  FieldName: String; DataSet: TDataSet;
  DateValueToSQLStringProc: TDateValueToSQLStringProcEh; SupportsLike: Boolean): String;

  function VarValueAsFilterStr(v: Variant): String;
  begin
    if VarType(v) = varDouble then
      Result := FloatToStr(v)
    else if VarType(v) = varDate then
      if @DateValueToSQLStringProc <> nil then
        Result := DateValueToSQLStringProc(Dataset, v)
      else
        Result := '''' + DateTimeToStr(v) + ''''
    else
      Result := '''' + VarToStr(v) + '''';
  end;

var
  i: Integer;
begin
  if O in [foIn, foNotIn] then
  begin
    Result := Result + ' (';
    if VarIsArray(v) then
      for i := VarArrayLowBound(v, 1) to VarArrayHighBound(v, 1) do
        Result := Result + '[' + FieldName + '] = ' + VarValueAsFilterStr(v[i]) + ' OR '
    else
      Result := Result + '[' +FieldName + '] = ' + VarValueAsFilterStr(v) + ' OR ';
    Delete(Result, Length(Result) - 3, 4);
    Result := Result + ')';
  end
  else if O in [foLike, foNotLike] then
  begin
    Result := Result +  ' [' + FieldName;
    if SupportsLike then
      if O = foLike
        then Result := Result + '] Like '
        else Result := Result + '] Not Like '
    else
      if O = foLike
        then Result := Result + '] = '
        else Result := Result + '] <> ';
    Result := Result + VarValueAsFilterStr(v);
  end else
  begin
    Result := Result +  ' [' + FieldName +  '] ' + STFilterOperatorsSQLStrMapEh[O];
    if not (O in [foNull, foNotNull]) then
      Result := Result + ' ' + VarValueAsFilterStr(v);
  end;
end;

function GetOneExpressionAsSQLWhereString(O: TSTFilterOperatorEh; v: Variant;
  FieldName: String; DataSet: TDataSet;
  DateValueToSQLStringProc: TDateValueToSQLStringProcEh; SupportsLike: Boolean): String;

  function VarValueAsFilterStr(v: Variant): String;
  var
{$IFDEF CIL}
    OldDecimalSeparator: String;
{$ELSE}
    OldDecimalSeparator: Char;
{$ENDIF}
  begin
    if VarType(v) = varDouble then
    begin
      OldDecimalSeparator := DecimalSeparator;
      DecimalSeparator := '.';
      try
        Result := FloatToStr(v);
      finally
        DecimalSeparator := OldDecimalSeparator;
      end;
    end
    else if VarType(v) = varDate then
      if @DateValueToSQLStringProc <> nil then
        Result := DateValueToSQLStringProc(DataSet, v)
      else
        Result := '''' + VarToStr(v) + ''''
    else
      Result := '''' + VarToStr(v) + '''';
  end;

var
  i: Integer;
  theNOT: String;
begin
  if O in [foIn, foNotIn] then
  begin
    if O = foNotIn then
      theNOT := ' NOT'
    else
      theNOT := '';
    Result := Result + FieldName + theNOT + ' IN (';
    if VarIsArray(v) then
      for i := VarArrayLowBound(v, 1) to VarArrayHighBound(v, 1) do
        Result := Result + VarValueAsFilterStr(v[i]) + ','
    else
      Result := Result + VarValueAsFilterStr(v) + ',';
    Delete(Result, Length(Result), 1);
    Result := Result + ')';
  end else
  begin
    Result := Result + ' ' + FieldName + ' ' + STFilterOperatorsSQLStrMapEh[O];
    if not (O in [foNull, foNotNull]) then
      Result := Result + ' ' + VarValueAsFilterStr(v);
  end;
end;

function DateValueToDataBaseSQLString(DataBaseName: String; v: Variant): String;
var
{$IFDEF CIL}
  OldDateSeparator: String;
{$ELSE}
  OldDateSeparator: Char;
{$ENDIF}
begin
  DataBaseName := UpperCase(DataBaseName);
  if DataBaseName = 'STANDARD' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'ORACLE' then
    Result := 'TO_DATE(''' + FormatDateTime(ShortDateFormat, v) + ''',''' + ShortDateFormat + ''')'
  else if DataBaseName = 'INTRBASE' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'INFORMIX' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'MSACCESS' then
  begin
    OldDateSeparator := DateSeparator;
    try
      DateSeparator := '/';
      Result := '#' + FormatDateTime('MM/DD/YYYY', v) + '#';
    finally
      DateSeparator := OldDateSeparator;
    end;
  end
  else if DataBaseName = 'MSSQL' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'SYBASE' then
    Result := '''' + VarToStr(v) + ''''
  else if DataBaseName = 'DB2' then
    Result := '''' + VarToStr(v) + ''''
  else
    Result := '''' + VarToStr(v) + '''';
end;

procedure ApplyFilterSQLBasedDataSet(Grid: TCustomDBGridEh;
  DateValueToSQLString: TDateValueToSQLStringProcEh; IsReopen: Boolean;
  SQLPropName: String);
var
  i, OrderLine: Integer;
  s: String;
  SQL: TStrings;
  SQLPropValue: WideString;
begin
  if not IsDataSetHaveSQLLikeProp(Grid.DataSource.DataSet, SQLPropName, SQLPropValue) then
    raise Exception.Create(Grid.DataSource.DataSet.ClassName + ' is not SQL based dataset');

  SQL := TStringList.Create;
  try
    SQL.Text := SQLPropValue;

    OrderLine := -1;
    for i := 0 to SQL.Count - 1 do
      if UpperCase(Copy(SQL[i], 1, Length(SQLFilterMarker))) = UpperCase(SQLFilterMarker) then
      begin
        OrderLine := i;
        Break;
      end;
    s := GetExpressionAsFilterString(Grid, GetOneExpressionAsSQLWhereString, DateValueToSQLString, True);
    if s = '' then
      s := '1=1';
    if OrderLine = -1 then
      Exit;
    Grid.DataSource.DataSet.DisableControls;
    try
      if Grid.DataSource.DataSet.Active then
        Grid.DataSource.DataSet.Close;
      SQL.Strings[OrderLine] := SQLFilterMarker + ' (' + s + ')';
      SetDataSetSQLLikeProp(Grid.DataSource.DataSet, SQLPropName, SQL.Text);
      if IsReopen then
        Grid.DataSource.DataSet.Open;
    finally
      Grid.DataSource.DataSet.EnableControls;
    end;

  finally
    SQL.Free;
  end;
end;

{ Sorting }

function IsSQLBasedDataSet(DataSet: TDataSet; var SQL: TStrings): Boolean;
var
  FPropInfo: PPropInfo;
begin
  Result := False;
  SQL := nil;
  FPropInfo := GetPropInfo(DataSet.ClassInfo, 'SQL');
  if FPropInfo = nil then Exit;
  if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkClass then
  try
    SQL := (TObject(GetOrdProp(DataSet, FPropInfo)) as TStrings);
  except // if PropInfo is not TStrings or not inherited of
  end;

  if SQL <> nil then
    Result := True;
end;

function IsDataSetHaveSQLLikeProp(DataSet: TDataSet; SQLPropName: String; var SQLPropValue: WideString): Boolean;
var
  FPropInfo: PPropInfo;
begin
  Result := False;
  SQLPropValue := '';
  FPropInfo := GetPropInfo(DataSet.ClassInfo, SQLPropName);
  if FPropInfo = nil then Exit;
  if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkString then
    SQLPropValue := GetStrProp(DataSet, FPropInfo)
{$IFDEF EH_LIB_6}
  else if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkWString then
    SQLPropValue := GetWideStrProp(DataSet, FPropInfo)
{$ELSE}
  else if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkWString then
    SQLPropValue := GetStrProp(DataSet, FPropInfo)
{$ENDIF}
  else if PropType_getKind(PropInfo_getPropType(FPropInfo)) = tkClass then
    try
      if (TObject(GetOrdProp(DataSet, FPropInfo)) as TStrings) <> nil then
        SQLPropValue := (TObject(GetOrdProp(DataSet, FPropInfo)) as TStrings).Text
      else
        Exit;
    except // if PropInfo is not TStrings or not inherited of
    end
  else Exit;
  Result := True;
end;

procedure ApplySortingForSQLBasedDataSet(Grid: TCustomDBGridEh; DataSet: TDataSet;
   UseFieldName: Boolean; IsReopen: Boolean; SQLPropName: String);

  function DeleteStr(str: String; sunstr: String): String;
  var
    i: Integer;
  begin
    i := Pos(sunstr, str);
    if i <> 0 then
      Delete(str, i, Length(sunstr));
    Result := str;
  end;

var
  i, OrderLine: Integer;
  s: String;
  SQL: TStrings;
  SQLPropValue: WideString;
begin
  if not IsDataSetHaveSQLLikeProp(DataSet, SQLPropName, SQLPropValue) then
    raise Exception.Create(DataSet.ClassName + ' is not SQL based dataset');

  SQL := TStringList.Create;
  try
    SQL.Text := SQLPropValue;

    s := '';
    for i := 0 to Grid.SortMarkedColumns.Count - 1 do
    begin
      if UseFieldName
        then s := s + Grid.SortMarkedColumns[i].FieldName
        else s := s + IntToStr(Grid.SortMarkedColumns[i].Field.FieldNo);
      if Grid.SortMarkedColumns[i].Title.SortMarker = smUpEh
        then s := s + ' DESC, '
        else s := s + ', ';
    end;

    if s <> '' then
      s := 'ORDER BY ' + Copy(s, 1, Length(s) - 2);

    OrderLine := -1;
    for i := 0 to SQL.Count - 1 do
      if UpperCase(Copy(SQL[i], 1, Length('ORDER BY'))) = 'ORDER BY' then
      begin
        OrderLine := i;
        Break;
      end;
    if OrderLine = -1 then
    begin
      SQL.Add('');
      OrderLine := SQL.Count-1;
    end;

    SQL.Strings[OrderLine] := s;

    DataSet.DisableControls;
    try
      if DataSet.Active then
        DataSet.Close;
      SetDataSetSQLLikeProp(DataSet, SQLPropName, SQL.Text);