Delphi. CreateProcess. Запуск UniGUI сервера

В данной статье посмотрим как запустить UniGUI сервер (UniGUI_mp3.exe) из внешней программы. В принципе ничего сложного, но с CreateProcess, которым я пользовался для запуска сервера много сюрпризов. Перед тем как он у меня заработал, пришлось перелопатить документацию MSDN, блоги и форумы программистов.

Вот код, который получился у меня в итоге.

//------------------------Start UniServer-------------------------------------------

procedure TMainForm.StartUniServer;
var
  UniServerPath: string;
  MyApplication: string;
  MyParams: string;
  MyCmdLine: string;


  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
  ExitCode: Cardinal; //код завершения
  
begin
// Запускаем UniGUI сервер

      ZeroMemory(@StartupInfo,SizeOf(StartupInfo));
      StartupInfo.cb := SizeOf(StartupInfo);
      StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
      StartupInfo.wShowWindow :=SW_SHOWNORMAL;//SW_SHOWDEFAULT; // SW_MINIMIZE;
   

     UniServerPath:=ExtractFileDir(Application.ExeName)+'\UniGUI_mp3.exe';
     //'C:\DELPHI\MyStudyProjects\300_UniGUI_audio\Win32\Debug\UniGUI_mp3.exe';

     MyApplication :=UniServerPath; 
     MyParams      := '';
     MyCmdLine     := Format('"%s" %s', [MyApplication, MyParams]);


     SetLastError(ERROR_INVALID_PARAMETER); // Для обхода бага по совету gunsmoker
     //http://www.gunsmoker.ru/2014/03/createprocessfailwithsuccess.html

    if Win32Check(CreateProcess(Pointer(MyApplication), PChar(MyCmdLine),
     nil, nil, false, NORMAL_PRIORITY_CLASS,
     nil, nil, StartupInfo, ProcessInfo))=true then

      try
      
       with ProcessInfo do
                begin
                //Ждем завершения инициализации.
                WaitForInputIdle(hProcess, INFINITE);
                //Ждем завершения процесса.
                WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
                //Получаем код завершения.
                GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
                //Закрываем дескриптор процесса.
                CloseHandle(hThread);
                //Закрываем дескриптор потока.
                CloseHandle(hProcess);
                end

       
      except
       on E:Exception do showmessage(E.ClassName+' поднята ошибка, с сообщением : '+E.Message);
      end;

end;

//------------------------Start UniServer-------------------------------------------

procedure TMainForm.StartUniServer;

var

UniServerPath: string;

MyApplication: string;

MyParams: string;

MyCmdLine: string;

StartupInfo : TStartupInfo;

ProcessInfo : TProcessInformation;

ExitCode: Cardinal; //код завершения

begin

// Запускаем UniGUI сервер

ZeroMemory(@StartupInfo,SizeOf(StartupInfo));

StartupInfo.cb := SizeOf(StartupInfo);

StartupInfo.dwFlags := STARTF_USESHOWWINDOW;

StartupInfo.wShowWindow :=SW_SHOWNORMAL;//SW_SHOWDEFAULT; // SW_MINIMIZE;

UniServerPath:=ExtractFileDir(Application.ExeName)+'\UniGUI_mp3.exe';

//'C:\DELPHI\MyStudyProjects\300_UniGUI_audio\Win32\Debug\UniGUI_mp3.exe';

MyApplication :=UniServerPath;

MyParams := '';

MyCmdLine := Format('"%s" %s', [MyApplication, MyParams]);

SetLastError(ERROR_INVALID_PARAMETER); // Для обхода бага по совету gunsmoker

//http://www.gunsmoker.ru/2014/03/createprocessfailwithsuccess.html

if Win32Check(CreateProcess(Pointer(MyApplication), PChar(MyCmdLine),

nil, nil, false, NORMAL_PRIORITY_CLASS,

nil, nil, StartupInfo, ProcessInfo))=true then

try

with ProcessInfo do

begin

//Ждем завершения инициализации.

WaitForInputIdle(hProcess, INFINITE);

//Ждем завершения процесса.

WaitforSingleObject(ProcessInfo.hProcess, INFINITE);

//Получаем код завершения.

GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);

//Закрываем дескриптор процесса.

CloseHandle(hThread);

//Закрываем дескриптор потока.

CloseHandle(hProcess);

end

except

on E:Exception do showmessage(E.ClassName+' поднята ошибка, с сообщением : '+E.Message);

end;

Интересный пример с форума

Пример, приведенный ниже показался мне интересным, поэтому решил сохранить его у себя в блоге со ссылкой на источник. Здесь также используется функция CreateProcess.

procedure TForm1.Button1Click(Sender: TObject);
var
Rlst: LongBool; //результат выполнения
StartUpInfo: TStartUpInfo; //параметры будущего процесса
ProcessInfo: TProcessInformation; //Отслеживание выполнения
CurrDir:string; //текущая папка
ArchiveDir:string; //папку куда складываем архивы
AppToRun:string; //путь до winrar
CommandLine:string; //строка параметров
filename:string; //имя файла
Error:integer; //номер ошибкок
ExitCode: Cardinal; //код завершения
begin
//Определяем текущюю директорию.
CurrDir:= ExtractFilePath(Application.ExeName);
 
//Определяем путь к WinRAR.
AppToRun:='C:\Program Files\WinRAR\rar.exe';
 
//Проверяем, есть ли в текущей директории программы, папка Archive.
//Если нет - создаем.
If not DirectoryExists(CurrDir+'Archive') then
MkDir(CurrDir+'Archive');
 
//Открываем выбор файла для архивирования.
//Если выбрали, то обрабатываем.
if OpenDialog1.Execute then
begin
//В FileName записываем полный путь к выбранному файлу
filename:=OpenDialog1.FileName;
 
