Fórum Reiniciar aplicativo Externo automatico #425670

procedure TForm1.VerificarExecucao;
var
  MutexHandle: THandle;
  hwind: HWND;

begin
  MutexHandle := CreateMutex(nil, TRUE, 'MysampleAppMutex');
  if MutexHandle <> 0 then
  begin
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      MessageBox(0, 'Este programa já está em execução!', '', mb_IconHand);
      CloseHandle(MutexHandle);
      hwind := 0;
      repeat
        hwind := Windows.FindWindowEx(0, hwind, 'TApplication', 'appexterno');
      until (hwind <> Application.Handle);
      if (hwind <> 0) then
      begin
        Windows.ShowWindow(hwind, SW_SHOWNORMAL);
        Windows.SetForegroundWindow(hwind);
      end;
      Halt;
end;
end;
end;

procedure TAutoStart_frm.CreateWin9xProcessList(List: TstringList);
var
  hSnapShot: THandle;
  ProcInfo: TProcessEntry32;
begin
  if List = nil then Exit;
  hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if (hSnapShot <> THandle(-1)) then
  begin
    ProcInfo.dwSize := SizeOf(ProcInfo);
    if (Process32First(hSnapshot, ProcInfo)) then
    begin
      List.Add(ProcInfo.szExeFile);
      while (Process32Next(hSnapShot, ProcInfo)) do
        List.Add(ProcInfo.szExeFile);
    end;
    CloseHandle(hSnapShot);
  end;

end;

procedure TAutoStart_frm.GetProcessList(var List: TstringList);
var
  ovi: TOSVersionInfo;
begin
  if List = nil then Exit;
  ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(ovi);
  case ovi.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List);
    VER_PLATFORM_WIN32_NT: CreateWin9xProcessList(List);
  end
end;

function TAutoStart_frm.EXE_Running(FileName: string; bFullpath: Boolean): Boolean;
var
  i: Integer;
  MyProcList: TstringList;
begin
  MyProcList := TStringList.Create;
  try
    GetProcessList(MyProcList);
    Result := False;
    if MyProcList = nil then Exit;
    for i := 0 to MyProcList.Count - 1 do
    begin
      if not bFullpath then
      begin
        if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then
          Result := True
      end
      else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True;
      if Result then Break;
    end;
  finally
    MyProcList.Free;
  end;
{exemplo de com usar}
procedure TAutoStart_frm.sBitBtn3Click(Sender: TObject);
begin
      if apache.Checked then
  if EXE_Running('apache.exe', False) then
      else
     ShellExecute(handle, 'open', 'Apache.bat', pchar(''),'Apache_Server', SW_SHOWNORMAL);
end;

function RunAndWait(Filename:String): BOOL;
var
  ProcessInfo: TProcessInformation;
  StartupInfo: TStartupInfo;
  ExitCode: DWORD;
begin
 try
  Result:= False;
   Assert(FileExists(FileName));
   GetStartupInfo(StartupInfo);
   UniqueString(FileName);
    if CreateProcess(nil, pChar(filename), nil, nil, False, 0, nil, nil, StartupInfo, ProcessInfo) then
      try
        WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
        Assert(Win32Check(GetExitCodeProcess(ProcessInfo.hProcess, ExitCode ) ));
        if ExitCode = NO_ERROR then
        Result:= True
      finally
        CloseHandle(ProcessInfo.hProcess);
        CloseHandle(ProcessInfo.hThread );
      end;
  except
 end;
end;

//declaracao do ponto inicio
label inicio;
begin
  //desliga o timer para nao ter que repetir o codigo continuamente
  TTimer(Sender).Enabled:=false;
  //marcamos aqui um ponto chamado de inicio
INICIO:
  showmessage('o programa sera executado');
  //coloque aqui o caminho do programa que vc quer chamar
if RunAndWait('C:\windows\system32\calc.exe') then
//volta ao ponto que marcamos como inicio
  goto inicio
 else showmessage('algum erro aconteceu')
end;

function ThreadProc(Param: Pointer): DWORD; stdcall;
begin
// coloque o codigo que vc uso dentro da timer aqui...
  form1.Timer1Timer(form1.Timer1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Handle,
  Id: DWORD;
begin
 Handle:= CreateThread(nil, 0, @ThreadProc, Self, 0, ID);
end;