⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 bdedatadriverdesigneh.pas

📁 最新的 DBGRIDEH4.0
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{*******************************************************}
{                                                       }
{                     EhLib v4.0                        }
{                                                       }
{         TBDEDesignDataBaseEh (Build 4.0.21)               }
{                                                       }
{     Copyright (c) 2004-2005 by Dmitry V. Bolshakov    }
{                                                       }
{*******************************************************}

unit BDEDataDriverDesignEh;

{$I EHLIB.INC}

interface

{$IFDEF CIL}
{$R BDEDataDriverEh.TBDEDataDriverEh.bmp}
{$ENDIF}

uses Windows, SysUtils, Classes, Controls, DB,
{$IFDEF CIL}
  EhLibVCLNET,
{$ELSE}
  EhLibVCL,
{$ENDIF}
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
{$IFDEF EH_LIB_5} Contnrs, {$ENDIF}
  ToolCtrlsEh, DBCommon, MemTableDataEh, DataDriverEh, DBTables,
  SQLDriverEditEh, BDEDataDriverEh, ComCtrls, MemTableEh, Forms;

type

{ IBDEDesignDataBaseEh }

  IBDEDesignDataBaseEh = interface
  ['{9E53BD33-4E5E-414F-9E4A-4980A8F7637A}']
    function GetDataBase: TDataBase;
  end;

