delphi 如何实现程序的自动重启

Question

在线等待万分紧急！

Answer 1

额,我也不记得了.其实主要是延时函数怎么写.启动程序简单,直接写下路径+执行文件名就行了.google下吧.

Answer 2

一个简单应用程序的代码
program Project1;uses
  Forms,
  Unit1 in 'Unit1.pas' {Form4};{$R *.res}begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}end.
第一步:
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  //加一个重启标志
  Restart_Flag: Boolean = false;
implementation{$R *.dfm}end.第二步:
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;type
  TForm1 = class(TForm)
    //添加一个“重启”按钮
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  //加一个重启标志
  Restart_Flag: Boolean = false;
implementation{$R *.dfm}

//启动按钮的执行代码
procedure TForm4.Button1Click(Sender: TObject);
begin
  Restart_Flag := True;
  Close;
end;
end.第三步:program Project1;uses
  windows,
  Forms,
  Unit1 in 'Unit1.pas' {Form4};{$R *.res}
var
  lpStartupInfo: TStartupInfo;
  lpProcessInformation: TProcessInformation;
begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
  //添加重启代码
  if Not Restart_Flag then Exit; //不需要重启
  FillChar( lpStartupInfo,sizeof(lpStartupInfo),0);
  FillChar(lpProcessInformation,sizeof(lpProcessInformation),0);
  lpStartupInfo.cb:=sizeof(lpStartupInfo);
  if CreateProcess(nil,PChar(Application.ExeName),nil,nil,false,0,nil,nil,lpStartupInfo,lpProcessInformation) then
    begin
      CloseHandle(lpProcessInformation.hThread);
      CloseHandle(lpProcessInformation.hProcess);
    end;  
end.如果是在程序当中有使用互斥对象，也可以在Application.Initialize前初始化，Application.Run之后清理

Answer 3

 Application.MainFormOnTaskbar := True; 这句报错？

Answer 4

-----------------------------------program Monitor;//{$APPTYPE CONSOLE}uses
  Windows,
  SysUtils,
  ProcLib in 'ProcLib.pas';var
  Mutex : HWND;
begin
  Mutex := Windows.CreateMutex(nil, False,'Monitor');
  if (GetLastError = ERROR_ALREADY_EXISTS) or (Mutex = 0) then
    Exit;
    
  G_ExeFile := ExtractFilePath(ParamStr(0))+'myApp.exe';  while True do
  begin
    Sleep(2000);
    if ProcessRunning('myApp.exe') then
      Continue;    if G_ExeFile ='' then
      Continue;    Exec(G_ExeFile);
  end;
end.
--------------------------------------------------unit ProcLib;interface
uses
  Windows,SysUtils,PsApi,TlHelp32,shellapi;function ProcessRunning(ExeName : string) : Boolean;
procedure Exec(FileName : string);var G_ExeFile : string = '';implementationfunction ProcessFileName(PID: DWORD): string;
var
  Handle: THandle;
begin
  Result := '';
  Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
  if Handle <> 0 then
    try
      SetLength(Result, MAX_PATH);
        if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then
          SetLength(Result, StrLen(PChar(Result)))
        else
          Result := '';
    finally
      CloseHandle(Handle);
    end;
end;function ProcessRunning(ExeName : string) : Boolean;
var
  SnapProcHandle : THandle;
  NextProc: Boolean;
  ProcEntry: TProcessEntry32;
  ProcFileName : string;
begin
  Result := False;
  SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if SnapProcHandle=INVALID_HANDLE_VALUE then
    Exit;  try
    ProcEntry.dwSize := SizeOf(ProcEntry);
    NextProc := Process32First(SnapProcHandle,ProcEntry);    while NextProc do
    begin
      if ProcEntry.th32ProcessID <> 0 then
      begin
        ProcFileName := ProcessFileName(ProcEntry.th32ProcessID);
        if ProcFileName='' then
          ProcFileName := ProcEntry.szExeFile;        if SameText(ExtractFileName(ProcFileName),ExeName) then
        begin
          G_CAMManager_File := ProcFileName;
          Result := True;
          Break;
        end;
      end;
      NextProc := Process32Next(SnapProcHandle,ProcEntry);
    end;
  finally
    CloseHandle(SnapProcHandle);
  end;
