runwaitexe.pas

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

//在线程中运行并等待可执行文件运行完毕

unit RunWaitEXE;

interface

uses
  Classes,windows,SysUtils,adodb,ActiveX,Dialogs;

type
  trun = procedure;

  TRunWait = class(TThread)
  public
    constructor Create(exefile:string;startrun,okrun,endrun,TUrun:trun);
  private
    Fexefile:STRING;
    Fstartrun,Fokrun,Fendrun,FTUrun:trun;
  protected
    procedure Execute; override;
  end;

  Tokrun = class(TThread)
  public
    constructor Create(okrun,TUrun:trun);
  private
    Fdoend:boolean;
    Fokrun,FTUrun:trun;
  protected
    procedure Execute; override;
  end;

  Tendrun = class(TThread)
  public
    constructor Create(endrun:trun);
  private
    Fendrun:trun;
  protected
    procedure Execute; override;
  end;

var
dwProcessID:DWORD;
cname:string;
ADOCon: TADOConnection;
runw:TRunwait;
okrunThread:Tokrun;
endrunThread:Tendrun;

procedure runexexfile(exefile:string;startrun,okrun,endrun,TUrun:trun);
procedure init;
procedure uninit;

implementation

uses Myfuctions, strinfo, mian;

procedure runexexfile;
begin
  runw:=TRunWait.Create(exefile,startrun,okrun,endrun,TUrun);
end;

procedure init;
begin
  ADOCon:=TADOConnection.Create(nil);
  ADOCon.ConnectionTimeout:=3;
  ADOCon.CommandTimeout:=3;
  ADOCon.LoginPrompt:=false;
end;

procedure uninit;
begin
  ADOCon.Free;
  ADOCon:=nil;
end;


//------------------------------------------------------------------------------
constructor TRunWait.Create;
begin
  inherited Create(False);
  Fstartrun:=startrun;
  Fokrun:=okrun;
  Fendrun:=endrun;
  FTUrun:=TUrun;
  Fexefile:=exefile;
  FreeOnTerminate := True;
end;

procedure TRunWait.Execute;
var
  bCreateProcess: boolean;
  lpStartupInfo: TStartupInfo;
  lpProcessInformation: TProcessInformation;
begin
  ZeroMemory(@lpStartupInfo,SizeOf(lpStartupInfo));
  lpStartupInfo.cb := SizeOf(TStartupInfo);
  {lpStartupInfo.wShowWindow:=SW_HIDE;
  lpStartupInfo.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;  }

  //开始运行
  Fstartrun;

  //创建进程
  bCreateProcess := CreateProcess(nil,pchar(Fexefile),nil, nil, True,NORMAL_PRIORITY_CLASS, nil,nil,lpStartupInfo, lpProcessInformation);

  if bCreateProcess then
    begin
      //保存ID
      dwProcessID:=lpProcessInformation.dwProcessId;
      //监听
      okrunThread:=Tokrun.Create(Fokrun,FTUrun);
      endrunThread:=Tendrun.Create(Fendrun);
    end
  else
    begin
      Fendrun;
    end;
end;


//------------------------------------------------------------------------------
constructor Tokrun.Create;
begin
  inherited Create(False);
  Fokrun:=okrun;
  Fdoend:=false;
  FTUrun:=TUrun;
  FreeOnTerminate := True;
  main.Addlog('创建 启动成功 监视线程',0);
end;

procedure Tokrun.Execute;
  function GT:integer; //GetTime
  begin
    Result:=trunc(now*24*60*60)
  end;
  function TOU(S:integer):boolean; //TimeOut
  begin
    Result:=(GT-S)>ConTimeout;
  end;
var
conok:boolean;
t:integer;
begin
  main.Addlog('启动成功 监视线程开始',0);
  t:=GT;
  conok:=false;

  CoInitialize(nil);

  ADOCon.ConnectionString:=format(constr,[cname]);
  while (not conok) and (not TOU(t)) and (not Fdoend) do
    begin
      try
        ADOCon.Close;
        ADOCon.Open;
      except
      end;
      if ADOCon.Connected then conok:=true;
    end;
  if conok then Fokrun;
  if TOU(t) then FTUrun;
  if Fdoend then FTUrun;
  main.Addlog('启动成功 监视线程结束',0);
end;

//------------------------------------------------------------------------------
constructor Tendrun.Create;
begin
  inherited Create(False);
  Fendrun:=endrun;
  FreeOnTerminate := True;
  main.Addlog('创建 结束 监视线程',0);
end;

procedure Tendrun.Execute;
var
h:dword;
begin
  main.Addlog('结束 监视线程开始',0);
  h:=OpenProcess(PROCESS_ALL_ACCESS,False,dwProcessID);
  WaitForSingleObject(h, INFINITE);
  //WaitForSingleObject(ProcessID, INFINITE);
  okrunThread.Fdoend:=true;
  Fendrun;
  main.Addlog('结束 监视线程结束',0);
end;

end.