//В CommandLine записываем командную строку
//В нашем случае командная строка должна выглядеть:
//<пробел> a -ep "<путь до архива>" "<путь до файла>"
CommandLine:=' a -ep "'+CurrDir+'Archive\'+ExtractFileName(filename)+'.rar" "'+filename+'"';
 
//Заполнение нулями всего StartUpInfo.
FillChar(StartUpInfo, SizeOf(TStartUpInfo), 0);
//После этого выставляем в нем некоторые параметры.
with StartUpInfo do
begin
//Содержит количество байтов, занимаемых структурой TStartUpInfo.
//Обязательно для заполнения. Инициализируйте как SizeOf(TStartUpInfo).
cb := SizeOf(TStartUpInfo);
//Содержит набор флагов, позволяющих управлять созданием дочернего процесса.
//Показываем окно, курсор - часики.
dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
//Определяет как должно выглядеть окно запущенного приложения.
//Нормальное отображение
wShowWindow := SW_SHOWNORMAL;
end;
 
//Сам запуск WinRAR с параметрами.
//По сути, мы запускаем следующее:
//WinRar.exe a -ep "<путь до архива>" "<путь до файла>"
showmessage(AppToRun+CommandLine);
Rlst:= CreateProcess(PChar(AppToRun), PChar(CommandLine),
nil, nil, false, NORMAL_PRIORITY_CLASS,
nil, nil, StartUpInfo, ProcessInfo);
 
//Отслеживаем выполнение.
//Если запуск успешен
if Rlst then
with ProcessInfo do
begin
//Ждем завершения инициализации.
WaitForInputIdle(hProcess, INFINITE);
//Ждем завершения процесса.
WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
//Получаем код завершения.
GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
//Закрываем дескриптор процесса.
CloseHandle(hThread);
//Закрываем дескриптор потока.
CloseHandle(hProcess);
end
//Иначе
else
begin
//В случае ошибки - выводим на экран сообщение.
Error := GetLastError;
MessageDlg(SysErrorMessage(Error), mtError, [mbOk], 0);
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);

var

Rlst: LongBool; //результат выполнения

StartUpInfo: TStartUpInfo; //параметры будущего процесса

ProcessInfo: TProcessInformation; //Отслеживание выполнения

CurrDir:string; //текущая папка

ArchiveDir:string; //папку куда складываем архивы

AppToRun:string; //путь до winrar

CommandLine:string; //строка параметров

filename:string; //имя файла

Error:integer; //номер ошибкок

ExitCode: Cardinal; //код завершения

begin

//Определяем текущюю директорию.

CurrDir:= ExtractFilePath(Application.ExeName);

//Определяем путь к WinRAR.

AppToRun:='C:\Program Files\WinRAR\rar.exe';

//Проверяем, есть ли в текущей директории программы, папка Archive.

//Если нет - создаем.

If not DirectoryExists(CurrDir+'Archive') then

MkDir(CurrDir+'Archive');

//Открываем выбор файла для архивирования.

//Если выбрали, то обрабатываем.

if OpenDialog1.Execute then

begin

//В FileName записываем полный путь к выбранному файлу

filename:=OpenDialog1.FileName;

//В CommandLine записываем командную строку

//В нашем случае командная строка должна выглядеть:

//<пробел> a -ep "<путь до архива>" "<путь до файла>"

CommandLine:=' a -ep "'+CurrDir+'Archive\'+ExtractFileName(filename)+'.rar" "'+filename+'"';

//Заполнение нулями всего StartUpInfo.

FillChar(StartUpInfo, SizeOf(TStartUpInfo), 0);

//После этого выставляем в нем некоторые параметры.

with StartUpInfo do

begin

//Содержит количество байтов, занимаемых структурой TStartUpInfo.

//Обязательно для заполнения. Инициализируйте как SizeOf(TStartUpInfo).

cb := SizeOf(TStartUpInfo);

//Содержит набор флагов, позволяющих управлять созданием дочернего процесса.

//Показываем окно, курсор - часики.

dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;

//Определяет как должно выглядеть окно запущенного приложения.

//Нормальное отображение

wShowWindow := SW_SHOWNORMAL;

end;

//Сам запуск WinRAR с параметрами.

//По сути, мы запускаем следующее:

//WinRar.exe a -ep "<путь до архива>" "<путь до файла>"

showmessage(AppToRun+CommandLine);

Rlst:= CreateProcess(PChar(AppToRun), PChar(CommandLine),

nil, nil, false, NORMAL_PRIORITY_CLASS,

nil, nil, StartUpInfo, ProcessInfo);

//Отслеживаем выполнение.

//Если запуск успешен

if Rlst then

with ProcessInfo do

begin

//Ждем завершения инициализации.

WaitForInputIdle(hProcess, INFINITE);

//Ждем завершения процесса.

WaitforSingleObject(ProcessInfo.hProcess, INFINITE);

//Получаем код завершения.

GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);

//Закрываем дескриптор процесса.

CloseHandle(hThread);

//Закрываем дескриптор потока.

CloseHandle(hProcess);

end

//Иначе

else

begin

//В случае ошибки - выводим на экран сообщение.

Error := GetLastError;

MessageDlg(SysErrorMessage(Error), mtError, [mbOk], 0);

end;

Список источников

В разработке решения мне помогли следующие источники.

MSDN Create Process function

MSDN Startupinfo structure

Этот проблемный CreateProces (блог GunSmoker)…

Когда CreateProcess завершается с ошибкой ERROR_SUCCESS

Обсуждение на форуме sql.ru

Обсуждение на форуме cyberforums.ru

Delphi. CreateProcess. Запуск UniGUI сервера

Интересный пример с форума

Список источников

MY PROJECTS

Recent Posts

Categories