bdedatadriverdesigneh.pas

最新的 DBGRIDEH4.0

  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.CreateReader(SQL: String; FParams: TParamsArr): TDataSet;
var
  Query: TQuery;
  i: Integer;
  dt: TFieldType;
  p: TParam;
begin
  Query := TQuery.Create(nil);
  Query.DatabaseName := FDBEDataBase.DatabaseName;
  Query.SQL.Text := SQL;
  if High(FParams) > Low(FParams) then
    for i := Low(FParams) to High(FParams) div 2 do
    begin
      dt := VarTypeToDataType(VarType(FParams[i*2+1]));
      if dt = ftUnknown then
        dt := ftString;
      p := Query.Params.CreateParam(dt, FParams[i*2], ptInputOutput);
      p.Value := FParams[i*2+1];
    end;
  try
    Query.Open;
  except
    Query.Free;
    raise;
  end;
  Result := Query;
end;

function TBDEDesignDataBaseEh.ExecuteSQL(SQL: String;
  FParams: TParamsArr): Integer;
var
  Query: TQuery;
  i: Integer;
  dt: TFieldType;
  p: TParam;
begin
  Query := TQuery.Create(nil);
  Query.DatabaseName := FDBEDataBase.DatabaseName;
  Query.SQL.Text := SQL;
  if High(FParams) > Low(FParams) then
    for i := Low(FParams) to High(FParams) div 2 do
    begin
      dt := VarTypeToDataType(VarType(FParams[i*2+1]));
      if dt = ftUnknown then
        dt := ftString;
      p := Query.Params.CreateParam(dt, FParams[i*2], ptInputOutput);
      p.Value := FParams[i*2+1];
    end;
  try
    Query.ExecSQL;
    Result := Query.RowsAffected;
  except
    Query.Free;
    raise;
  end;
end;

function TBDEDesignDataBaseEh.BuildOracleObjectTree(List: TList): Boolean;
var
  NList: Tlist;
  i: Integer;
//  TreeNode: TTreeNode;
begin
  if FTreeNodeMan <> nil then
    FTreeNodeMan.Free;
  FTreeNodeMan := TOracleDBService.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;

procedure TBDEDesignDataBaseEh.EditDatabaseParams;
begin
{$IFDEF DESIGNTIME}
  EditDatabase(FDBEDataBase);
{$ENDIF}
//  inherited;
end;

function TBDEDesignDataBaseEh.GetEngineName: String;
begin
  Result := 'BDE';
end;

function TBDEDesignDataBaseEh.GetConnected: Boolean;
begin
  Result := FDBEDataBase.Connected;
end;

procedure TBDEDesignDataBaseEh.SetConnected(const Value: Boolean);
begin
  FDBEDataBase.Connected := Value;
end;

type
  TBDEAccessEngineEh = class(TAccessEngineEh)
    function AccessEngineName: String; override;
//    function CreateDesignDataBase(DataDriver: TCustomSQLDataDriverEh): TDesignDataBaseEh; override;
    function CreateDesignDataBase(DataDriver: TCustomSQLDataDriverEh;
      DBServiceClass: TCustomDBServiceClass; DataBaseName: String): TDesignDataBaseEh; override;
  end;

function TBDEDesignDataBaseEh.SupportCustomSQLDataDriver: Boolean;
begin
  Result := True;
end;

function TBDEDesignDataBaseEh.GetFieldList(const TableName: string; DataSet: TDataSet): Boolean;
var
  table: TTable;
  list: TStrings;
  i: Integer;

  procedure GetDataFieldNames(Dataset: TDataset; ErrorName: string; List: TStrings);
  var
    I: Integer;
  begin
    with Dataset do
    try
      FieldDefs.Update;
      List.BeginUpdate;
      try
        List.Clear;
        for I := 0 to FieldDefs.Count - 1 do
          List.Add(FieldDefs[I].Name);
      finally
        List.EndUpdate;
      end;
    except
      if ErrorName <> '' then
        MessageDlg(Format('SSQLDataSetOpen', [ErrorName]), mtError, [mbOK], 0);
    end;
  end;

  procedure SetKeyFields;
  var
    SepPos, I, Index: Integer;
    FName, FieldNames: string;
  begin
    table.IndexDefs.Update;
    for I := 0 to table.IndexDefs.Count - 1  do
      if ixPrimary in table.IndexDefs[I].Options then
      begin
        FieldNames := table.IndexDefs[I].Fields + ';';
        while Length(FieldNames) > 0 do
        begin
          SepPos := Pos(';', FieldNames);
          if SepPos < 1 then Break;
          FName := Copy(FieldNames, 1, SepPos - 1);
{$IFDEF CIL}
          Borland.Delphi.System.Delete(FieldNames, 1, SepPos);
{$ELSE}
          System.Delete(FieldNames, 1, SepPos);
{$ENDIF}
          Index := list.IndexOf(FName);
          if Index > -1 then list.Objects[Index] := TObject(1);
        end;
        break;
      end;
  end;

