Запустить приложение и подождать

Материал из DRKB

Запустить приложение и подождать[править | править код]

function ExecuteFile(FileName, Params, WorkingDir: string; Wait: Boolean): Integer;
var
  buffer: array[0..511] of Char;
  TmpStr: string;
  i: Integer;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  ext, key, FName, path: string;
  ExitCode: Cardinal;
begin
  if WorkingDir <> '' then
    ChDir(WorkingDir);
  ext := LowerCase(ExtractFileExt(FileName));
  path := ExtractFilePath(FileName);
  if ext <> '.exe' then
  begin
    with TRegistry.create do
    begin
      try
        RootKey := HKEY_CLASSES_ROOT;
        OpenKey(ext, False);
        Key := ReadString('');
        CloseKey;
        OpenKey(key + '\Shell\open\command', False);
        key := ReadString('');
        FName := ExtractFileName(key);
        if Pos('/', fname) > 0 then
          FName := Copy(FName, 1, Pos('/', FName)-1);
        FName := StringReplace(FName, '%1', '', [rfReplaceAll, rfIgnoreCase]);
        if Pos(' ', FileName) > 0 then
          FileName := '"' + Filename + '"';
        TmpStr := ExtractFilePath(key) + FName + ' ' + FileName;
        if Params <> '' then
          TmpStr := TmpStr + ' ' + Params;
        Closekey;
      finally
        Free;
      end;
    end;
  end
  else
  begin
    TmpStr := FileName;
    TmpStr := TmpStr + ' ' + Params;
  end;
  StrPCopy(buffer, TmpStr);
  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_SHOWNORMAL;
  if CreateProcess(nil, buffer, nil, nil, False, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
  begin
    if Wait then
    begin
      while WaitforSingleObject(ProcessInfo.hProcess, 200) = WAIT_TIMEOUT do
        Application.ProcessMessages;
      GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
    end;
  end
  else
    Result := GetLastError();
end;


Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
ID: 02150