objectsbrowser.pas

mssql查询分析器

  var
    Node: TTreeNode;
  begin
    Node := FTreeView.Items.AddChildObject(ParentNode, Title, Pointer(Data));
    Node.ImageIndex := 2;
    Node.SelectedIndex := 3;
    Node.HasChildren := True;
  end;

const
  sql = 'select id, owner = user_name(uid), name, status ' +
        'from [%s].dbo.sysobjects where type = N''U'' order by name';
var
  Rst: _Recordset;
  tabNode: TTreeNode;
  dbo, table: string;
  tabID: Integer;
begin
  ExecuteSql(Format('use [%s]', [dbName]));
  Rst := ExecuteRst(Format(sql, [dbName]));
  while not Rst.EOF do
  begin
    dbo := String(Rst.Fields.Item['owner'].Value);
    table := String(Rst.Fields.Item['name'].Value);
    tabID := Integer(Rst.Fields.Item['id'].Value);

    tabNode := FTreeView.Items.AddChild(Node, dbo + '.' + table);
    tabNode.ImageIndex := 4;
    tabNode.SelectedIndex := 4;
    tabNode.Data := Pointer(TTableNode.Create);

    AddTableItemNode(tabNode, '列', TTableItemInfo.Create(dbName, tabID, ttColumn));
    AddTableItemNode(tabNode, '索引', TTableItemInfo.Create(dbName, tabID, ttIndex));
    AddTableItemNode(tabNode, '约束', TTableItemInfo.Create(dbName, tabID, ttContraint));
    AddTableItemNode(tabNode, '相关性', TTableItemInfo.Create(dbName, tabID, ttDepend));
    AddTableItemNode(tabNode, '触发器', TTableItemInfo.Create(dbName, tabID, ttTrigger));

    Rst.MoveNext;
  end;
  if Node.Count = 0 then Node.HasChildren := False;
end;

procedure TObjectsBrowserPanel.FillUserTypes(Node: TTreeNode;
  dbName: string);
const
  sql =
'select xtype, xusertype, type, name ' +
'from [%s].dbo.systypes where xusertype > 256 order by xtype';
var
  Rst: _Recordset;
  tNode: TTreeNode;
  typename: string;
begin
  ExecuteSql(Format('use [%s]', [dbName]));
  Rst := ExecuteRst(Format(sql, [dbName]));
  while not Rst.EOF do
  begin
    typename := Rst.Fields.Item['name'].Value;
    tNode := FTreeView.Items.AddChild(Node, typename);
    tNode.ImageIndex := 15;
    tNode.SelectedIndex := 15;

    Rst.MoveNext;
  end;

  if Node.Count = 0 then Node.HasChildren := False;
end;

procedure TObjectsBrowserPanel.FillViewColumns(Node: TTreeNode;
  Data: TObject);
const
  sql = 'select * from %s.%s.%s';

  function ADOTypeToSqlType(adotype: Word): string;
  begin
    case adotype of
      adTinyInt, adUnsignedTinyInt: Result := 'tinyint';
      adSmallInt, adUnsignedSmallInt: Result := 'smallint';
      adInteger, adUnsignedInt: Result := 'int';
      adBigInt, adUnsignedBigInt: Result := 'bigint';
      adSingle: Result := 'real';
      adDouble: Result := 'float';
      adCurrency: Result := 'money';
      adDecimal: Result := 'decimal';
      adNumeric, adVarNumeric: Result := 'numeric';
      adBoolean: Result := 'bit';
      adVariant: Result := 'sql_variant';
      adGUID: Result := 'uniqueidentifier';

      adDate, adDBDate, adDBTime,
      adDBTimeStamp, adFileTime, adDBFileTime:
          Result := 'datetime';

      adBSTR: Result := 'varchar';
      adChar: Result := 'char';
      adVarChar: Result := 'varchar';
      adLongVarChar: Result := 'text';
      adWChar: Result := 'nchar';
      adVarWChar: Result := 'nvarchar';
      adLongVarWChar: Result := 'ntext';
      adBinary: Result := 'binary';
      adVarBinary: Result := 'binary';
      adLongVarBinary: Result := 'image';
    else
      Result := 'unknown';
    end;
  end;

  function GetColumnText(f: Field): string;
  begin
    Result := GetColumnDescription(f.Name, ADOTypeToSqlType(f.Type_),
                        f.DefinedSize, f.Precision, f.NumericScale,
                        (f.Attributes and adFldIsNullable) = adFldIsNullable);
  end;

var
  info: TViewItemInfo;
  Rst: _Recordset;
  cNode: TTreeNode;
  s: string;
  I: Integer;
