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

原创 2011年01月24日 09:44:00

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(Li

st.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;

procedure Register;
begin
  RegisterComponents('BDE', [TBDEClientDataSet]);
end;

end.

//以上经DBLocalB.pas改装而成,可存为任意文件名,当然扩展名是PAS
//然后安装此控件即可

 

DELPHI 7.0软件 自带有报表 Quick Report组件(TQRShape等所有组件 说明)

DELPHI7.0软件自带有报表Quick Report组件,但是默认的情况下,工具栏中是没有的,需要手动添加,步骤:   component->install packages->add->\bo...
  • u011704389
  • u011704389
  • 2014年02月26日 15:41
  • 1523

教程:简单几步教你在Win版Delphi7中安装AlphaControls皮肤控件包.

注:这是个简易教程。 AlphaControls是一款不错的皮肤控件合集包。 它内置的诸多空间不仅能够让你的程序变得更加漂亮,同时你还可以为这些控件附加行为。 ***第一步,下载Alpha...
  • MoeDisk
  • MoeDisk
  • 2016年10月07日 12:12
  • 1877

Delphi 7皮肤控件VCLSkin 5.60的使用

VCLSkin是一个能够用于创建Delphi/C++ Builder应用程序美化界面的皮肤组件。它允许允许软件开发人员不用修改程序代码便把软件界面变得非常漂亮。它的美化支持窗体和控件和菜单。VCLSk...
  • wozengcong
  • wozengcong
  • 2013年07月28日 18:15
  • 2929

delphi7及控件安装

1 安装delphi 解压可看到一个delphi 7.0目录 下有个,双击即可安装,如需要输入注册码等,百度即可。 2 安装cnPack IDE专家(使delphi组件查找起来更加方便) 双击安...
  • baidu_28713695
  • baidu_28713695
  • 2015年06月03日 16:23
  • 158

Delphi7中的socketserver控件的安装

delphi7默认没有安装。需要手动安装。 具体位置:delphi7/bin/dclsockets70.bpl。 安装方法如下: Component->Install Packages->Ad...
  • ShengShengLan
  • ShengShengLan
  • 2013年05月06日 23:36
  • 699

Delphi著名皮肤控件库大全

皮肤这东西很多人褒贬不一,有人认为程序做的好就行了,界面还是保持原生态来的稳定。的确,稳定是程序至关重要的一点,离开这点其他任何都无从谈起,但不可否认,无论是微软、苹果,还是大众用户,审美观越来越高,...
  • u013408061
  • u013408061
  • 2017年06月25日 23:58
  • 353

Delphi 第三方控件安装

1 只有一个DCU文件的组件。           DCU文件是编译好的单元文件,这样的组件是作者不想把源码公布。一般来说,作者必须说明此组件适合Delphi的哪种版本,如果版本不对,在安装时就会出...
  • lailai186
  • lailai186
  • 2013年05月25日 15:57
  • 5763

Delphi 7 精简版在 Windows 8.1 64 位中的安装

精简版选用的是7.3.3.4优化精简适中版,只有40多兆,运行安装后如下所示: 点击确定后会弹出兼容警告,忽略,点确定继续 : 出现安装向导 点击下一步出现许可协议,不用看,点“我同意“”:...
  • MaxWoods
  • MaxWoods
  • 2014年02月25日 13:25
  • 5894

我常用的delphi 第三方控件

有网友问我常用的控件及功能。我先大概整理一下,以后会在文章里面碰到时再仔细介绍。       Devexpress VCL 这个基本上覆盖了系统界面及数据库展示的方方面面,是做桌面系统必备的一套...
  • chinajobs
  • chinajobs
  • 2016年06月28日 15:15
  • 2288

Delphi7中单元文件内各个部分的执行顺序

注:本文主要是讨论delphi程序启动时和退出时的执行顺序,期间有些知识来源于Delphi帮助,有些来自《Delphi7程序设计教程》(这本书只告诉我有initialization 和 finaliz...
  • u010673851
  • u010673851
  • 2014年02月09日 15:20
  • 985
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:delphi7找不到TBDEClientDataSet控件的解决方案
举报原因:
原因补充:

(最多只允许输入30个字)