runsql_u.pas

实现了在开发的数据库程序中打包加入SQL数据库驱动并允许在安装程序服务器端时安装SQL数据库 这样可以不需要实施人员或客户单独安装SQL数据库程序

unit runsql_u;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ExtCtrls, Grids, DBGrids, DB, ADODB, ComObj;

type
  Trunsql = class(TForm)
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Splitter1: TSplitter;
    Memo1: TMemo;
    Panel1: TPanel;
    ComboBox1: TComboBox;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    ComboBox2: TComboBox;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    ComboBox3: TComboBox;
    SpeedButton8: TSpeedButton;
    procedure SpeedButton6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public

  end;

var
  runsql: Trunsql;

implementation

uses RunWaitEXE, Myfuctions;

{$R *.dfm}

procedure Trunsql.FormCreate(Sender: TObject);
begin
adoquery1.Connection:=RunWaitEXE.ADOCon;
SpeedButton6Click(nil);
SpeedButton8Click(nil);
end;

procedure Trunsql.SpeedButton6Click(Sender: TObject);
var
q1:tadoquery;
begin
  ComboBox2.Items.Clear;

  q1:=tadoquery.Create(nil);
  q1.Connection:=RunWaitEXE.ADOCon;

  q1.SQL.Text:='use master';
  q1.ExecSQL;

  q1.SQL.Text:='select name from sysdatabases order by dbid';
  q1.Open;
  q1.First;

  while not q1.Eof do
    begin
      ComboBox2.Items.Add(q1.Fields[0].asstring);
      q1.Next;
    end;

  q1.Close;
  q1.Free;

  ComboBox2.ItemIndex:=0;
  ComboBox2Change(ComboBox2);
end;

procedure Trunsql.ComboBox2Change(Sender: TObject);
var
q1:tadoquery;
begin
  ComboBox3.Items.Clear;

  q1:=tadoquery.Create(nil);
  q1.Connection:=RunWaitEXE.ADOCon;

  q1.SQL.Text:='use '+TComboBox(sender).Text;
  q1.ExecSQL;

  q1.SQL.Clear;
  q1.SQL.add('select CASE xtype when ''S'' then ''系统'' when ''U'' then ''用户'' when ''V'' then ''视图'' when ''p'' then ''过程''  end as type, name from sysobjects');
  q1.SQL.Add('where xtype=''P'' or xtype=''S'' or xtype=''U'' or xtype=''V'' order by CASE xtype when ''S'' then ''1'' when ''U'' then ''0'' when ''V'' then ''2'' when ''p'' then ''3'' end ,name');
  q1.Open;
  q1.First;

  while not q1.Eof do
    begin
      ComboBox3.Items.Add(q1.Fields[0].asstring+' '+q1.Fields[1].asstring);
      q1.Next;
    end;

  q1.Close;
  q1.Free;

  ComboBox3.ItemIndex:=0;
  ComboBox3Change(ComboBox3);
end;

procedure Trunsql.ComboBox3Change(Sender: TObject);
var
t,n,text:string;
begin
text:=TComboBox(sender).Text;
t:=copy(text,1,4);
n:=copy(text,6,length(text)-5);

if (t='用户')or(t='系统')or(t='视图') then
  begin
    memo1.Lines.Clear;
    memo1.Lines.Add('select *');
    memo1.Lines.Add('from ['+n+']');
    SpeedButton4Click(nil);
  end;
if (t='过程') then
  begin
    memo1.Lines.Clear;
    memo1.Lines.Add('Exec ['+n+']');
  end;
end;

//------------------------------------------------------------------------------

//查询
procedure Trunsql.SpeedButton4Click(Sender: TObject);
begin
try
  adoquery1.Close;
  adoquery1.SQL.Text:=memo1.Lines.Text;
  adoquery1.Open;
except
  on e:exception do
    begin
      showmessage(e.Message);
    end;
end;
end;

//运行
procedure Trunsql.SpeedButton5Click(Sender: TObject);
begin
try
  adoquery1.Close;
  adoquery1.SQL.Text:=memo1.Lines.Text;
  showmessage(inttostr(adoquery1.ExecSQL)+' 行被影响。');
except
  on e:exception do
    begin
      showmessage(e.Message);
    end;
end;
end;

//------------------------------------------------------------------------------
//CLEAR

