Выполнение команды CMD и получение вывода

[Janger]

В общем, проблема. Нагуглил функцию...

function GetDosOutput(
      CommandLine: string; Work: string = 'C:\'): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(
          STD_INPUT_HANDLE); // не переадресовывать stdinput
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

Вставил всё скомпилировалось без ошибки. Окей, далее....
Решил вывести результат:

Memo1.Text := GetDosOutput('SystemInfo');

И вот что мне показала программа:
=================================== ==
਍겈⃯꟣ꂫ›††††††††††††L봳䥔⁍꟣਍⁍ꂍꊧ궠ꖨ踠㪑†††† †††††††L봳ꂌꪩ껠껡圠湩潤獷㠠ㄮ輠껠ꗤ꺨ꂭꂭï∕�٤ᗚ耐破甛٤봳਍ꪩꖂ踠㪑††††††††††††ꂭï∕�٤ᗚ耐破甛٤봳⸶⸳㘹〰贠萯꼠ꖮꢭ₥㘹〰†††ꂭï∕�٤ᗚ耐਍⸳ꞈ꺣껢ꢢꗢ踠㪑†††††††††ꂭï∕�٤ᗚ耐楍牣獯景⁴潃灲牯瑡潩††††††ꂭï∕਍牣ꂏꃠꖬ⃫醎›† †††††††††ꂭï∕ꞈꮮꊮ궠ꂭ⃯ꃠ꺡ꃧ⃯궠⃯꣦††ꂭï∕਍ ꮮ꺏껠궥ꖨ踠㪑††††††††††ꂭï∕畍瑬灩潲散獳牯䘠敲⁥††† ††††ꂭ਍瑬ꂇꗠꢣ꣠껠ꂢ궭ꧫꈠꂫꖤꖫ㫦†††ꂭ楔浭ꡩ꣠਍浭ꂇ ꗠꢣ꣠껠ꂢ궭긠ꏠ궠Ꞩ›†ꂭ਍ꗠ꺊₤꒮ꫣꃢ›†††††††† ††ꂭ〰㘲ⴱ〵〰ⴰ〰〰ⴰ䅁㠹‹†††††ꂭ਍㘲ꂄꃢ궠ꊮꢪ›†† †††††††ꂭ㌲〮⸹〲㐱‬㈲ㄺ㨸㤰†††††††ꂭ਍〮겥⃯ꂧ ꟣ꢪꗢ›†††††ꂭ㤰ㄮ⸰〲㐱‬㨷㔰㔺ꔳ›†††††ꂭ਍ㄮ ꞈ꺣껢ꢢꗢꗢ›††††††ꂭ楇慧祢整吠捥湨汯杯⁹潃Ⱞ䰠摴*† †ꂭ਍慧꺌ꖤꗢ›†††††††††ꂭ䅇㜭〷ⵔ㍄ꕌ›††† ਍㜭ꢒ₯꣡겥㫫†††††††††††ꂭ㙸ⴴ慢敳⁤䍐††††††਍ⴴ 껡⣠⧫›††††††††††ꂭꢗꯡ₮껡껠₢*⸱††††† †ꂭ਍ꯡ†††††††††††††††††ꂭせ崱›䵁㙄‴慆業祬ㄠ‶ 潍敤‴瑓灥楰杮㌠䄠瑵敨瑮捩䵁⁄㉾〸‰莌æ봳਍崱ꖂ䈠佉㩓††††† ††††††楰杮㌠䄠瑵敨瑮捩䵁⁄㉾〸‰莌æ봳睁牡⁤潓瑦慷敲䤠瑮牥慮楴湯 污‬湉⹣䘠ⰳ㈠⸸㜰㈮㄰挰䵁⁄㉾〸‰莌æ봳਍牡ꂏꪯ₠楗摮睯㩳†††††† ††††䘠ⰳ㈠⸸㜰㈮㄰挰䵁⁄㉾〸‰莌æ봳㩃坜义佄南睯㩳†††਍坜ꢑ겥 ꂭ⃯ꂯꪯ㪠†††††††††䘠ⰳ㈠⸸㜰㈮㄰挰䵁⁄㉾〸‰莌æ봳㩃坜义佄南 獜獹整㍭′†††††††䘠ⰳ਍坜ꦮ꺢꜠ꎠꪧ㪨†††††††䘠ⰳ 䑜癥捩履慈摲楤歳潖畬敭‱†††††䘠ⰳ਍癥ꞟꫫꗢ›††††††† †††䘠ⰳ畲逻ꫡꦨ›†††਍逻ꞟꫫꈠ꺢ꂤ›†††††††††††䘠 ⰳ湥甭㭳궀ꮣꦨꫡꦨ⠠频⦀††††††䘠ⰳ਍甭ꂗ껡꺢₩꺯›†††††† ††††䘠ⰳ唨䍔〫㨲〰
ꢂⳡ訠ꖨⲢ造ꎨⲠ鄠‬ꂒꮫ궨‬ꖕ꣡ꪭエ ‰莌æ봳਍䍔꺏궫ꧫ긠겥Ꞩ꺪₩ꂯ꣢›†‬ꂒꮫ궨‬ꖕ꣡ꪭエ ‰莌æ봳X㤱‰膌겥Ꞩ਍㤱꺄꿣ꂭ⃯꣤ꢧꗧꫡ꼠겠㫬†††‬ꂒ ꮫ궨‬ꖕ꣡ꪭエ‰莌æ봳V㔴‵膌⃯꣤ꢧꗧ਍㔴ꢂꃣꂭ⃯ꂯ›ꂌ* ꃠ겧›‬ꂒꮫ궨‬ꖕ꣡ꪭエ‰莌æ봳Y㜴‰膌ꂭ⃯ꂯ਍㜴ꢂꃣꂭ ⃯ꂯ›꺄꿣ꂭ›††‬ꂒꮫ궨‬ꖕ꣡ꪭエ‰莌æ봳W〵‱膌ꂭ⃯ꂯ ਍〵ꢂꃣꂭ⃯ꂯ›꺯›‬ꂒꮫ궨‬ꖕ꣡ꪭエ‰莌æ 봳Q㘹‹膌ꂭ⃯ꂯ਍㘹ꂐ꿡ꮮꚮ궥ꖨꦠꂫ꼠꒮ꂪꫧ㪨†††‬ꂒꮫ궨‬ ꖕ꣡ꪭエ‰莌æ봳㩃灜条晥汩⹥祳ꥳ敤
=================================== ==
Что блин это всё значит?????..... Я в шоке....
Если что, то у меня Delphi XE4

[FaTaL]

Может кодировка нужна ОЕМ 866?

[Janger]

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

Может кодировка нужна ОЕМ 866?

А не подскажете как кодировку сменить?
я не помню

[Stilet]

Смотри:
http://www.programmersforum.ru/showthread.php?t=125948
http://www.programmersforum.ru/showthread.php?t=66815
http://www.programmersforum.ru/showthread.php?t=217269

[min@y™]

Какая прелесть!

[A-MaR_]

Тоже долгое время пользуюсь функцией GetDosOutput, несколько модернизированной с добавлением подробного вывода в лог. До недавнего времени никаких проблем не было. Проблемы начались, когда потребовалось обращаться на сайт ЦРПТ для онлайн-проверки дата-матрикс кода в рамках разрешительного режима.

Отправляемая строка CommandLine:
curl.exe -X POST "https://cdn06.crpt.ru/api/v4/true-api/codes/check" -H "Content-Type: application/json" -H "X-API-KEY: <токен для авторизации>" -d "{""codes"" : [""<дата-матрикс код для проверки>""], ""fiscalDriveNumber"" : ""<рег. номер фискальника>""}" >"C:\WorkFolder\TmpJson\<Текущие дата/время в формате yyyymmdd_hhnnsszzz>_PostDataMatrix.json" >"C:\WorkFolder\TmpJson\Debug\_<Текущие дата/время в формате yyyymmdd_hhnnsszzz>_PostDataMatrix.json"
В первый файл выводится непосредственно ответ сервера, во второй (отладочный) - ход процесса вывода.

В некоторых ситуациях (предположительно - при обрыве связи с сервером) после строки "WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);" лог обрывается и происходит глухое зависание программы. Происходит это исключительно на нескольких клиентских точках.

Есть мысль попробовать использовать вместо синхронной функции ReadFile асинхронную ReadFileEx, но никак не могу разобраться с параметрами. В частности, что представляет из себя подпрограмма завершения lpCompletionRoutine, что в ней должно быть? Также мне непонятна структура lpOverlapped, которая в ReadFile не используется и задаётся как nil.

BOOL ReadFileEx(
  [in]            HANDLE                          hFile,
  [out, optional] LPVOID                          lpBuffer,
  [in]            DWORD                           nNumberOfBytesToRead,
  [in, out]       LPOVERLAPPED                    lpOverlapped,
  [in]            LPOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine
);

Может кто-нибудь проконсультировать по данной функции?

[DeepFlake]

Почему два раза

>"C:\WorkFolder\TmpJson\<Текущ

Может быть надо во второй раз

2>"C:\WorkFolder\TmpJson\Debug\_<Текущ

Использовать TProcess и TProcessUTF8 не пробовали?

Вроде бы проще с ними:

procedure TForm1.Button1Click(Sender: TObject); 
var 
  AProcess: TProcess; 
  Output: TStringList; 
begin 
  AProcess := TProcess.Create(nil); 
  Output := TStringList.Create; 
  try 
    AProcess.Executable := 'wmic'; 
    AProcess.Parameters.Add('path'); 
    AProcess.Parameters.Add('win32_pnpentity'); 
    AProcess.Parameters.Add('get'); 
    AProcess.Parameters.Add('caption, description'); 
    AProcess.Options := AProcess.Options + [poWaitOnExit, poUsePipes]; 
    AProcess.ShowWindow := swoHIDE; 
    AProcess.Execute; 
    Output.LoadFromStream(AProcess.Output); 
    
    // Print the output to a memo or any other control 
    Memo1.Lines.AddStrings(Output); 
  finally 
    Output.Free; 
    AProcess.Free; 
  end; 
end;

[A-MaR_]

Вопрос решился добавлением параметра curl.exe --max-time <таймаут в секундах>