end;procedure Exec(FileName : string);
var
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
begin
  FillChar(StartupInfo,SizeOf(StartupInfo),#0);
  StartupInfo.cb:=SizeOf(StartupInfo);
  StartupInfo.dwFlags:=STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow:= SW_SHOWDEFAULT;
  if not CreateProcess(
    PChar(FileName),nil,nil,nil,False,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
    nil,PChar(ExtractFilePath(FileName)),StartupInfo,ProcessInfo) then
      Exit;
  WaitForSingleObject(processinfo.hProcess,INFINITE);
end;end.

Answer 5

低版本当中没有这个，不要直接复制代码，使用颜色标识的部分是修改的。
可以记下先前程序的进程号（PID).

Answer 6

----------------------------------------
program KMonitor;//{$APPTYPE CONSOLE}uses
  Windows,
  SysUtils,
  ProcLib in 'ProcLib.pas';var
  Mutex : HWND;
  pidApp : DWORD;
begin
  Mutex := Windows.CreateMutex(nil, False,'KMonitor');
  if (GetLastError = ERROR_ALREADY_EXISTS) or (Mutex = 0) then
    Exit;  pidApp := 0;  while True do
  begin
    sleep(2000);
    if pidApp =0 then
      pidApp := GetProcessID('myApp.exe');    if (pidApp = 0) then
      Continue;    StopProcess(pidApp);
  end;
end.
----------------------------------------------------unit ProcLib;interface
uses
  Windows,SysUtils,PsApi,TlHelp32,shellapi;function GetProcessID(FileName : string) : DWORD;
procedure StopProcess(ProcessID : DWORD);
procedure WaitProcess(ProcessID : DWORD);implementationfunction ProcessFileName(PID: DWORD): string;
var
  Handle: THandle;
begin
  Result := '';
  Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
  if Handle <> 0 then
    try
      SetLength(Result, MAX_PATH);
        if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then
          SetLength(Result, StrLen(PChar(Result)))
        else
          Result := '';
    finally
      CloseHandle(Handle);
    end;
end;function GetProcessID(FileName : string) : DWORD;
var
  SnapProcHandle : THandle;
  NextProc: Boolean;
  ProcEntry: TProcessEntry32;
  ProcFileName : string;
begin
  Result := 0;
  SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if SnapProcHandle=INVALID_HANDLE_VALUE then
    Exit;  try
    ProcEntry.dwSize := SizeOf(ProcEntry);
    NextProc := Process32First(SnapProcHandle,ProcEntry);    while NextProc do
    begin
      if ProcEntry.th32ProcessID <> 0 then
      begin
        ProcFileName := ProcessFileName(ProcEntry.th32ProcessID);
        if ProcFileName='' then
          ProcFileName := ProcEntry.szExeFile;        if SameText(ExtractFileName(ProcFileName),FileName) then
        begin
          Result := ProcEntry.th32ProcessID;
          Break;
        end;
      end;
      NextProc := Process32Next(SnapProcHandle,ProcEntry);
    end;
  finally
    CloseHandle(SnapProcHandle);
  end;
end;procedure StopProcess(ProcessID : DWORD);
var
  Handle: THandle;
begin
  Handle := OpenProcess(PROCESS_TERMINATE or PROCESS_VM_READ, False, ProcessID);
  if Handle <> 0 then
    try
      TerminateProcess(Handle,0);
      WaitForSingleObject(Handle,INFINITE);
    finally
      CloseHandle(Handle);
    end;
end;procedure WaitProcess(ProcessID : DWORD);
var
  Handle: THandle;
begin
  Handle := OpenProcess(SYNCHRONIZE, False, ProcessID);
  if Handle <> 0 then
    try
      WaitForSingleObject(Handle,INFINITE);
    finally
      CloseHandle(Handle);
    end;
end;
end.

Answer 7

Monitor是运行一个程序
KMonitor是关闭一个程序procedure WaitProcess(ProcessID : DWORD);
等待一个程序运行结束procedure StopProcess(ProcessID : DWORD);
结束一个程序

Answer 8

有没有考虑过TerminateProcess可能带来的后果？

Answer 9

