程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> delphi7找不到TBDEClientDataSet控件的解決方案

delphi7找不到TBDEClientDataSet控件的解決方案

編輯：Delphi

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.FieldByName(List.FFIEldName[I]);
　　              except
　　                FIEld := nil;
　　              end;
　　            end else
　　              FIEld := nil;
　　            if Assigned(FIEld) then
　　            begin
　　              if FIEld.DataType <> ftString then
　　                List[I].DataType := FIEld.DataType
　　              else if TStringField(FIEld).FixedChar then
　　                List[I].DataType := ftFixedChar
　　              else
　　                List[I].DataType := 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;
　　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.SetMasterFIElds(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;
　　end;

　　function TBDEClIEntDataSet.GetConnection: TDatabase;
　　begin
　　 Result := FDataBase;
　　end;

　　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;
　　end;

　　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(Source).CommandText;
　　 inherited CloneCursor(Source, Reset, KeepSettings);
　　end;

　　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;
　　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;
　　end;

　　function TBDEClIEntDataSet.GetMasterSource: TDataSource;
　　begin
　　 Result := inherited MasterSource;
　　end;

　　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 then
　　      TBDEClIEntDataSet(TDataSet(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;