unit1.pas

1.可查看/修改windows操作系统 可使用oledb或odbc的数据库 2.对于不需为用户安装管理工具的数据库,可方便程序员管理数据. 3.可以非常灵活地导出数据,甚至sql insert语句

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, Grids, DBGrids, ExtCtrls, ComCtrls, StdCtrls, ImgList,
  Menus;
const WM_PROCESS=11298;
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    TreeView1: TTreeView;
    Splitter1: TSplitter;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ADOConnection1: TADOConnection;
    ADODataSet1: TADODataSet;
    ImageList1: TImageList;
    CheckBox1: TCheckBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    SaveDialog1: TSaveDialog;
    CheckBox2: TCheckBox;
    N5: TMenuItem;
    N6: TMenuItem;
    StatusBar1: TStatusBar;
    Button2: TButton;
    N7: TMenuItem;
    sql1: TMenuItem;
    PopupMenu2: TPopupMenu;
    N8: TMenuItem;
    N10: TMenuItem;
    HTML1: TMenuItem;
    Panel2: TPanel;
    sql2: TMenuItem;
    CheckBox3: TCheckBox;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    sql3: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure TreeView1Collapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure Button2Click(Sender: TObject);
    procedure sql1Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure HTML1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure sql2Click(Sender: TObject);
    procedure onprocess(var message:Tmessage); message WM_PROCESS;
    procedure sql3Click(Sender: TObject);
  private
    { Private declarations }
    currtable:string;
  public
    { Public declarations }
    procedure ectractdbtree;
    procedure outtohtml(var dset:Tadodataset;fname:string)   ;
    procedure showdata;
    procedure exportstruct;
    procedure opends;
  end;