如果只是为了实现功能不考虑可能的情况，一个ShellExecute或者WinExec等之类的执行之后再退出自身的进程，当然简单。

Answer 10

WinExec('Pro.exe',SW_SHOW);
Application.Terminate;

Answer 11

Application.Terminate是比TerminateProcess好一些
但是自己启动自己，会造成某一时刻有两个实例，也容易引起资源冲突折衷的做法是当前进程自己正常退出，
另一个进程等待当前进程结束，再创建新的进程

Answer 12

可以用下面的步骤：A程序自己正常退出，退出前运行B程序，B程序等待A程序运行结束，B程序启动A程序

Answer 13

既然要用A启动B，为什么不直接启动A的新实例。任何的互斥对象之类的，在Application.Run;执行完之后，从设计逻辑上都应该释放了吧？还有什么冲突？

Answer 14

自己启动新实例，需要程序先释放所有与程序启动冲突的独占资源，然后创建自己的新实例，接着再退出。
如果设计逻辑上能保证在创建新实例以前，都释放了所有独占资源，那当然可以自己启动自己。事实上并不是所有的程序都有良好设计，一些资源的释放还都是靠系统在Application.Terminate时释放，
比如数据库的connection,不见得所有人都有Application.Terminate以前close的习惯，
还有就是一些监听端口的程序也是这样。很多程序是在运行时打开数据库连接，并做一些读写操作，这种情况下，遇到类似Access这些要求独占的资源，
前一个实例还没有Application.Terminate或者正在退出当中，后一个实例已经开始运行，这时就会有冲突不管是自己启动自己，还是用另一个程序启动，都是要有一定前提条件的，
哪种都是可行的，哪种都不是万灵丹

Answer 15

大头鸟说得对。那样会同时出现两个进程，即可能出现资源冲突，如UDPServer端口监听，如果你的程序有设置不能同时启动两个进程的化，这种方法是不能达成楼主的目的的。

Answer 16

做成两个程序的切换,当A启动时做你要的检查,我用自动升级给你说嘛.
主程序的project单元中做一个检测函数,叛定有没有升级程序,如果有运行升级程序update
同时terminate主程序
update从网上下载了主程序覆盖本地主程序后,update再调用主程序,同时terminate update程序.
就这么简单.

Answer 17

Learn it again. Mark again.

Answer 18

program Project1;uses
  windows,
  shellapi,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};{$R *.res}begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
  if Not Restart_Flag then Exit; //不需要重启 
  ShellExecute(getdesktopwindow,'open', PChar(Application.ExeName), nil, nil, SW_SHOWNORMAL) ;
end.
:)

Answer 19

一个简单的批处理文件搞定
@echo off
:deleteself
del C:\aa.exe
if exist C:\aa.exe goto deleteself
copy d:\aa.exe C:\ /y
C:\aa.exe

Answer 20

1、做成常驻程序，不退出，最小化到托盘区，用TIMER定时起动
2、写另外一个B程序，负责定时起动A程序，当然B程序也要常驻
3、用WIN的定时任务，定时起动

Answer 21

程序重启，我就是
Application.MainForm.Close;
ShellExecute(Application.Handle,'open',PChar(AppName),nil,nil,SW_SHOWNORMAL);
这两句代码就可以了

Answer 22

简单的调用ShellExecute启动自己一定会同时出现两个进程，有时不可取。

Answer 23

受大家的启发，正好也需要，实现了另开进程的方式。之前一直是进程内重启动，可是有两个问题：
1、由于某些bpl设计不良，虽然有unloadpackage，但还是可能没有释放某些资源，不能真正与第一次登陆的初始环境完全一致；
2、delphi本身的package机制有个缺陷，间接载入的bpl，其中的没有直接引用到的unit，其initialization部分不会被执行。
=======================
用于重启动的进程，等到传入的进程确实退出后，再执行传入的命令行
=======================
program tmRestart;//{$APPTYPE CONSOLE}uses
  Windows,
  Dialogs,
  Classes,
  SysUtils;procedure StopProcess(ProcessID : DWORD);
var
  Handle: THandle;
