unit1.pas

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

    else
      outtohtml(ADODataSet1,SaveDialog1.filename);
  end;
end;
procedure TForm1.outtohtml(var dset:Tadodataset;fname:string);
var tstrs:tstrings;
begin
  tstrs:=tstringlist.Create ;
  if htmutils.datasettohtm(dset,tstrs,checkbox3.checked,self.Handle) then
    tstrs.SaveToFile(fname);
    tstrs.Free ;
end;
procedure TForm1.N5Click(Sender: TObject);
var ww:integer;
begin
  if trystrtoint(inputbox('','请输入列宽值','0'),ww) then
    self.DBGrid1.SelectedField.DisplayWidth:=ww;
end;

procedure TForm1.N6Click(Sender: TObject);
var pch:pchar;
    tstr:string;
    astr:widestring;
    binv,blv,blmemo:boolean;
    s:Tstream;
    function pchartohex(pchr:pchar;size:integer):string;
    var i:integer;
        p:pchar;
    begin
      try
      p:=pchr;
      result:='';
      i:=0;
      while i<size do
      begin
        if (i mod 32=0) and (i<>0) then
          result:=result+#$D#$A;
        result:=result+hexchars[ord(p ^) div 16]+hexchars[ord(p ^) mod 16]+' ';
        inc(p);
        inc(i);
      end;
      finally
      end;
    end;
    function getpstr(pstr:pchar;size:integer):widestring;
    var j:integer;
        p2:pchar;
    begin
      result:='';
      p2:=pstr;
      for j:=0 to size do
      begin
        if p2 ^ =chr(0) then
          result:=result+' '
        else
        result:=result+p2[0];
        inc(p2);
      end;
    end;
begin
  tstr:=uppercase(dbgrid1.SelectedField.Text);
  astr:=dbgrid1.SelectedField.Text;
  binv:=(( tstr='(VARBYTES)') or (tstr ='(BYTES)')) ;
  blv:=UPPERCASE(trim(tstr))='(BLOB)';
  blmemo:=tstr='(MEMO)';
  if binv then
  begin
    getmem(pch,dbgrid1.SelectedField.DataSize);
    if dbgrid1.SelectedField.IsNull then
      tstr:='(NULL)'
    else
    begin
      dbgrid1.SelectedField.GetData(pch);
      tstr:='十六进制:'#$D#$A+pchartohex(pch,dbgrid1.SelectedField.DataSize);
    end;
    astr:=getpstr(pch,dbgrid1.SelectedField.DataSize);
    freemem(pch);
  end
  else if blv then
  begin
    s:=Tstringstream.Create('');
    TBlobField(dbgrid1.SelectedField).SaveToStream(s);
    s.Seek(0,0);
    tstr:=Tstringstream(s).ReadString(s.Size) ;
    s.Free;
  end
  else if blmemo then
  begin
    s:=Tstringstream.Create('');
    TBlobField(dbgrid1.SelectedField).SaveToStream(s);
    s.Seek(0,0);
    tstr:=Tstringstream(s).ReadString(s.Size) ;
    s.Free;
  end
  else
    tstr:=dbgrid1.SelectedField.Text;
  Unit2.Form2.caption :=self.ADODataSet1.CommandText +'----['+
  dbgrid1.SelectedField.Fieldname+']';
  dthexstr:=tstr;
  dtascstr:=astr;
  Unit2.Form2.Memo1.Text :=tstr;
  Unit2.Form2.CheckBox1.Checked :=true;
  Unit2.Form2.CheckBox1.Visible :=binv;
  Unit2.Form2.ShowModal ;
  if (blv or blmemo) and (not CheckBox1.Checked) then
  begin
    s:=Tstringstream.Create(Unit2.Form2.Memo1.Text);
    if dbgrid1.DataSource.DataSet.State =dsBrowse then
       dbgrid1.DataSource.DataSet.edit;
    s.Seek(0,0); 
    TBlobField(dbgrid1.SelectedField).LoadFromStream(s);
    s.Free;
  end
end;

procedure TForm1.DBGrid1DblClick(Sender: TObject);
begin
  N6Click(nil);
end;

procedure TForm1.TreeView1Collapsing(Sender: TObject; Node: TTreeNode;
  var AllowCollapse: Boolean);
  var r:trect;
      pp:Tpoint;

begin
  r:=Node.DisplayRect(true);
  Ttreeview(sender).Focused;
  windows.GetCursorPos(pp);
  pp:=Ttreeview(sender).ScreenToClient(pp);
  if (pp.X >=r.Left) and (pp.X<=r.Right ) and
     (pp.Y >=r.top) and (pp.Y<=r.bottom ) then
    AllowCollapse:=false
  else
    AllowCollapse:=true;
end;

procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
  var r:trect;
      pp:Tpoint;

begin
  r:=Node.DisplayRect(true);
  Ttreeview(sender).Focused;
  windows.GetCursorPos(pp);
  pp:=Ttreeview(sender).ScreenToClient(pp);
  if (pp.X >=r.Left) and (pp.X<=r.Right ) and
     (pp.Y >=r.top) and (pp.Y<=r.bottom ) then
    AllowExpansion:=false
  else
    AllowExpansion:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ADOConnection1.Connected :=false;
  self.StatusBar1.Panels[0].Text :='准备打开数据库连接';
  application.ProcessMessages ;
  ADOConnection1.ConnectionString:='Provider=MSDASQL.1;Password=9999999;Persist Security Info=True;User ID=sa;Data Source=LocalServer;Initial Catalog=icmeterdb';
  ADOConnection1.LoginPrompt :=false;
  try
    ADOConnection1.Connected :=true;
    self.StatusBar1.Panels[0].Text :='请稍候正在获取数据库结构信息.......';
    application.ProcessMessages ;
    ectractdbtree;
    self.StatusBar1.Panels[0].Text :='';
  except
    ADOConnection1.Connected :=false;
  end;
end;

procedure TForm1.sql1Click(Sender: TObject);
var tstr:string;
begin
  tstr:=SaveDialog1.Filter ;
  SaveDialog1.Filter:='sql|*.sql';
  SaveDialog1.FileName :='sql.sql';
  if SaveDialog1.Execute then
    gensqlbydset(SaveDialog1.FileName,adodataset1);
  SaveDialog1.Filter :=tstr;  
end;

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

procedure TForm1.N10Click(Sender: TObject);
begin
  exportstruct;
end;

procedure TForm1.HTML1Click(Sender: TObject);
var tstr:string;
begin
  tstr:=SaveDialog1.Filter ;
  SaveDialog1.Filter:='html文件|*.html';
  SaveDialog1.FileName :=currtable+'.html';
  if SaveDialog1.Execute then
    outtohtml(adodataset1,SaveDialog1.FileName);
  SaveDialog1.Filter :=tstr;  
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  label1.Caption:='作者：刘晋强'#$D#$A'[e-mail]';
  if apppub.appconfig.Datas['dbview','lastds']<>'' then
  begin
    ADOConnection1.LoginPrompt:=false;
    self.ADOConnection1.ConnectionString:=apppub.appconfig.Datas['dbview','lastds'];
    opends;
  end;
end;

procedure TForm1.Panel2Click(Sender: TObject);
begin
label1.Visible :=not label1.Visible;
end;

procedure TForm1.sql2Click(Sender: TObject);
var i:integer;
  sql,fields:string;
  function getcurrfields():string;
  var j:integer;
      tb:string;
  begin
    tb:= TreeView1.Selected.text+'.';
    for j:=0 to TreeView1.Selected.Count-1 do
    begin
      if j=0 then
        result:=tb+TreeView1.Selected.Item[j].Text
      else
        result:=result+','+tb+TreeView1.Selected.Item[j].Text;
    end;
  end;
begin
  try
    if TreeView1.Selected.SelectedIndex <>0 then
    begin
      sql:=TreeView1.Selected.Text;
      fields:=getcurrfields();
    end
    else
      sql:='';
  Unit3.Form3.Memo1.Text :='select '+fields+' from '+sql;
  if not Unit3.Form3.ShowModal =mrok then exit;
  sql:=Unit3.Form3.Memo1.Lines.Text;
  sql:=stringreplace(sql,#$D#$A,'',[rfreplaceall]);
  sql:=stringreplace(sql,#$9,' ',[rfreplaceall]);

  if sql='' then exit;
    ADODataSet1.Active :=false;
    currtable:='sql查询结果';
    if pos('SELECT',uppercase(sql))>0 then
      self.ADODataSet1.CommandText :=sql
    else
    begin
      try
        self.ADOConnection1.Execute(sql);
        messagebox(handle,'执行成功','提示',mb_ok);
      except
        messagebox(handle,'执行出错','提示',mb_ok or mb_iconerror);
      end;
      exit;
    end;
    ADODataSet1.Active:=true;
    for i:=0 to self.DBGrid1.Columns.Count -1 do
    if DBGrid1.Columns[i].Width >800 then
      DBGrid1.Columns[i].Width :=100;
  except
  end;
end;
procedure TForm1.onprocess(var message:Tmessage);
begin
  self.ProgressBar1.Visible:=(message.LParam>=0);
  self.ProgressBar1.Position:=message.LParam mod 100;
  application.ProcessMessages;
end;
procedure TForm1.sql3Click(Sender: TObject);
begin
  sqlbatchfrm.showmodal;
end;

end.