objectsbrowser.pas

mssql查询分析器

// 对象浏览器控件.
//
unit ObjectsBrowser;

interface
uses Windows, Messages, Classes, SysUtils, Controls, StdCtrls, ComCtrls,
    ExtCtrls, Graphics, ImgList, Variants, ADOInt, Pub, Forms, Menus;

type
  TObjectsBrowserPanel = class(TPanel)
  private
    FComboBox: TComboBox;
    FTreeView: TTreeView;
    FConnection: _Connection;
    FImageList: TImageList;
    FMenu: TPopupMenu;
    FRefreshMenu: TMenuItem;
    FServerInfos: TList;

    procedure LoadResBitmap;
    procedure OnSelectServer(Sender: TObject);
    procedure OnTreeNodeDeletion(Sender: TObject; Node: TTreeNode);
    procedure OnTreeNodeChanged(Sender: TObject; Node: TTreeNode);
    procedure OnTreeNodeExpanding(Sender: TObject; Node: TTreeNode;
                        var AllowExpansion: Boolean);

    procedure FillDatabases(Node: TTreeNode);
    procedure FillUserTables(Node: TTreeNode; dbName: string);
    procedure FillSysTables(Node: TTreeNode; dbName: string);
    procedure FillViews(Node: TTreeNode; dbName: string);
    procedure FillUserTypes(Node: TTreeNode; dbName: string);
    procedure FillTableColumns(Node: TTreeNode; Data: TObject);
    procedure FillTableIndexes(Node: TTreeNode; Data: TObject);
    procedure FillTableContraints(Node: TTreeNode; Data: TObject);
    procedure FillDepends(Node: TTreeNode; DBName: string; ObjID: Integer);
    procedure FillTriggers(Node: TTreeNode; DBName: string; ObjID: Integer);
    procedure FillViewColumns(Node: TTreeNode; Data: TObject);
    procedure FillViewIndexes(Node: TTreeNode; Data: TObject);
    procedure FillStoredProcs(Node: TTreeNode; dbName: string);
    procedure FillFunctions(Node: TTreeNode; dbName: string);
    procedure FillSProcParams(Node: TTreeNode; dbName, dbo, spname: string);

    function ExecuteSql(const Sql: string): Integer;
    function ExecuteRst(const Sql: string): _Recordset;
    function GetColumnDescription(colname, typename: string;
        size, prec, scale: Integer; nullable: Boolean): string;

    procedure Relayout;

    procedure DoRefresh(Sender: TObject);
    procedure DoMenuPopup(Sender: TObject);
  protected
    procedure CreateWnd; override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure RefreshObjects;
    procedure AddServer(AServer, AUserName, APwd,
                        ADataSource, ALoginName: string;
                        AuthType: TAuthType);
  end;

implementation

{$R ObjectsBrowser.RES}

type
  TServerInfo = class
    Server: string;
    UserName: string;
    Password: string;
    AuthType: TAuthType;
    DataSource: string;
  end;

  TDBItemType = (dtUnknown, dtUserTable, dtSysTable, dtView, dtStoredProc,
                  dtFunction, dtUserType);
  TTableItemType = (ttUnknown, ttColumn, ttIndex, ttContraint, ttDepend, ttTrigger);
  TViewItemType = (vtUnknown, vtColumn, vtIndex, vtDepend, vtTrigger);
  TSPItemType = (stUnknown, stParameter, stDepend);
  TFunctionItemType = (ftUnknown, ftParameter, ftDepend);

  TDBNode = class(TObject);

  TDBItemInfo = class
  public
    FDBName: string;
    FItemType: TDBItemType;
    constructor Create(ADBName: string; AType: TDBItemType);
  end;

  TTableNode = class(TObject);

  TTableItemInfo = class
  public
    FDBName: string;
    FTableID: Integer;
    FItemType: TTableItemType;
    constructor Create(ADBName: string; ATableID: Integer; AType: TTableItemType);
  end;

  TViewNode = class(TObject);

  TViewItemInfo = class
  public
    FDBName: string;
    FViewID: Integer;
    FViewName: string;
    FOwner: string;
    FItemType: TViewItemType;
    constructor Create(ADBName: string; AViewID: Integer;
                    AViewName: string; AOwner: string; AType: TViewItemType);
  end;

  TSPNode = class(TObject);
  
  TSPItemInfo = class
  public
    FDBName: string;
    FOwner: string;
    FSPName: string;
    FSPID: Integer;
    FItemType: TSPItemType;
    constructor Create(ADBName, AOwner, ASPName: string; ASPID: Integer;
                      AItemType: TSPItemType);
  end;

  TFuncNode = class(TObject);

  TFuncItemInfo = class
  public
    FDBName: string;
    FOwner: string;
    FFuncName: string;
    FFuncID: Integer;
    FItemType: TFunctionItemType;

    constructor Create(ADBName, AOwner, AFuncName: string; AFuncID: Integer;
                      AItemType: TFunctionItemType);
  end;

