unit BDEClientDataSet;

interface

uses Windows, SysUtils, Variants, Classes, DB, DBCommon, Midas,
SqlTimSt, DBClient, DBLocal, Provider, DBTables;

type
{ TBDEQuery }

  TBDEQuery = class(TQuery)
  private
    FKeyFields: string;
  protected
    function PSGetDefaultOrder: TIndexDef; override;
  end;

{ TBDEClientDataSet }
  TBDEClientDataSet = class(TCustomCachedDataSet)
  private
    FCommandText: string;
    FCurrentCommand: string;
    FDataSet: TBDEQuery;
    FDatabase: TDataBase;
    FLocalParams: TParams;
    FStreamedActive: Boolean;
    procedure CheckMasterSourceActive(MasterSource: TDataSource);
    procedure SetDetailsActive(Value: Boolean);
    function GetConnection: TDataBase;
    function GetDataSet: TDataSet;
    function GetMasterSource: TDataSource;
    function GetMasterFields: string;
    procedure SetConnection(Value: TDataBase);
    procedure SetDataSource(Value: TDataSource);
    procedure SetLocalParams;
    procedure SetMasterFields(const Value: string);
    procedure SetParamsFromSQL(const Value: string);
    procedure SetSQL(const Value: string);
  protected
    function GetCommandText: String; override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetActive(Value: Boolean); override;
    procedure SetCommandText(Value: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CloneCursor(Source: TCustomClientDataSet; Reset: Boolean;
      KeepSettings: Boolean = False); override;
    procedure GetFieldNames(List: TStrings); override;
    function GetQuoteChar: String;
    property DataSet: TDataSet read GetDataSet;
  published
    property Active;
    property CommandText: string read GetCommandText write SetCommandText;
    property DBConnection: TDataBase read GetConnection write SetConnection;
    property MasterFields read GetMasterFields write SetMasterFields;
    property MasterSource: TDataSource read GetMasterSource write SetDataSource;
  end;
 
procedure Register;

implementation

uses BDEConst, MidConst;

type

{ TBDECDSParams }

  TBDECDSParams = class(TParams)
  private
    FFieldName: TStrings;
  protected
    procedure ParseSelect(SQL: string);
  public
    constructor Create(Owner: TPersistent);
    Destructor Destroy; override;
  end;

constructor TBDECDSParams.Create(Owner: TPersistent);
begin
  inherited;
  FFieldName := TStringList.Create;
end;

destructor TBDECDSParams.Destroy;
begin
  FreeAndNil(FFieldName);
  inherited;
end;

procedure TBDECDSParams.ParseSelect(SQL: string);
const
  SSelect = ''''select'''';
var
  FWhereFound: Boolean;
  Start: PChar;
  FName, Value: string;
  SQLToken, CurSection, LastToken: TSQLToken;
  Params: Integer;
begin
  if Pos('''' '''' + SSelect + '''' '''', LowerCase(string(PChar(SQL)+8))) > 1 then Exit;  // can''''t parse sub queries
  Start := PChar(ParseSQL(PChar(SQL), True));
  CurSection := stUnknown;
  LastToken := stUnknown;
  FWhereFound := False;
  Params := 0;
  repeat
    repeat
      SQLToken := NextSQLToken(Start, FName, CurSection);
      if SQLToken in [stWhere] then
      begin
        FWhereFound := True;
        LastToken := stWhere;
      end else if SQLToken in [stTableName] then
      begin
        { Check for owner qualified table name }
        if Start^ = ''''.'''' then
          NextSQLToken(Start, FName, CurSection);
      end else
      if (SQLToken = stValue) and (LastToken = stWhere) then
        SQLToken := stFieldName;
      if SQLToken in SQLSections then CurSection := SQLToken;
    until SQLToken in [stFieldName, stEnd];
    if FWhereFound and (SQLToken in [stFieldName]) then
      repeat
        SQLToken := NextSQLToken(Start, Value, CurSection);
          if SQLToken in SQLSections then CurSection := SQLToken;
      until SQLToken in [stEnd,stValue,stIsNull,stIsNotNull,stFieldName];
    if Value=''''?'''' then
    begin
      FFieldName.Add(FName);
      Inc(Params);
    end;
  until (Params = Count) or (SQLToken in [stEnd]);
end;

{ TBDEQuery }

  function TBDEQuery.PSGetDefaultOrder: TIndexDef;
  begin
    if FKeyFields = '''''''' then
      Result := inherited PSGetDefaultOrder
    else
    begin  // detail table default order
      Result := TIndexDef.Create(nil);
      Result.Options := [ixUnique];      // keyfield is unique
      Result.Name := StringReplace(FKeyFields, '''';'''', ''''_'''', [rfReplaceAll]);
      Result.Fields := FKeyFields;
    end;
  end;

{ TBDEClientDataSet }

constructor TBDEClientDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataSet := TBDEQuery.Create(nil);
  FDataSet.Name := Self.Name + ''''DataSet1'''';
  Provider.DataSet := FDataSet;
  SqlDBType := typeBDE;
  FLocalParams := TParams.Create;
end;

destructor TBDEClientDataSet.Destroy;
begin
  FreeAndNil(FLocalParams);
  FDataSet.Close;
  FreeAndNil(FDataSet);
  inherited Destroy;
end;

procedure TBDEClientDataSet.GetFieldNames(List: TStrings);
var
  Opened: Boolean;
begin
  Opened := (Active = False);
  try
    if Opened then
      Open;
    inherited GetFieldNames(List);
  finally
    if Opened then Close;
  end;
end;

function TBDEClientDataSet.GetCommandText: string;
begin
  Result := FCommandText;
end;

function TBDEClientDataSet.GetDataSet: TDataSet;
begin
  Result := FDataSet as TDataSet;
end;

procedure TBDEClientDataSet.CheckMasterSourceActive(MasterSource: TDataSource);
begin
  if Assigned(MasterSource) and Assigned(MasterSource.DataSet) then
    if not MasterSource.DataSet.Active then
      DatabaseError(SMasterNotOpen);
end;

procedure TBDEClientDataSet.SetParamsFromSQL(const Value: string);
var
  DataSet: TQuery;
  TableName, TempQuery, Q: string;
  List: TBDECDSParams;
  I: Integer;
  Field: TField;
begin
  TableName := GetTableNameFromSQL(Value);
  if TableName <> '''''''' then
  begin
    TempQuery := Value;
    List := TBDECDSParams.Create(Self);
    try
      List.ParseSelect(TempQuery);
        List.AssignValues(Params);
      for I := 0 to List.Count - 1 do
        List[I].ParamType := ptInput;
      DataSet := TQuery.Create(nil);
      try
        DataSet.DatabaseName := FDataSet.DatabaseName;
        Q := GetQuoteChar;
        DataSet.SQL.Add(''''select * from '''' + Q + TableName + Q + '''' where 0 = 1''''); { do not localize }
        try
          DataSet.Open;
          for I := 0 to List.Count - 1 do
          begin
            if List.FFieldName.Count > I then
            begin
              try
                Field := DataSet

[1] [2]  下一页