begin
  table := TTable.Create(nil);
  table.DatabaseName := GetDataBase.DatabaseName;
  table.TableName := TableName;
  list := TStringList.Create;
  GetDataFieldNames(table, 'Error', list);
  SetKeyFields;
  for i := 0 to list.Count-1 do
    if list.Objects[i] = TObject(1)
      then DataSet.AppendRecord([list[i], True])
      else DataSet.AppendRecord([list[i], False]);
  list.Free;
  table.Free;
  Result := True;
end;

procedure TBDEDesignDataBaseEh.BuildQueryPlan(PlanTable: TMemTableEh;
  Command: TCustomSQLCommandEh);
var
  DataSet: TDataSet;
{
CREATE TABLE PLAN_TABLE (

STATEMENT_ID    VARCHAR2(30),
TIMESTAMP       DATE,
REMARKS         VARCHAR2(80),
OPERATION       VARCHAR2(30),
OPTIONS         VARCHAR2(30),
OBJECT_NODE     VARCHAR2(128),
OBJECT_OWNER    VARCHAR2(30),
OBJECT_NAME     VARCHAR2(30),
OBJECT_INSTANCE NUMERIC,
OBJECT_TYPE     VARCHAR2(30),
OPTIMIZER       VARCHAR2(255),
SEARCH_COLUMNS  NUMBER,
ID              NUMERIC,
PARENT_ID       NUMERIC,
POSITION        NUMERIC,
COST            NUMERIC,
CARDINALITY     NUMERIC,
BYTES           NUMERIC,
OTHER_TAG       VARCHAR2(255),
PARTITION_START VARCHAR2(255),
PARTITION_STOP  VARCHAR2(255),
PARTITION_ID    NUMERIC,
OTHER           LONG,
DISTRIBUTION    VARCHAR2(30));
}
begin
  if GetServerTypeName = 'ORACLE' then
  begin
    ExecuteSQL('EXPLAIN PLAN FOR '#13 + Command.CommandText.Text, nil);
    DataSet := CreateReader('select * from PLAN_TABLE order by POSITION', nil);
    PlanTable.TreeList.Active := False;
    PlanTable.LoadFromDataSet(DataSet, -1, lmCopy, False);
    PlanTable.TreeList.KeyFieldName := 'ID';
    PlanTable.TreeList.RefParentFieldName := 'PARENT_ID';
    PlanTable.TreeList.DefaultNodeExpanded := True;
    PlanTable.TreeList.Active := True;
  end;
end;

function TBDEDesignDataBaseEh.GetSpecParamsList: String;
begin
  if GetCustomDBService <> nil then
    Result := GetCustomDBService.GetSpecParamsList;
end;

function TBDEDesignDataBaseEh.GetCustomDBService: TCustomDBService;
begin
  if FDBService = nil then
  begin
    if GetServerTypeName = 'INFORMIX' then
      FDBService := TInformixDBService.Create(Self)
    else if GetServerTypeName = 'INTRBASE' then
      FDBService := TInterbaseDBService.Create(Self)
    else if GetServerTypeName = 'ORACLE' then
      FDBService := TOracleDBService.Create(Self)
    else
      FDBService := nil
  end;
  Result := FDBService;
end;

function TBDEDesignDataBaseEh.GetIncrementObjectsList: TStrings;
begin
  if FUpdateObjectsList = nil then
    FUpdateObjectsList := TStringList.Create;
  if (GetCustomDBService <> nil) and (GetCustomDBService.GetIncrementObjectsList <> nil) then
  begin
    FUpdateObjectsList.Assign(GetCustomDBService.GetIncrementObjectsList);
    Result := FUpdateObjectsList;
  end else
    Result := nil;
end;

procedure TBDEDesignDataBaseEh.DataBaseDisconnected(Sender: TObject);
begin
  FreeAndNil(FDBService);
  FreeAndNil(FTreeNodeMan);
end;

procedure TBDEDesignDataBaseEh.ResetDesignInfo;
begin
  inherited ResetDesignInfo;
  FreeAndNil(FDBService);
  FreeAndNil(FTreeNodeMan);
end;

{ TBDEAccessEngineEh }

function TBDEAccessEngineEh.AccessEngineName: String;
begin
  Result := 'BDE';
end;

//function TBDEAccessEngineEh.CreateDesignDataBase(DataDriver: TCustomSQLDataDriverEh): TDesignDataBaseEh;
function TBDEAccessEngineEh.CreateDesignDataBase(DataDriver: TCustomSQLDataDriverEh;
  DBServiceClass: TCustomDBServiceClass; DataBaseName: String): TDesignDataBaseEh;
begin
  Result := TBDEDesignDataBaseEh.Create;
  Result.EditDatabaseParams;
  if DataDriver is TBDEDataDriverEh then
    TBDEDesignDataBaseEh(Result).RuntimeDataBaseName := TBDEDataDriverEh(DataDriver).DatabaseName;
//  DataDriver.DesignDataBase := BDEDesignDataBase;
end;

procedure RegisterBDEAccessEngines;
var
  Engine: TBDEAccessEngineEh;
begin
  RegisterDesignDataBuilderProcEh(TBDEDataDriverEh, SetDesignDBEDataBaseProcEh);
  Engine := TBDEAccessEngineEh.Create;
  RegisterAccessEngine('BDE', Engine);
  RegisterDBServiceEngine(Engine, TBDEUniService);
end;

procedure UnregisterBDEAccessEngines;
begin
  UnregisterDesignDataBuilderProcEh(TBDEDataDriverEh);
  UnregisterAccessEngine('BDE');
  UnregisterDBServiceEngine(TBDEUniService);
end;

{ TBDEUniService }

constructor TBDEUniService.Create(ADesignDB: TDesignDataBaseEh);
var
  ServiceClass: TCustomDBServiceClass;
begin
  inherited Create(ADesignDB);
  ServiceClass := GetDBServiceByName(ADesignDB.GetServerTypeName);
  if ServiceClass <> nil then
    ServerService := ServiceClass.Create(ADesignDB);
end;

destructor TBDEUniService.Destroy;
begin
  FreeAndNil(ServerService);
  inherited Destroy;
end;

function TBDEUniService.CreateRootNodes: TList;
begin
  Result := nil;
  if ServerService <> nil then
    Result := ServerService.CreateRootNodes;
end;

function TBDEUniService.CreateNodes(Parent: TSQLTreeNode): TList;
begin
  Result := nil;
  if ServerService <> nil then
    Result := ServerService.CreateNodes(Parent);
end;

function TBDEUniService.ShowPopup(Source: TObject; Coord: TPoint;
  Params: TServicePopupParams): Integer;
begin
  Result := -1;
  if ServerService <> nil then
    Result := ServerService.ShowPopup(Source, Coord, Params);
end;

class function TBDEUniService.GetDBServiceName: String;
begin
  Result := 'BDEUniService';
end;

{$IFDEF DESIGNTIME}

{ TDatabaseNameProperty }

type
  TDatabaseNameProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

procedure TDatabaseNameProperty.GetValueList(List: TStrings);
begin
  (GetComponent(0) as TBDEDataDriverEh).DBSession.GetDatabaseNames(List);
end;

procedure Register;
begin
  RegisterComponents('EhLib', [TBDEDataDriverEh]);
  RegisterPropertyEditor(TypeInfo(string), TBDEDataDriverEh, 'DatabaseName', TDatabaseNameProperty);

  RegisterComponentEditor(TBDEDataDriverEh, TSQLDataDriverEhEditor);
end;

{$ENDIF}

initialization
  RegisterBDEAccessEngines();
//  RegisterEngineDesignDataBuilderProcEh('BDE', SetEngineDesignBDEDataBaseProcEh);
finalization
//  ShowMessage('UnRegistering BDE');
  UnregisterBDEAccessEngines;
//  ShowMessage('UnRegistered BDE');
end.