{ TDBItemInfo }

constructor TDBItemInfo.Create(ADBName: string; AType: TDBItemType);
begin
  FDBName := ADBName;
  FItemType := AType;
end;

{ TTableItemInfo }

constructor TTableItemInfo.Create(ADBName: string; ATableID: Integer;
                          AType: TTableItemType);
begin
  FDBName := ADBName;
  FTableID := ATableID;
  FItemType := AType;
end;

{ TViewItemInfo }

constructor TViewItemInfo.Create(ADBName: string; AViewID: Integer;
                    AViewName: string; AOwner: string; AType: TViewItemType);
begin
  FDBName := ADBName;
  FViewID := AViewID;
  FViewName := AViewName;
  FOwner := AOwner;
  FItemType := AType;
end;

{ TSPItemInfo }

constructor TSPItemInfo.Create(ADBName, AOwner, ASPName: string; ASPID: Integer;
                  AItemType: TSPItemType);
begin
  FDBName := ADBName;
  FOwner := AOwner;
  FSPName := ASPName;
  FSPID := ASPID;
  FItemType := AItemType;
end;

{ TFuncItemInfo }

constructor TFuncItemInfo.Create(ADBName, AOwner, AFuncName: string; AFuncID: Integer;
                  AItemType: TFunctionItemType);
begin
  FDBName := ADBName;
  FOwner := AOwner;
  FFuncName := AFuncName;
  FFuncID := AFuncID;
  FItemType := AItemType;
end;

const
  ConnStr1 = 'Provider=SQLOLEDB.1;Integrated Security=SSPI;' +
             'Persist Security Info=False;Data Source=%s;Application Name=SQL查询器-对象浏览器';

  ConnStr2 = 'Provider=SQLOLEDB.1;Password=%s;' +
             'Persist Security Info=True;User ID=%s;Data Source=%s;' +
             'Application Name=SQL查询器-对象浏览器';

procedure LoadRes;
var
  b: TBitmap;
begin
  b := TBitmap.Create;
  try
    b.LoadFromResourceName(SysInit.HInstance, 'B0');
  finally
    b.Free;
  end;
end;

{ TObjectsBrowserPanel }

procedure TObjectsBrowserPanel.AddServer(AServer, AUserName, APwd,
  ADataSource, ALoginName: string; AuthType: TAuthType);
  
  function FindServer: Boolean;
  var
    I: Integer;
    info: TServerInfo;
  begin
    for I := 0 to FComboBox.Items.Count-1 do
    begin
      info := TServerInfo(FComboBox.Items.Objects[I]);
      if info = nil then Continue;
      if SameText(info.Server, AServer) and SameText(info.UserName, AUserName)
          and SameText(info.Password, APwd) and (info.AuthType = AuthType) then
      begin
        Result := True;
        Exit;
      end;
    end;
    Result := False;
  end;     
var
  info: TServerInfo;
begin
  if FindServer then Exit;

  info := TServerInfo.Create;
  info.Server := AServer;
  info.UserName := AUserName;
  info.Password := APwd;
  info.AuthType := AuthType;
  info.DataSource := ADataSource;

  FServerInfos.Add(Pointer(info));
  FComboBox.AddItem(ADataSource + '(' + ALoginName + ')', TObject(info));
end;

constructor TObjectsBrowserPanel.Create(AOwner: TComponent);
begin
  inherited;

  Self.BevelOuter := bvNone;
  FServerInfos := TList.Create;

  FComboBox := TComboBox.Create(nil);
  FTreeView := TTreeView.Create(nil);
  FMenu := TPopupMenu.Create(nil);
  FRefreshMenu := TMenuItem.Create(nil);
  FMenu.Items.Add(FRefreshMenu);
end;