procedure Trunsql.SpeedButton1Click(Sender: TObject);
begin
memo1.Lines.Clear;
end;

//------------------------------------------------------------------------------
//TO Excel

procedure Trunsql.SpeedButton2Click(Sender: TObject);
var
 CovExcel:Variant;
 WorkBook:Variant;
 WorkSheet:Variant;
 x,y:integer;
 title:string;
begin
  //判断是否打开 ADOQUERY
  if not adoquery1.Active then
    begin
      showmessage('没有查询结果可使用');
      exit;
    end;

  //创建OLE
  try
    CovExcel := CreateOleObject('Excel.Application');
    WorkBook := CovExcel.WorkBooks.Add;
    WorkSheet := WorkBook.WorkSheets[1];
  except
    showmessage('您的机器可能没安 Excel');
    exit;
  end;

  //合并第一行
  WorkSheet.Range['A1:'+Chr((adoquery1.FieldCount- 1) + 65) + '1'].Merge(True);

  //标题
  WorkSheet.Cells[1, 1].Value:='标题';
  if memo1.Lines.Count>1 then
    begin
      title:=memo1.Lines[0];
      if copy(title,1,4)='--T=' then
        begin
          WorkSheet.Cells[1, 1].Value:=copy(title,5,length(title)-4);
        end;
    end;
  WorkSheet.Cells[1, 1].HorizontalAlignment := -4108;

  //字段
  y:=2;
  for x:=1 to adoquery1.FieldCount do
    begin
      WorkSheet.Cells[y, x].Value:=adoquery1.Fields[x-1].FullName;
      WorkSheet.Cells[y, x].Borders.LineStyle := 1;
    end;
  WorkSheet.Rows[y].Font.FontStyle:='加粗';
  WorkSheet.Rows[y].Font.size:=11;

  adoquery1.First;
  y:=2;
  while not adoquery1.Eof do
    begin
      inc(y);
      WorkSheet.Rows[y].Font.size:=11;
      for x:=1 to adoquery1.FieldCount do
        begin
          WorkSheet.Cells[y, x].Value:=adoquery1.Fields[x-1].AsString;
          WorkSheet.Cells[y, x].Borders.LineStyle := 1;
        end;
      adoquery1.Next;
    end;

  WorkSheet.Cells[3, 1].SELECT;
  
  CovExcel.Visible:=true;
end;

//------------------------------------------------------------------------------
//脚本

//刷新脚本列表
procedure Trunsql.SpeedButton8Click(Sender: TObject);
var
filename:string;
sr: TSearchRec;
begin
  combobox1.Items.Clear;
  combobox1.Items.Add('-<Sql Script>-');
  if FindFirst(Formatfilelink('$PPSqlScript\*.txt'),faAnyFile-faDirectory,sr) = 0 then
    repeat
      filename:=copy(sr.name,1,length(sr.name)-4);
      combobox1.Items.Add(filename);
    until FindNext(sr)<>0;
  FindClose(sr);
  combobox1.ItemIndex:=0;
end;

//更换脚本
procedure Trunsql.ComboBox1Change(Sender: TObject);
begin
if tcombobox(sender).Text<>'-<Sql Script>-' then
  begin
    memo1.Lines.LoadFromFile(Formatfilelink('$PPSqlScript\'+tcombobox(sender).Text+'.txt'));
    SpeedButton4Click(nil);
  end;
end;

//保存脚本
procedure Trunsql.SpeedButton3Click(Sender: TObject);
var
jsname:string;
begin
  jsname:=Dialogs.InputBox('脚本','请输入SQL脚本名称','');
  if jsname<>'' then
    begin
      try
        memo1.Lines.SaveToFile(Formatfilelink('$PPSqlScript\'+jsname+'.txt'));
      except
        showmessage('保存文件出错');
      end;
      SpeedButton8Click(nil);
    end;
end;

//删除脚本
procedure Trunsql.SpeedButton7Click(Sender: TObject);
begin
  if MessageDlg('您确认要删除脚本：'+ComboBox1.Text+' 么？',mtConfirmation,[mbYes, mbNo],1)=6 then
    begin
      DeleteFile(pchar(Formatfilelink('$PPSqlScript\'+ComboBox1.Text+'.txt')));
      SpeedButton8Click(nil);
    end;
end;

procedure Trunsql.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
end;

end.