var
  Form1: TForm1;
  hexchars:array[0..15] of char=('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
implementation
uses htmutils,Unit2,Unit3,sqlutils,apppub, frmsqlbatch;
{$R *.dfm}
procedure Tform1.opends;
var pc:integer;
begin
  try
    ADOConnection1.Connected :=true;
    //ADOConnection1.ConnectionObject.OpenSchema;
    ADOConnection1.OpenSchema(siDBInfoKeywords, EmptyParam, EmptyParam, self.ADODataSet1);
    apppub.appconfig.Datas['dbview','lastds']:= ADOConnection1.ConnectionString;
    self.StatusBar1.Panels[0].Text :='请稍候正在获取数据库结构信息.......';
    application.ProcessMessages ;
    ectractdbtree;
    self.StatusBar1.Panels[0].Text :='';
  except
    ADOConnection1.Connected :=false;
  end;
end;
procedure Tform1.showdata;
var i:integer;
begin
  if TreeView1.Selected.SelectedIndex <>0 then
  begin
    ADODataSet1.Active :=false;
    currtable:=TreeView1.Selected.Text;
    if pos(' ',TreeView1.Selected.Text)>1 then //sqlserver
      self.ADODataSet1.CommandText :='select * from "' + TreeView1.Selected.Text+'"'
    else                                       //access
      self.ADODataSet1.CommandText :='select * from ' + TreeView1.Selected.Text;
    try
      ADODataSet1.Active:=true;
    except
      self.ADODataSet1.CommandText :='select * from [' + TreeView1.Selected.Text+']';//access
      try
        ADODataSet1.Active:=true;
      except
      end;
    end;
     for i:=0 to self.DBGrid1.Columns.Count -1 do
    if DBGrid1.Columns[i].Width >800 then
      DBGrid1.Columns[i].Width :=100;
  end;
  if TreeView1.Selected.ImageIndex=4 then//存储过程
  begin
    try
      ADODataSet1.Active:=false;
      self.ADOConnection1.OpenSchema(siProcedures,EmptyParam, EmptyParam,self.ADODataSet1);
    finally
      for i:=0 to self.DBGrid1.Columns.Count -1 do
      if DBGrid1.Columns[i].Width >800 then
      DBGrid1.Columns[i].Width :=100;
    end;
  end;
end;
procedure Tform1.exportstruct;
var i:integer;
  tstrs:Tstrings;
  tstr:string;
begin
  tstrs:=Tstringlist.Create;
  try
    for i:=0 to TreeView1.Items.Count-1 do
    if (TreeView1.Items[i].SelectedIndex <>0) and
    (TreeView1.Items[i].Parent.Text='用户表') then
    begin
      tstrs.Add(sqlutils.get_Table_syntax(self.ADOConnection1,TreeView1.Items[i].Text));
    end;
    if tstrs.count<=0 then
      messagebox(handle,'生成脚本出错','提示',mb_ok or mb_iconerror)
    else
    begin
      tstr:=SaveDialog1.Filter ;
      SaveDialog1.Filter:='sql|*.sql';
      SaveDialog1.FileName :=adoconnection1.Provider+'.sql';
      if SaveDialog1.Execute then
      begin
        tstrs.SaveToFile(SaveDialog1.FileName);
        messagebox(handle,'操作成功','提示',mb_ok );
      end;
      SaveDialog1.Filter :=tstr;
    end;
  except
    messagebox(handle,'生成脚本出错','提示',mb_ok or mb_iconerror);
  end;
  tstrs.free;
end;
procedure Tform1.ectractdbtree ;
var tstrs:tstrings;
    procs,utabs,fields:tstrings;
    root:Ttreenode;
    node:array[1..3] of Ttreenode;
    i,j:integer;
//    EmptyParam: OleVariant;
//    DataSet :TADODataSet;
begin
//  EmptyParam:=NULL;
  tstrs:=tstringlist.Create ;
  procs:=tstringlist.Create ;
  utabs:=tstringlist.Create ;
  fields:=tstringlist.Create ;
  treeview1.Items.Clear;
  self.ADOConnection1.GetProcedureNames(tstrs);
  procs.Text:=tstrs.Text;
  self.ADOConnection1.GetTableNames(tstrs);
  utabs.text:=tstrs.Text;
  self.ADOConnection1.GetTableNames(tstrs,true);
  //DataSet := TADODataSet.Create(nil);
  //self.ADOConnection1.OpenSchema(siTables,EmptyParam,EmptyParam,DataSet);
  //dataset.free;
  root    :=treeview1.Items.Addchild(nil,self.ADOConnection1.ConnectionObject.Provider);
  node[1] :=treeview1.Items.Addchild(root,'用户表');
  //图标
  node[2] :=treeview1.Items.Addchild(root,'系统表');
  //图标
  node[3] :=treeview1.Items.Addchild(root,'存储过程');
  //图标
  root.ImageIndex :=1;
  node[1].ImageIndex :=2 ;
  node[2].ImageIndex :=3  ;
  node[3].ImageIndex :=4 ;
  for i:=0 to tstrs.count-1 do
  begin
    if utabs.IndexOf(tstrs.Strings[i])<0 then //系统标
    begin
      root:=treeview1.Items.Addchild(node[2],tstrs.Strings[i]);
      root.SelectedIndex:=3;
    end
    else
    begin
      root:=treeview1.Items.Addchild(node[1],tstrs.Strings[i]);
      root.SelectedIndex:=2;
    end;
    //图标
    root.ImageIndex :=5;
    self.ADOConnection1.GetFieldNames(tstrs.Strings[i],fields);
    for j:=0 to fields.Count-1 do
    begin
      with treeview1.Items.Addchild(root,fields.Strings[j]) do
      begin
        //图标

      end;
    end;
  end;
  root:=node[3];
  for i:=0 to procs.Count-1 do
  begin
    with treeview1.Items.Addchild(root,procs.Strings[i]) do
    begin
      //图标
      imageindex:=root.ImageIndex;
    end;
  end;
  tstrs.Free ;
  procs.Free ;
  utabs.Free ;
  fields.Free;
  treeview1.TopItem.Expand(false);
  node[1].Expand(false);
  node[2].Expand(false);
  node[3].Expand(false);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOConnection1.Connected :=false;
  self.StatusBar1.Panels[0].Text :='准备打开数据库连接';
  application.ProcessMessages ;
  ADOConnection1.ConnectionString:=
  adodb.PromptDataSource(self.Handle,self.ADOConnection1.ConnectionString) ;
  ADOConnection1.LoginPrompt :=false;
  opends;
end;

procedure TForm1.TreeView1DblClick(Sender: TObject);
begin
  showdata;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  self.DBGrid1.ReadOnly :=  CheckBox1.Checked ;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  ADODataSet1.Sort :=
  DBGrid1.SelectedField.FieldName+' ASC';
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  ADODataSet1.Sort :=
  DBGrid1.SelectedField.FieldName+' DESC';
end;

procedure TForm1.N4Click(Sender: TObject);
begin
  if self.SaveDialog1.Execute then
  begin
    if uppercase(extractfileext(self.SaveDialog1.FileName))='.XML' then
      self.ADODataSet1.SaveToFile(self.SaveDialog1.FileName ,pfXML)
    else if  uppercase(extractfileext(self.SaveDialog1.FileName))='.ADTG' then
      self.ADODataSet1.SaveToFile(self.SaveDialog1.FileName )