begin
  Handle := OpenProcess(PROCESS_TERMINATE or PROCESS_VM_READ, False, ProcessID);
  if Handle <> 0 then
    try
      TerminateProcess(Handle,0);
      WaitForSingleObject(Handle,INFINITE);
    finally
      CloseHandle(Handle);
    end;
end;var
  vProcessID:integer;
  vCommandLine:string;
  vList:TStringList;
  vHandle:THandle;
begin
  vList:=TStringList.Create;
  try
    vList.Delimiter:=' ';
    vList.CommaText:=Windows.GetCommandLine;
    if vList.Count<3 then exit;
    vProcessID:=StrToInt(vList[1]);
    vCommandLine:=vList[2];
  finally
    vList.Free;
  end;
  //ParamStr函数有bug，会去掉任何的双引号，当文件夹有空格会出问题
  //如'"D:\Shanghai China\A.exe" "D:\Shanhai China\A.ini"'，会得到'D:\Shanghai China\A.exe D:\Shanhai China\A.ini'
  //vProcessID:=StrToInt(ParamStr(1));
  //vCommandLine:=ParamStr(2);
  repeat
    Sleep(100);
    vHandle := Windows.OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, vProcessID);
    if vHandle<>0 then CloseHandle(vHandle);
  until vHandle=0;  //不要强制终止，会导致单元的finialization执行不到
  //StopProcess(vProcessID);
  Windows.WinExec(PChar(vCommandLine),SW_Show);
end.=====================================
主程序
ExitProgram是一个boolean变量，主窗体的Logout功能把它设为false
=====================================
program ERP2009;
{$R *.RES}
function WinExecAndWait32(AExeFile,AParams:WideString;AIsShowGUI:Boolean;AIsWaitingResult:Boolean):cardinal;
var
  ExecInfo:   TShellExecuteInfoW;
  ucmdShow:integer;
begin
  Result:=$FFFF;
  if AIsShowGUI then ucmdShow:=SW_Show
  else ucmdShow:=SW_Hide;
  ZeroMemory(@ExecInfo,SizeOf(ExecInfo));
  ExecInfo.cbSize   :=   SizeOf(ExecInfo);
  ExecInfo.fMask    :=   SEE_MASK_NOCLOSEPROCESS;
  ExecInfo.lpVerb   :=   'open';
  ExecInfo.lpFile   :=   PWideChar(AExeFile);
  ExecInfo.lpParameters:=PWideChar(AParams);
  ExecInfo.Wnd      :=   0;
  ExecInfo.nShow    :=   ucmdShow;
  if ShellExecuteExW(@ExecInfo) then
  begin
    Result:=0;
    if AIsWaitingResult then
    begin
      if WaitforSingleObject(ExecInfo.hProcess,INFINITE)=WAIT_OBJECT_0 then
        GetExitCodeProcess(ExecInfo.hProcess,Result);
    end;
  end;
end;procedure RestartProgramme(AMonitorFileName:WideString);
var
  i:integer;
  //S:string;
  CommandLine:WideString;
  vExeFile,vParam:WideString;
begin
  CommandLine:='';
  for i:=0 to ParamCount do
  begin
    if CommandLine<>'' then CommandLine:=CommandLine+' ';
    CommandLine:=CommandLine+AnsiQuotedStr(ParamStr(i),'"');
  end;
  {S:=AnsiQuotedStr(ExtractFilePath(Application.ExeName)+'KMonitor.exe','"')+' '+
     InttoStr(Windows.GetCurrentProcessID)+' '+
     AnsiQuotedStr(CommandLine,'"');
  }
  vExeFile:=AnsiQuotedStr(ExtractFilePath(Application.ExeName)+AMonitorFileName,'"');
  vParam:=InttoStr(Windows.GetCurrentProcessID)+' '+AnsiQuotedStr(CommandLine,'"');  //用WinExec会感觉卡
  //Windows.WinExecW(PWideChar(S),SW_Hide);
  WinExecAndWait32(vExeFile,vParam,false,false);
end;begin
  //也许这里有检查只能启动一个进程的代码
  //........
  ExitProgram:=true;
  Application.Initialize;
  Application.CreateForm(TIDEMainForm, IDEMainForm);
  Application.Run;
  if not ExitProgram then
    RestartProgramme('tmRestart.exe');
end.