procedure TObjectsBrowserPanel.CreateWnd;
begin
  inherited;

  FComboBox.Parent := Self;
  FComboBox.Style := csDropDownList;

  FTreeView.Parent := Self;
  FTreeView.HideSelection := False;
  FTreeView.ReadOnly := True;
  FTreeView.PopupMenu := FMenu;

  FRefreshMenu.Caption := '刷新(&R)';
  FRefreshMenu.ShortCut := ShortCut(116 {VK_F5}, []);
  FRefreshMenu.OnClick := DoRefresh;
  FMenu.OnPopup := DoMenuPopup;

  LoadResBitmap;
  FTreeView.Images := FImageList;

  FComboBox.OnSelect := OnSelectServer;
  FTreeView.OnDeletion := OnTreeNodeDeletion;
  FTreeView.OnChange := OnTreeNodeChanged;
  FTreeView.OnExpanding := OnTreeNodeExpanding;

  Resize;
end;

destructor TObjectsBrowserPanel.Destroy;
var
  I: Integer;
begin
  FComboBox.Free;
  FTreeView.Free;
  FRefreshMenu.Free;
  FMenu.Free;
  FImageList.Free;;

  for I := 0 to FServerInfos.Count-1 do
    TObject(FServerInfos[I]).Free;
  FServerInfos.Free;

  FConnection := nil;

  inherited;
end;

procedure TObjectsBrowserPanel.DoMenuPopup(Sender: TObject);
var
  pt: TPoint;
  Node: TTreeNode;
begin
  GetCursorPos(pt);
  pt := FTreeView.ScreenToClient(pt);
  Node := FTreeView.GetNodeAt(pt.X, pt.Y);
  if Node <> nil then
    Node.Selected := True;

  if Node = nil then
    Node := FTreeView.Selected;

  if Node = nil then Exit;

  FMenu.Items[0].Enabled := Node.Data <> nil;
end;

procedure TObjectsBrowserPanel.DoRefresh(Sender: TObject);
var
  Node, theNode: TTreeNode;
  obj: TObject;
  I: Integer;
begin
  Node := FTreeView.Selected;
  if Node = nil then Exit;

  obj := TObject(Node.Data);
  if obj = nil then Exit;

  if (obj is TDBNode) or (obj is TTableNode) or (obj is TViewNode)
        or (obj is TSPNode) or (obj is TFuncNode) then
  begin
    for I := 0 to Node.Count-1 do
    begin
      theNode := Node[I];
      theNode.DeleteChildren;
      theNode.HasChildren := True;
    end;
  end
  else if (obj is TDBItemInfo) or (obj is TTableItemInfo)
      or (obj is TViewItemInfo) or (obj is TSPItemInfo)
      or (obj is TFuncItemInfo) then
  begin
    Node.DeleteChildren;
    Node.HasChildren := True;
  end;
end;

function TObjectsBrowserPanel.ExecuteRst(const Sql: string): _Recordset;
var
  VarAffected: OleVariant;
begin
  Result := FConnection.Execute(Sql, VarAffected, 0);
end;

function TObjectsBrowserPanel.ExecuteSql(const Sql: string): Integer;
var
  VarAffected: OleVariant;
begin
  FConnection.Execute(Sql, VarAffected, adExecuteNoRecords);
  Result := VarAffected;
end;

procedure TObjectsBrowserPanel.FillDatabases(Node: TTreeNode);

  procedure AddItemNode(PNode: TTreeNode; s: string; data: TDBItemInfo);
  var
    itemNode: TTreeNode;
  begin
    itemNode := FTreeView.Items.AddChild(PNode, s);
    itemNode.HasChildren := True;
    itemNode.ImageIndex := 2;
    itemNode.SelectedIndex := 3;
    itemNode.Data := Pointer(data);
  end;

const
  sql = 'exec sp_MShasdbaccess';
var
  Rst: _Recordset;
  dbNode: TTreeNode;
  dbname: string;
begin
  Rst := ExecuteRst(sql);

  while not Rst.EOF do
  begin
    dbname := String(Rst.Fields['dbname'].Value);
    dbNode := FTreeView.Items.AddChild(Node, dbname);
    dbNode.ImageIndex := 1;
    dbNode.SelectedIndex := 1;
    dbNode.Data := Pointer(TDBNode.Create);
    
    AddItemNode(dbNode, '用户表', TDBItemInfo.Create(dbname, dtUserTable));
    AddItemNode(dbNode, '系统表', TDBItemInfo.Create(dbname, dtSysTable));
    AddItemNode(dbNode, '视图', TDBItemInfo.Create(dbname, dtView));
    AddItemNode(dbNode, '存储过程', TDBItemInfo.Create(dbname, dtStoredProc));
    AddItemNode(dbNode, '函数', TDBItemInfo.Create(dbname, dtFunction));
    AddItemNode(dbNode, '用户定义的数据类型', TDBItemInfo.Create(dbname, dtUserType));