begin
  info := Data as TViewItemInfo;

  ExecuteSql(Format('use [%s]', [info.FDBName]));
  Rst := ExecuteRst(Format(sql, [info.FDBName, info.FOwner, info.FViewName]));
  for I := 0 to Rst.Fields.Count - 1 do
  begin
    s := GetColumnText(Rst.Fields.Item[I]);
    cNode := FTreeView.Items.AddChild(Node, s);
    cNode.ImageIndex := 5;
    cNode.SelectedIndex := 5;
  end;

  if Node.Count = 0 then Node.HasChildren := False;
end;

procedure TObjectsBrowserPanel.FillViewIndexes(Node: TTreeNode;
  Data: TObject);
const
  sql =
'select I.name, I.status ' +
'from [%s].dbo.sysindexes I ' +
'where I.id = %d and I.indid > 0 and I.indid < 255';

var
  info: TViewItemInfo;
  Rst: _Recordset;
  iNode: TTreeNode;
  idxname: string;
begin
  info := Data as TViewItemInfo;

  ExecuteSql(Format('use [%s]', [info.FDBName]));
  Rst := ExecuteRst(Format(sql, [info.FDBName, info.FViewID]));
  while not Rst.EOF do
  begin
    idxname := Rst.Fields.Item['name'].Value;
    iNode := FTreeView.Items.AddChild(Node, idxname);
    iNode.ImageIndex := 6;
    iNode.SelectedIndex := 6;
    
    Rst.MoveNext;
  end;
  if Node.Count = 0 then Node.HasChildren := False;
end;

procedure TObjectsBrowserPanel.FillViews(Node: TTreeNode; dbName: string);

  procedure AddViewItemNode(ParentNode: TTreeNode; Title: string;
                                Data: TViewItemInfo);
  var
    Node: TTreeNode;
  begin
    Node := FTreeView.Items.AddChildObject(ParentNode, Title, Pointer(Data));
    Node.ImageIndex := 2;
    Node.SelectedIndex := 3;
    Node.HasChildren := True;
  end;

const
  sql = 'select id, owner = user_name(uid), name, status, ' +
        'OBJECTPROPERTY(id, N''isschemabound'') ' +
        'from [%s].dbo.sysobjects where type = N''V'' order by name';
var
  Rst: _Recordset;
  tabNode: TTreeNode;
  dbo, view: string;
  viewID: Integer;
begin
  ExecuteSql(Format('use [%s]', [dbName]));
  Rst := ExecuteRst(Format(sql, [dbName]));
  while not Rst.EOF do
  begin
    dbo := String(Rst.Fields.Item['owner'].Value);
    view := String(Rst.Fields.Item['name'].Value);
    viewID := Rst.Fields.Item['id'].Value;
    
    tabNode := FTreeView.Items.AddChildObject(Node, dbo + '.' + view, nil);
    tabNode.ImageIndex := 11;
    tabNode.SelectedIndex := 11;

    AddViewItemNode(tabNode, '列',
      TViewItemInfo.Create(dbName, viewID, view, dbo, vtColumn));
    AddViewItemNode(tabNode, '索引',
      TViewItemInfo.Create(dbName, viewID, view, dbo, vtIndex));
    AddViewItemNode(tabNode, '相关性',
      TViewItemInfo.Create(dbName, viewID, view, dbo, vtDepend));
    AddViewItemNode(tabNode, '触发器',
      TViewItemInfo.Create(dbName, viewID, view, dbo, vtTrigger));

    Rst.MoveNext;
  end;
  if Node.Count = 0 then Node.HasChildren := False;
end;

function TObjectsBrowserPanel.GetColumnDescription(colname, typename: string;
    size, prec, scale: Integer; nullable: Boolean): string;
var
  s: string;
begin
  if SameText(typename, 'numeric') or
    SameText(typename, 'decimal') then
  begin
    s := Format('%s(%d, %d)', [typename, prec, scale]);
  end
  else if SameText(typename, 'varchar') or
    SameText(typename, 'nvarchar') or
    SameText(typename, 'binary') or
    SameText(typename, 'varbinary') or
    SameText(typename, 'char') or
    SameText(typename, 'nchar') then
  begin
    s := Format('%s(%d)', [typename, size]);
  end
  else
    s := typename;
  Result := colname + '(' + s;
  if nullable then
    Result := Result + ', Null)'
  else
    Result := Result + ', Not Null)';  
end;

procedure TObjectsBrowserPanel.LoadResBitmap;
var
  I: Integer;
  bmp: TBitmap;
begin
  if FImageList = nil then
    FImageList := TImageList.Create(nil);
  FImageList.Clear;
  bmp := TBitmap.Create;
  try
    for I := 0 to 20 do
    begin
      bmp.LoadFromResourceName(SysInit.HInstance, 'B' + IntToStr(I));
      FImageList.AddMasked(bmp, clFuchsia);
    end;
  finally
    bmp.Free;
  end;
end;

