CreateProcess. Существуют тонкости в запуске консольных приложений?

[st01en]

Доброго дня,

Оговорюсь сразу, код спер отсюда:
http://programmersforum.ru/showpost....7&postcount=10

Приведу сразу код, а затем расскажу, что у меня не выходит

procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStrings=nil; Errors:  TStrings=nil);
var
  sa: TSecurityAttributes;
  si: TStartupInfo;
  pi: TProcessInformation;
  hPipeOutRead, hPipeOutWrite, hPipeErrRead, hPipeErrWrite: THandle;
  res, bTest: boolean;
  env: array[1..100] of char;
  szBuffer: array[0..256] of char;
  dwBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  sa.nLength := SizeOf(sa);
  sa.lpSecurityDescriptor := nil;
  sa.bInheritHandle := true;
  CreatePipe(hPipeOutRead, hPipeOutWrite, @sa, 0);
  CreatePipe(hPipeErrRead, hPipeErrWrite, @sa, 0);
  ZeroMemory(@env, SizeOf(env));
  ZeroMemory(@si, SizeOf(si));
  ZeroMemory(@pi, SizeOf(pi));
  si.cb := SizeOf(si);
  si.dwFlags := STARTF_USESHOWWINDOW + STARTF_USESTDHANDLES;
  si.wShowWindow := SW_HIDE;
  si.hStdInput := 0;
  si.hStdOutput := hPipeOutWrite;
  si.hStdError := hPipeErrWrite;

  Res := CreateProcess(nil, PChar(CommandLine), nil, nil, true,
          CREATE_NEW_CONSOLE + NORMAL_PRIORITY_CLASS, @env, nil, si, pi);

  if not Res then
  begin
    CloseHandle(hPipeOutRead);
    CloseHandle(hPipeOutWrite);
    CloseHandle(hPipeErrRead);
    CloseHandle(hPipeErrWrite);
    Exit;
  end;
  CloseHandle(hPipeOutWrite);
  CloseHandle(hPipeErrWrite);

  //Read Output Pipe
  if Output <> nil then
  begin
    Stream := TMemoryStream.Create;
    try
      while True do
      begin
        bTest := ReadFile(hPipeOutRead, szBuffer, 256, dwBytesRead, nil);
        if not bTest then break;
        OemToAnsi(szBuffer, szBuffer);
        Stream.Write(szBuffer, dwBytesRead);
      end;
      Stream.Position := 0;
      Output.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  end;
  //Read Error Pipe
  if Errors <> nil then
  begin
    Stream := TMemoryStream.Create;
    try
      while True do
      begin
        bTest := ReadFile(hPipeErrRead, szBuffer, 256, dwBytesRead, nil);
        if not bTest then break;
        OemToAnsi(szBuffer, szBuffer);
        Stream.Write(szBuffer, dwBytesRead);
      end;
      Stream.Position := 0;
      Errors.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  end;

  WaitForSingleObject(pi.hProcess, INFINITE);
  CloseHandle(hPipeOutRead);
  CloseHandle(hPipeErrRead);
end;

Вызываю так:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExecConsoleApp(Edit1.Text, Memo1.Lines, Memo2.Lines);
end;

Проблема:
половина консольных приложений не выполняются, некоторые работают неверно.

Пару примеров:
Команда (в едит1): dir
Результат: ничего

Команда: dir c:\
Результат: ничего

Команда: copy c:\1.txt c:\2.txt
Результат: ничего

Команда: ping programmersforum.ru
Результат: При проверке связи не удалось обнаружить узел programmersforum.ru. Проверьте имя узла и повторите попытку.

Команда: tracert programmersforum.ru
Результат: Не удается разрешить системное имя узла programmersforum.ru.

Команда: ipconfig
Результат: Выводит нужный результат, работает как с ключами, так и без

Команда: systeminfo
Результат: в Error Output: Ошибка: Не найден указанный модуль.

