Delphi7 can't find a solution for TBDeclientDataSet controls

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) oorride; proced ure 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 ReadDataSource Write setDataSource; END;

Procedure register; importation

Uses bdeconst, midconst;

Type

{Tbdecdsparams}

TBDecdsparams = Class (TPARAMS) Private FfieldName: TStrings; Protected Procedure Parseselect (SQL: String); Public Constructor Create (Owner: TPERSIStent); Destructor Destroy; Override;

Constructor TBDecdsparams.create (Owner: TPERSIStent); Begin inherited; ffieldname: = tstringlist.create;

DESTRUCTOR TBDECDSPARAMS.DESTROY; Begin FreeAndnil (FfieldName); inherited;

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 the cursection: = SQLTOKEN; Until Sqltoken In [STF ieldName, 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 [Sten); 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 results: = 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;

Destructor TBDeclientDataSet.Destroy; Begin FreeAndnil (FLOCALPARAMS); FDATASET.CLOSE; FreeAndnil (FDataSet); inherited Destroy;

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: = fdataaset as tdatanet;

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 <> ' 'Ten Begin Tempquery: = value; list: = tbdecdsparams.create (Self); Try list.parselection; 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: = getquotecha; 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.fieldbyname (list.ffieldname [I]); Except Field: = NIL; END; END ELSE FIELD: = NIL; if Assigned (Field) Then Begin if Field.DataType <> ftstring the list [i] .datatype: = FIELD.DATATYPE ELSE IF TSTRINGFIELD (FIELD) .FIXEDCHAR THEN LIST [i] .DataType: = FTFixedChar else: = ftstring; end; end; eXcept // ignore all exceptions end; finally dataset.free; end; finally if list.count> 0 Then params.assign (list); list.free; End; end;

procedure TBDEClientDataSet.SetSQL (const Value: string); begin if Assigned (Provider.DataSet) then begin TQuery (Provider.DataSet) .SQL.Clear; if Value <> '' then TQuery (Provider.DataSet) .SQL.Add ( Value); inherited SetCommandText (Value); end else DataBaseError (SNoDataProvider); end; procedure TBDEClientDataSet.Loaded; begin inherited Loaded; if FStreamedActive then begin SetActive (True); FStreamedActive: = False; end; end;

Function TBDeclientDataSet.getMasterfields: String; Begin Result: = inherited Masterfields; End;

Procedure tbdeclientDataSet.SetMasterfield (const value: string); begin inherited masterfields: = value; if value <> '' Then indexfieldnames: = value; fdataset.fKeyfields: = '; END;

procedure TBDEClientDataSet.SetCommandText (Value: String); begin inherited SetCommandText (Value); FCommandText: = Value; if not (csLoading in ComponentState) then begin FDataSet.FKeyFields: = ''; IndexFieldNames: = ''; MasterFields: = '' INDEXNAME: = '; indexdefs.clear; params.clear; if (csdesigning in componentstate) and (value <>' ') THEN setParamsfromsql (Value); end;

Function TBDeclientDataSet.getConnection: TDATABASE; Begin Result: = fdatabase;

procedure TBDEClientDataSet.SetConnection (Value: TDataBase); begin if Value = FDatabase then exit; CheckInactive; if Assigned (Value) then begin if not (csLoading in ComponentState) and (Value.DatabaseName = '') then DatabaseError (SDatabaseNameMissing); FDataSet .DatabaseName: = Value.DatabaseName; end else FDataSet.DataBaseName: = ''; FDataBase: = Value; end; function TBDEClientDataSet.GetQuoteChar: String; begin Result: = ''; if Assigned (FDataSet) then Result: = FDataSet. Psgetquotechar;

procedure TBDEClientDataSet.CloneCursor (Source: TCustomClientDataSet; Reset: Boolean; KeepSettings: Boolean = False); begin if not (Source is TBDEClientDataSet) then DatabaseError (SInvalidClone); Provider.DataSet: = TBDEClientDataSet (Source) .Provider.DataSet; DBConnection: = TBDECLIENTDATASET (SOURCE) .dbconnection; CommandText: = tbdeclientDataSet; inherited Clonecursor (Source, Reset, KeepSettings);

procedure TBDEClientDataSet.Notification (AComponent: TComponent; Operation: TOperation); begin inherited Notification (AComponent, Operation); if Operation = opRemove then if AComponent = FDatabase then begin FDataBase: = nil; SetActive (False); end; end;

Procedure TBDeclientDataSet.SetLocalParams;

procedure CreateParamsFromMasterFields (Create: Boolean); var I: Integer; List: TStrings; begin List: = TStringList.Create; try if Create then FLocalParams.Clear; FDataSet.FKeyFields: = MasterFields; List.CommaText: = MasterFields; for I: = 0 to List.Count -1 do begin if Create then FLocalParams.CreateParam (ftUnknown, MasterSource.DataSet.FieldByName (List [I]) FieldName, ptInput.); FLocalParams [I] .AssignField (MasterSource.DataSet.FieldByName (List [I])); end; finally List.Free; end; end; begin if (MasterFields <> '') and Assigned (MasterSource) and Assigned (MasterSource.DataSet) then begin CreateParamsFromMasterFields (True); FCurrentCommand: = AddParamSQLForDetail ( FLOCALPARAMS, CommandText, True, getquotechar; end;

procedure TBDEClientDataSet.SetDataSource (Value: TDataSource); begin inherited MasterSource: = Value; if Assigned (Value) then begin if PacketRecords = -1 then PacketRecords: = 0; end else begin if PacketRecords = 0 then PacketRecords: = -1; end ;

Function TBDeclientDataSet.getmastersource: TDataSource; Begin Result: = inherited Mastersource;

procedure TBDEClientDataSet.SetDetailsActive (Value: Boolean); var DetailList: TList; I: Integer; begin DetailList: = TList.Create; try GetDetailDataSets (DetailList); for I: = 0 to DetailList.Count -1 do if TDataSet (DetailList [ I]) IS TBDECLIENTDATASET (TDataSt (Detaillist [i])). Active: = value; finally Detaillist.Free; end; end;

procedure TBDEClientDataSet.SetActive (Value: Boolean); begin if Value then begin if csLoading in ComponentState then begin FStreamedActive: = True; exit; end; if MasterFields <> '' then begin if not (csLoading in ComponentState) then CheckMasterSourceActive (MasterSource) ; SetLocalParams; SetSQL (FCurrentCommand); Params: = FLocalParams; FetchParams; end else begin SetSQL (FCommandText); if Params.Count> 0 then begin FDataSet.Params: = Params; FetchParams; end; end; end; if Value and ( FDataSet.ObjectView <> ObjectView) then FDataSet.ObjectView: = ObjectView; inherited SetActive (Value); SetDetailsActive (Value); end; procedure Register; begin RegisterComponents ( 'BDE', [TBDEClientDataSet]); end;

End.// More than DBLocalb.Pas is modified, can be stored as any file name, of course, the extension is PAS / / and then install this control