procedure TObjectsBrowserPanel.OnSelectServer(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  try
    RefreshObjects;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TObjectsBrowserPanel.OnTreeNodeChanged(Sender: TObject;
  Node: TTreeNode);
begin

end;

procedure TObjectsBrowserPanel.OnTreeNodeDeletion(Sender: TObject;
  Node: TTreeNode);
begin
  if Node.Data <> nil then
  begin
    TObject(Node.Data).Free;
    Node.Data := nil;
  end;
end;

procedure TObjectsBrowserPanel.OnTreeNodeExpanding(Sender: TObject;
  Node: TTreeNode; var AllowExpansion: Boolean);
var
  obj: TObject;
  dbinfo: TDBItemInfo;
  tabinfo: TTableItemInfo;
  vwinfo: TViewItemInfo;
  spinfo: TSPItemInfo;
  funcinfo: TFuncItemInfo;
begin
  if Node.Data = nil then Exit;
  if Node.Count > 0 then Exit;

  obj := TObject(Node.Data);
  Screen.Cursor := crHourGlass;
  try

  if obj is TDBItemInfo then
  begin
    dbinfo := TDBItemInfo(obj);
    case dbinfo.FItemType of
      dtUserTable: FillUserTables(Node, dbinfo.FDBName);
      dtSysTable: FillSysTables(Node, dbinfo.FDBName);
      dtView: FillViews(Node, dbinfo.FDBName);
      dtStoredProc: FillStoredProcs(Node, dbinfo.FDBName);
      dtFunction: FillFunctions(Node, dbinfo.FDBName);
      dtUserType: FillUserTypes(Node, dbinfo.FDBName);
    end;
  end
  else if obj is TTableItemInfo then
  begin
    tabinfo := TTableItemInfo(obj);
    case tabinfo.FItemType of
      ttColumn: FillTableColumns(Node, tabinfo);
      ttIndex: FillTableIndexes(Node, tabinfo);
      ttContraint: FillTableContraints(Node, tabinfo);
      ttDepend: FillDepends(Node, tabinfo.FDBName, tabinfo.FTableID);
      ttTrigger: FillTriggers(Node, tabinfo.FDBName, tabinfo.FTableID);
    end;
  end
  else if obj is TViewItemInfo then
  begin
    vwinfo := TViewItemInfo(obj);
    case vwinfo.FItemType of
      vtColumn: FillViewColumns(Node, vwinfo);
      vtIndex: FillViewIndexes(Node, vwinfo);
      vtDepend: FillDepends(Node, vwinfo.FDBName, vwinfo.FViewID);
      vtTrigger: FillTriggers(Node, vwinfo.FDBName, vwinfo.FViewID);
    end;
  end
  else if obj is TSPItemInfo then
  begin
    spinfo := TSPItemInfo(obj);
    case spinfo.FItemType of
      stParameter: FillSProcParams(Node, spinfo.FDBName, spinfo.FOwner, spinfo.FSPName);
      stDepend: FillDepends(Node, spinfo.FDBName, spinfo.FSPID);
    end;
  end
  else if obj is TFuncItemInfo then
  begin
    funcinfo := TFuncItemInfo(obj);
    case funcinfo.FItemType of
      ftParameter: FillSProcParams(Node, funcinfo.FDBName, funcinfo.FOwner, funcinfo.FFuncName);
      ftDepend: FillDepends(Node, funcinfo.FDBName, funcinfo.FFuncID);
    end;
  end;

  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TObjectsBrowserPanel.RefreshObjects;
var
  serv_info: TServerInfo;
  RootNode: TTreeNode;
begin
  if FComboBox.ItemIndex < 0 then Exit;

  with FComboBox do
    serv_info := TServerInfo(Items.Objects[ItemIndex]);

  if FConnection = nil then
    FConnection := CoConnection.Create;

  if (FConnection.State and adStateOpen) = adStateOpen then
    FConnection.Close;

  if serv_info.AuthType = atWindows then
    FConnection.ConnectionString := Format(ConnStr1, [serv_info.Server])
  else
    FConnection.ConnectionString := Format(ConnStr2,
        [serv_info.Password, serv_info.UserName, serv_info.Server]);
  FConnection.Open('', '', '', 0);

  FTreeView.Items.Clear;
  RootNode := FTreeView.Items.Add(nil, serv_info.DataSource);
  RootNode.ImageIndex := 0;
  RootNode.SelectedIndex := 0;

  FillDatabases(RootNode);
end;

procedure TObjectsBrowserPanel.Relayout;
begin
  if (FComboBox = nil) or (FTreeView = nil) then Exit;

  if FComboBox.Parent <> nil then FComboBox.HandleNeeded;
  FComboBox.Left := 0;
  FComboBox.Top := 0;
  FComboBox.Width := Self.Width;

  FTreeView.Left := 0;
  FTreeView.Top := FComboBox.Height + 2;
  FTreeView.Width := Self.Width;
  FTreeView.Height := Self.Height - FComboBox.Height - 2;
end;

procedure TObjectsBrowserPanel.Resize;
begin
  Relayout;
  inherited;
end;

initialization
  Variants.NullStrictConvert := False;
end.