Собственно вопрос: что не так?

Спасибо.

з.ы.
Я кстати все еще не против про named pipes почитать :
http://programmersforum.ru/showthread.php?p=247072

[postal2]

Попробуйте вызывать не
ping programmersforum.ru
, а например так
ping www.programmersforum.ru
или полностью имя
ping http://www.programmersforum.ru

Может быть в этом и недочёт. Насчёт остальных не знаю, чесслово

[evg_m]

Вопрс первый: ты уверен что CreateProcess вернул результат =true? Потому что в противном случае у тебя стоит Exit и получаем правильный ответ НИЧЕГО.

[st01en]

Сообщение от postal2

Попробуйте вызывать не
ping programmersforum.ru
, а например так
ping www.programmersforum.ru
или полностью имя
ping http://www.programmersforum.ru

Может быть в этом и недочёт. Насчёт остальных не знаю, чесслово

Извините но ваш совет не в тему, особенно второй вариант

Сообщение от evg_m

Вопрс первый: ты уверен что CreateProcess вернул результат =true? Потому что в противном случае у тебя стоит Exit и получаем правильный ответ НИЧЕГО.

В том то и дело что он возвращает false. Вот и суть вопроса сформулировалась - почему он возвращает false?
Но и это не все, некоторые консоьные утилиты запускаются с ошибками ...

[evg_m]

после createprocess добавь вызов Getlasterror. Он выдаст код ошибки который поможет узнать что не в порядке.

[st01en]

Сообщение от evg_m

после createprocess добавь вызов Getlasterror. Он выдаст код ошибки который поможет узнать что не в порядке.

Сделал так

  Res := CreateProcess(nil, PChar(CommandLine), nil, nil, true,
          CREATE_NEW_CONSOLE + NORMAL_PRIORITY_CLASS, @env, nil, si, pi);

  if not Res then
  begin
//Это кусок кода выдраный из примера, с этим GetLastError и FormatMessage мне еще предстоит разобраться :)
    ErrNo := GetLastError;
    Msg := AllocMem(4096);
    try
      FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, 0, Msg, 4096, nil);
      ShowMessage('Create Process Error #' + IntToStr(ErrNo) + ': ' + string(Msg));
    finally
      FreeMem(Msg);
    end;

    CloseHandle(hPipeOutRead);
    CloseHandle(hPipeOutWrite);
    CloseHandle(hPipeErrRead);
    CloseHandle(hPipeErrWrite);
    Exit;
  end;

В итоге ошибка:

Create Process Error #2: Не удается найти указаный файл.

какой же это файл он интересно ищет

[Андрей Куб]

трояна на нашел нужного =)

[st01en]

Сообщение от Андрей Куб

трояна на нашел нужного =)

ха-ха?

Так, с dir разобрался. Это вовсе не программа, а команда коммандной строки, ясное дело что он такого файла найти не смог. вот так все работает:

cmd /c dir

Но, по прежднему не работает ping/tracert - почему-то не ресолвит доменные имена, по IP адрессу нормально работает.
systeminfo не находит какой-то модуль. Такое чуство, что процесс создается в какой-то уж очень изолированой от системы среде.

[st01en]

up
неужели никто не знает в чем проблема?

[Somebody]

Не знаю, какие переменные там нужны этому ping'у, но если в lpEnvironment передавать nil, а не пустой список (env), то всё работает.
---
Он %SystemRoot% использует, когда её нет, получается:

C:\WINDOWS\system32\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND
C:\WINDOWS\system32\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND	
C:\WINDOWS\system\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND	
C:\WINDOWS\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND	
D:\Projects\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND	
C:\WINDOWS\system32\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND	
C:\WINDOWS\system32\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND
C:\WINDOWS\system\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND	
C:\WINDOWS\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND
D:\Projects\%SystemRoot%\System32\mswsock.dll	PATH NOT FOUND