mian.pas

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

unit mian;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, OleCtrls, SHDocVw, DB,
  ADODB, registry, inifiles, Menus, ImgList, TrayIcon, CoolTrayIcon;

type
  Tmain = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    StatusBar1: TStatusBar;
    TabSheet4: TTabSheet;
    RichEdit1: TRichEdit;
    RichEdit2: TRichEdit;
    Timer1: TTimer;
    ImageList1: TImageList;
    Image1: TImage;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    TabSheet2: TTabSheet;
    Image2: TImage;
    Panel2: TPanel;
    ListView1: TListView;
    Panel3: TPanel;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton8: TSpeedButton;
    procedure Addlog(str:string;c:integer);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RichEdit1Enter(Sender: TObject);
    procedure RichEdit2Enter(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure gettablelist;
    procedure SpeedButton8Click(Sender: TObject);
    procedure ListView1Resize(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure TabSheet2Show(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
  private
    { Private declarations }
  public
    reg: tregistry;
    ini: tinifile;
    mesql:boolean;
  end;

var
  main: Tmain;

implementation

uses RunWaitEXE, Myfuctions, strinfo, runsql_u, adddb_u;

{$R *.dfm}

procedure startrun;
begin
  main.BitBtn1.Enabled:=false;
  main.BitBtn2.Enabled:=true;
  main.Addlog('服务器启动中',0);
  main.mesql:=true;
end;

procedure okrun;
begin
  main.Addlog('服务器就绪,等待连接',1);
  main.Panel2.Enabled:=true;
  main.ini.WriteString('Run','path',Formatfilelink('$PP'));
end;

procedure endrun;
begin
  main.BitBtn1.Enabled:=true;
  main.BitBtn2.Enabled:=false;
  main.Panel2.Enabled:=false;
  main.ListView1.Items.Clear;
  main.Addlog('服务器停止运行',2);
end;

procedure TUrun;
begin
  main.Addlog('服务器启动超时',2);
end;

procedure Tmain.Addlog(str:string;c:integer);
begin
  case c of
    0:RichEdit1.SelAttributes.Color:=clblack;
    1:RichEdit1.SelAttributes.Color:=clblue;
    2:RichEdit1.SelAttributes.Color:=clred;
  end;
  self.RichEdit1.Lines.Add(formatdatetime('"["mm"/"dd" "hh":"nn":"ss"] "',now)+str);
  application.ProcessMessages;
end;

procedure Tmain.BitBtn1Click(Sender: TObject);
begin
winexec(pchar(Formatfilelink('Regedit -s "$PPserver\config.Sui"')),SW_HIDE);
runexexfile(Formatfilelink('$PPserver\sqlservr.exe'),startrun,okrun,endrun,TUrun);
end;

procedure Tmain.FormCreate(Sender: TObject);
begin
init;

reg:=tregistry.create;

ini:=tinifile.Create(Formatfilelink('$PPdata.ini'));

//最后运行时间
ini.WriteDateTime('Run','Lastruntime',now);

if not ini.ReadBool('Run','Firstrun',false) then
  begin
    showmessage('您是第一次运行,请一定要仔细看好说明。');
    ini.WriteBool('Run','Firstrun',true);
    TabSheet4.Show;
  end;
  
end;

procedure Tmain.FormDestroy(Sender: TObject);
begin
ini.Free;
reg.Free;
uninit;
end;

procedure Tmain.BitBtn2Click(Sender: TObject);
var
h:dword;
begin
h:=OpenProcess(PROCESS_TERMINATE,False,dwProcessID);
TerminateProcess(h,$FFFFFFFF);
end;

procedure Tmain.Timer1Timer(Sender: TObject);
var
h:dword;
p1,p2:string;
tostop:boolean;
begin
ttimer(sender).Enabled:=false;

//默认不停止
tostop:=false;

//说明文件
richedit2.Lines.LoadFromFile(Formatfilelink('$PPReadMe.rtf'));

//机器名
cname:=hostname;
main.Addlog(format('取得配置信息',[cname]),0);

h:=Getpid('sqlservr.exe');
dwProcessID:=h;

if h<>0 then
  begin
    //已经启动 修改按钮状态 给提示信息
    main.Addlog('已经有服务器在使用',2);
    main.BitBtn1.Enabled:=false;
    main.BitBtn2.Enabled:=true;

    //对比是不是自己的SQL
    p1:= UpperCase(getpexefile(h));
    p2:= UpperCase(Formatfilelink('$PPserver\sqlservr.exe'));

    if p1<>p2 then
      begin
        //如果是自己的DQL
        main.Addlog('目前控制的不是您的 SQL Server',1);
        main.Addlog('Exe = '+p1,1);
        main.Addlog('您可以继续管理它',1);
        main.Addlog('也可以结束它 启动您的版本.',1);
        showmessage('目前您的机器有 SQL Server 在运行'+#13+'请备份注册表:HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\MSSQLServer'+#13+'下所有东西。'+#13+'run exe = '+p1+#13+'you exe = '+p2);
        mesql:=false;

        //参数处理
        if ini.ReadBool('Run_parameter','run_stop_else_server',false) then
          begin
            main.Addlog('参数指示，停止非自己的SQL',2);
            BitBtn2Click(nil);
            tostop:=true;
          end;
      end
    else
      begin
        main.Addlog('那是您的 SQL Server.',0);
        main.Addlog('切入管理状态.',0);
        
        mesql:=true;

        //参数处理
        if ini.ReadBool('Run_parameter','run_stop_me_server',false) then
          begin
            main.Addlog('参数指示，停止自己的SQL',2);
            BitBtn2Click(nil);
            endrun;
            tostop:=true;
          end;
      end;

      if not tostop then
        begin
          okrunThread:=Tokrun.Create(okrun,TUrun);
          endrunThread:=Tendrun.Create(endrun);
        end;
  end
else
  begin
    //merun:=true;
  end;

//参数处理
if ini.ReadBool('Run_parameter','run_start_server',false) then
  begin
    if BitBtn1.Enabled then
      begin
        main.Addlog('参数指示，启动SQL',2);
        BitBtn1Click(nil);
      end;
  end;
end;

procedure Tmain.BitBtn3Click(Sender: TObject);
begin
close;
end;

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

procedure Tmain.RichEdit1Enter(Sender: TObject);
begin
  TabSheet1.SetFocus;
end;

procedure Tmain.RichEdit2Enter(Sender: TObject);
begin
  TabSheet4.SetFocus;
end;

procedure Tmain.SpeedButton1Click(Sender: TObject);
begin
winexec(pchar(Formatfilelink('$PPisqlw\isqlw.exe')),SW_NORMAL);
end;

procedure Tmain.gettablelist;
var
q1,q2:tadoquery;
begin
  q1:=tadoquery.Create(nil);
  q1.Connection:=RunWaitEXE.ADOCon;

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

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

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

  listview1.Visible:=false;
  listview1.Items.Clear;
  
  while not q1.Eof do
    begin
      with listview1.Items.Add do
        begin
          caption:=q1.Fields[0].asstring;
          subitems.Clear;
          subitems.Add('?');
          subitems.Add('?');
          try
            q2.SQL.Text:='use '+q1.Fields[0].asstring;
            q2.ExecSQL;

            q2.SQL.Text:='select filename from sysfiles order by fileid';
            q2.Open;
            q2.First;
            subitems[0]:=trim(q2.Fields[0].AsString);
            q2.Next;
            subitems[1]:=trim(q2.Fields[0].AsString);
            q2.Close;
          except
          end;
        end;
      q1.Next;
    end;
  listview1.Visible:=true;
  q1.Close;
  q1.Free;

  q2.Free;
end;

procedure Tmain.SpeedButton8Click(Sender: TObject);
begin
  gettablelist;
end;

procedure Tmain.ListView1Resize(Sender: TObject);
var
w:integer;
begin
  w:=(Tlistview(sender).Width-90) div 2;
  listview1.Columns[1].Width:=w;
  listview1.Columns[2].Width:=w;
end;

procedure Tmain.SpeedButton4Click(Sender: TObject);
begin
Trunsql.Create(application).Show;
end;

procedure Tmain.TabSheet2Show(Sender: TObject);
begin
if Panel2.Enabled then gettablelist;
end;

procedure Tmain.SpeedButton2Click(Sender: TObject);
begin
Tadddb.Create(application).Show;
gettablelist;
end;

procedure Tmain.SpeedButton3Click(Sender: TObject);
var
q1:tadoquery;
begin
  if listview1.SelCount=1 then
    begin
      if MessageDlg('您确认要分离数据库：'+listview1.Selected.Caption+' 么？',mtConfirmation,[mbYes, mbNo],1)=6 then
        begin
          q1:=tadoquery.Create(nil);
          q1.Connection:=RunWaitEXE.ADOCon;
          q1.SQL.Text:=format('EXEC sp_detach_db ''%s'', ''true''',[listview1.Selected.Caption]);
          try
            q1.ExecSQL;
            showmessage('数据库分离完毕');
          except
            on e:exception do
              begin
                showmessage(e.Message);
              end;
          end;
        end;
    end;
  gettablelist;
end;

end.