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] 下一页 没有相关教程
|