{ TBDEDesignDataBaseEh }

  TBDEDesignDataBaseEh = class(TDesignDataBaseEh, IBDEDesignDataBaseEh)
  private
    FDBEDataBase: TDataBase;
    FTreeNodeMan: TCustomDBService;
    FRuntimeDataBaseName: String;
    FDBService: TCustomDBService;
    FUpdateObjectsList: TStringList;
  protected
    function GetConnected: Boolean; override;
    procedure SetConnected(const Value: Boolean); override;
    procedure DataBaseDisconnected(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
    function GetEngineName: String; override;
    function GetServerTypeName: String; override;
    function CreateDesignCopy(RTDataDriver: TCustomSQLDataDriverEh): TCustomSQLDataDriverEh; override;
    function DesignDataBaseConnetionEqual(DataDriver: TCustomSQLDataDriverEh): Boolean; override;
    function Execute(Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer; override;
    function GetDataBase: TDataBase;
    function BuildUpdates(DataDriver: TCustomSQLDataDriverEh): Boolean; override;
    function CreateReader(SQL: String; FParams: TParamsArr): TDataSet; override;
    function ExecuteSQL(SQL: String; FParams: TParamsArr): Integer;
    function BuildObjectTree(List: TList): Boolean; override;
    function BuildInformixObjectTree2(List: TList): Boolean;
    function BuildInterbaseObjectTree2(List: TList): Boolean;
    function BuildOracleObjectTree(List: TList): Boolean;
    function GetFieldList(const TableName: string; DataSet: TDataSet): Boolean; override;
    function SupportCustomSQLDataDriver: Boolean; override;
    function GetSpecParamsList: String; override;
    function GetCustomDBService: TCustomDBService; override;
    function GetIncrementObjectsList: TStrings; override;
    procedure BuildQueryPlan(PlanTable: TMemTableEh; Command: TCustomSQLCommandEh); override;
    procedure EditDatabaseParams; override;
    procedure ResetDesignInfo; override;
    property RuntimeDataBaseName: String read FRuntimeDataBaseName write FRuntimeDataBaseName;
  end;

{ TBDEDesignDataBaseEh }

  TBDEUniService = class(TCustomDBService)
  private
    ServerService: TCustomDBService;
  public
    constructor Create(ADesignDB: TDesignDataBaseEh); override;
    destructor Destroy; override;
    function CreateRootNodes: TList; override;
//    function CreateNodes(Parent: IGetSQLTreeNode): TList; override;
    function CreateNodes(Parent: TSQLTreeNode): TList; override;
    function ShowPopup(Source: TObject; Coord: TPoint; Params: TServicePopupParams): Integer; override;
    class function GetDBServiceName: String; override;
  end;

procedure UnregisterBDEAccessEngines;
procedure RegisterBDEAccessEngines;

{$IFDEF DESIGNTIME}
procedure Register;
{$ENDIF}

implementation

uses BDE, DesignConnectionListEh, 
{$IFDEF DESIGNTIME}
	MemTableDesignEh,
{$IFDEF DESIGNTIME}
  {$IFDEF CIL}
    Borland.Vcl.Design.DbEdit,
    Borland.Vcl.Design.FldProp,
  {$ELSE}
    Dbedit,
  {$ENDIF}
{$ENDIF}
{$IFDEF CIL}
  Borland.Vcl.Design.DesignIntf,
{$ELSE}
  {$IFDEF EH_LIB_6}
     DesignIntf,
  {$ELSE} //EH_LIB_6
      DsgnIntf,
  {$ENDIF}
  DBReg,
{$ENDIF}
{$ENDIF}
Dialogs, UpdateSQLEditEh;

type
  TDBDescription = record
    szName          : String;          { Logical name (Or alias) }
    szText          : String;          { Descriptive text }
    szPhyName       : String;          { Physical name/path }
    szDbType        : String;          { Database type }
  end;

{$IFDEF CIL}
{$ELSE}
function StrToOem(const AnsiStr: string): string;
begin
  SetLength(Result, Length(AnsiStr));
  if Length(Result) > 0 then
    CharToOem(PChar(AnsiStr), PChar(Result));
end;
{$ENDIF}

function GetDatabaseDesc(DBName: String; var Description: TDBDescription): Boolean;
var
  Desc: DBDesc;
begin
  Result := False;
{$IFDEF CIL}
  if DbiGetDatabaseDesc(DBName, Desc) <> 0 then Exit;
{$ELSE}
  if DbiGetDatabaseDesc(PChar(StrToOem(DBName)), @Desc) <> 0 then Exit;
{$ENDIF}
  Description.szName := Desc.szName;
  Description.szText := Desc.szText;
  Description.szPhyName := Desc.szPhyName;
  Description.szDbType := Desc.szDbType;
  Result := True;
end;

var
  DataBaseInc: Integer = 0;

function GetUnicalDataBaseName: String;
begin
  Inc(DataBaseInc);
  Result := 'BDEDataDriverEhDataBaseName' + IntToStr(DataBaseInc);
end;

function CreateDesignDataBase(DataDriver: TBDEDataDriverEh): TComponent;
var
  DesignDataBase: TBDEDesignDataBaseEh;
  SourceDataBase: TDataBase;
  Description: TDBDescription;

  function IsAlias(DatabaseName: String): Boolean;
  var
    List: TStringList;
  begin
    Result := False;
    List := TStringList.Create;
    try
      Session.GetAliasNames(List);
      if List.IndexOf(DatabaseName) >= 0 then
        Result := True;
    finally
      List.Free;
    end;
  end;

begin
  DesignDataBase :=  TBDEDesignDataBaseEh.Create;
  SourceDataBase := Session.FindDatabase(DataDriver.DatabaseName);
  if SourceDataBase <> nil then
  begin
    DesignDataBase.FDBEDataBase.DatabaseName := GetUnicalDataBaseName;
    if (SourceDataBase.AliasName = '') and
      (SourceDataBase.DriverName = '') and
      GetDatabaseDesc(DataDriver.DatabaseName, Description)
    then
      DesignDataBase.FDBEDataBase.AliasName := DataDriver.DatabaseName
    else if SourceDataBase.AliasName <> '' then
      DesignDataBase.FDBEDataBase.AliasName := SourceDataBase.AliasName
    else if SourceDataBase.DriverName <> '' then
      DesignDataBase.FDBEDataBase.DriverName := SourceDataBase.DriverName;
    DesignDataBase.FDBEDataBase.Params := SourceDataBase.Params;
  end else if IsAlias(DataDriver.DatabaseName) then
    DesignDataBase.FDBEDataBase.DatabaseName := DataDriver.DatabaseName
  else if GetDatabaseDesc(DataDriver.DatabaseName, Description) then
    DesignDataBase.FDBEDataBase.DatabaseName := DataDriver.DataBaseName;
  DesignDataBase.RuntimeDataBaseName := DataDriver.DatabaseName;

{$IFDEF DESIGNTIME}
  EditDatabase(DesignDataBase.FDBEDataBase);
{$ENDIF}

  Result := DesignDataBase;
end;

procedure SetDesignDBEDataBaseProcEh(DataDriver: TCustomSQLDataDriverEh);
var
  i: Integer;
  DesignDataBase: TComponent;
begin
  if DataDriver.DesignDataBase = nil then
  begin
    for i := 0 to GetDesignDataBaseList.Count-1 do
      if TDesignDataBaseEh(GetDesignDataBaseList[i]).DesignDataBaseConnetionEqual(DataDriver) then
      begin
        DataDriver.DesignDataBase := TComponent(GetDesignDataBaseList[i]);
        Exit;
      end;

    if GetDesignDataBaseList.Count > 0 then
    begin
      DesignDataBase := SelectDesignConnectionListEh(DesignDataBaseList);
      if (DesignDataBase <> nil) and (DesignDataBase <> DataDriver.DesignDataBase) then
        DataDriver.DesignDataBase := DesignDataBase;
    end else
      DataDriver.DesignDataBase := CreateDesignDataBase(TBDEDataDriverEh(DataDriver));
  end;
end;

{ TBDEDesignDataBaseEh }

function TBDEDesignDataBaseEh.BuildObjectTree(List: TList): Boolean;
begin
//  TreeView.Items.Clear;
  if GetServerTypeName = 'INFORMIX' then
    Result := BuildInformixObjectTree2(List)
  else if GetServerTypeName = 'INTRBASE' then
    Result := BuildInterbaseObjectTree2(List)
  else if GetServerTypeName = 'ORACLE' then
    Result := BuildOracleObjectTree(List)
  else
    Result := False;
end;

function TBDEDesignDataBaseEh.BuildUpdates(DataDriver: TCustomSQLDataDriverEh): Boolean;
begin
  Result := EditDataDriverUpdateSQL(DataDriver as TCustomSQLDataDriverEh);// UpdateSQLEditEh
end;

constructor TBDEDesignDataBaseEh.Create;
begin
  inherited Create;
  FDBEDataBase := TDatabase.Create(Application);
  FDBEDataBase.DatabaseName := GetUnicalDataBaseName;
  FDBEDataBase.AfterDisconnect := DataBaseDisconnected;
//  FColumnsMT := TMemTableEh.Create(nil);
end;

destructor TBDEDesignDataBaseEh.Destroy;
begin
//  ShowMessage('TBDEDesignDataBaseEh.Destroy');
  if not (csDestroying in Application.ComponentState) then
    FreeAndNil(FDBEDataBase);
//  FreeAndNil(FColumnsMT);
  FreeAndNil(FTreeNodeMan);
  FreeAndNil(FDBService);
  inherited Destroy;
end;

function TBDEDesignDataBaseEh.CreateDesignCopy(RTDataDriver: TCustomSQLDataDriverEh): TCustomSQLDataDriverEh;
begin
  Result := TBDEDataDriverEh.Create(nil);
  Result.SelectCommand := RTDataDriver.SelectCommand;
  Result.UpdateCommand := RTDataDriver.UpdateCommand;
  Result.InsertCommand := RTDataDriver.InsertCommand;
  Result.DeleteCommand := RTDataDriver.DeleteCommand;
  Result.GetrecCommand := RTDataDriver.GetrecCommand;
  TBDEDataDriverEh(Result).SpecParams := TBDEDataDriverEh(RTDataDriver).SpecParams;
  TBDEDataDriverEh(Result).DatabaseName := FDBEDataBase.DatabaseName;
end;

function TBDEDesignDataBaseEh.DesignDataBaseConnetionEqual(DataDriver: TCustomSQLDataDriverEh): Boolean;
begin
  Result := False;
  if DataDriver is TBDEDataDriverEh then
    Result := (TBDEDataDriverEh(DataDriver).DatabaseName = RuntimeDataBaseName);
end;

function TBDEDesignDataBaseEh.Execute(Command: TCustomSQLCommandEh; var Cursor: TDataSet; var FreeOnEof: Boolean): Integer;
begin
  Result := -1;
  FreeOnEof := True;
  with Command do
    case CommandType of
      cthSelectQuery, cthUpdateQuery:
        begin
          Cursor := TQuery.Create(nil);
          with Cursor as TQuery do
          begin
            DataBaseName := FDBEDataBase.DatabaseName;
            SQL := Command.CommandText;
            Params := Command.GetParams;
            if CommandType = cthSelectQuery then
              Open
            else
            begin
              ExecSQL;
              Result := RowsAffected;
            end;
          end;
        end;
      cthTable:
        begin
          Cursor := TTable.Create(nil);
          with Cursor as TTable do
          begin
            DataBaseName := FDBEDataBase.DatabaseName;
            TableName := Command.CommandText.Text;
//            Params := Command.GetParams;
            Open;
          end;
        end;
      cthStoredProc:
        begin
          Cursor := TStoredProc.Create(nil);
          with Cursor as TStoredProc do
          begin
            DataBaseName := FDBEDataBase.DatabaseName;
            StoredProcName := Command.CommandText.Text;
            Params := Command.GetParams;
            ExecProc;
          end;
        end;
    end;
end;

function TBDEDesignDataBaseEh.GetDataBase: TDataBase;
begin
  Result := FDBEDataBase;
end;

function TBDEDesignDataBaseEh.GetServerTypeName: String;
var
  Description: TDBDescription;
begin
  if not FDBEDataBase.Connected then
  try
    FDBEDataBase.Open;
  except
    Application.HandleException(Self);
  end;
  if GetDatabaseDesc(FDBEDataBase.DatabaseName, Description) then
  begin
    Result := UpperCase(Description.szDbType);
  end;
end;

function TBDEDesignDataBaseEh.BuildInterbaseObjectTree2(List: TList): Boolean;
var
  NList: Tlist;
  i: Integer;
//  TreeNode: TTreeNode;
begin
  if FTreeNodeMan <> nil then
    FTreeNodeMan.Free;
  FTreeNodeMan := TInterbaseDBService.Create(Self);
  NList := FTreeNodeMan.CreateRootNodes;
//  List.Assign(NList, laCopy);
  List.Clear;
  for I := 0 to NList.Count - 1 do
    List.Add(NList[I]);

{  for i := 0 to List.Count-1 do
  begin
    TreeNode := TreeView.Items.Add(nil, TSQLTreeNode(List[i]).FName);
    TreeNode.HasChildren := True;
    TreeNode.Data := List[i];
  end;}
  NList.Free;
  Result := True;
end;

function TBDEDesignDataBaseEh.BuildInformixObjectTree2(List: TList): Boolean;
var
  NList: Tlist;
  i: Integer;
//  TreeNode: TTreeNode;
begin
  if FTreeNodeMan <> nil then
    FTreeNodeMan.Free;
  FTreeNodeMan := TInformixDBService.Create(Self);
  NList := FTreeNodeMan.CreateRootNodes;
//  List.Assign(NList, laCopy);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -