[cezer]

Добрый вечер. Не посылайте в поиск ибо весь день занимался поиском и честное слово копипастом но так ничего и не вышло. Нет дело не в копипасте что куда подставить и дописать я в курсе...

И так вопрос: Есть консольное приложение в котором появляется переодически текст и этот текст нужно вывести в memo1. все известные процедуры:
GetDosOutput, RunDosInMemo, dos2win и тд не помогли(( Привожу пример использования GetDosOutput

Код:

function GetDosOutput(const CommandLine,Parametrs:string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  WorkDir, Line: String;
begin
  Application.ProcessMessages;
  with SA do
    begin
      nLength := SizeOf(SA);
      bInheritHandle := True;
      lpSecurityDescriptor := nil;
    end;
  // создаём пайп для перенаправления стандартного вывода
  CreatePipe(StdOutPipeRead,  // дескриптор чтения
             StdOutPipeWrite, // дескриптор записи
             @SA,              // аттрибуты безопасности
             0                // количество байт принятых для пайпа - 0 по умолчанию
             );
  try
    // Создаём дочерний процесс, используя StdOutPipeWrite в качестве стандартного вывода,
    // а так же проверяем, чтобы он не показывался на экране.
    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); // стандартный ввод не перенаправляем
        hStdOutput := StdOutPipeWrite;
        hStdError := StdOutPipeWrite;
      end;
    // Запускаем компилятор из командной строки
    WorkDir := ExtractFilePath(CommandLine);
    WasOK := CreateProcess(nil,
                           PChar(CommandLine+' '+Parametrs),
                           nil,
                           nil,
                           True,
                           0,
                           nil,
                           PChar(WorkDir),
                           SI,
                           PI);
    // Теперь, когда дескриптор получен, для безопасности закрываем запись.
    // Нам не нужно, чтобы произошло случайное чтение или запись.
    CloseHandle(StdOutPipeWrite);
    // если процесс может быть создан, то дескриптор, это его вывод
    if not WasOK then //raise Exception.Create('Could not execute command line!')
    else
      try
        // получаем весь вывод до тех пор, пока DOS-приложение не будет завершено
        Line := '';
        repeat
          Application.ProcessMessages;
          // читаем блок символов (могут содержать возвраты каретки и переводы строки)
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          // есть ли что-нибудь ещё для чтения?
          if BytesRead > 0 then
            begin
              // завершаем буфер PChar-ом
              Buffer[BytesRead] := #0;
              // добавляем буфер в общий вывод
              Line := Line + Buffer;
            end;
        until not WasOK or (BytesRead = 0);
        // ждём, пока завершится консольное приложение
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        // Закрываем все оставшиеся дескрипторы
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    result:= utf8toansi(Line); // перекодируем UTF-8 в ANSI
    CloseHandle(StdOutPipeRead);
  end;
end;

Код:

procedure TForm1.Button1Click(Sender: TObject);
var 
dir: pansichar;
begin
Memo1.Clear;
begin
dir:= Pansichar(extractfilepath(paramstr(0)));
memo1.Lines.Add( trim(GetDosOutput(dir+'1.bat', '')));
end;
end;

На мой взгляд более подходящий но к сожалению не рабочий в моём случае...
в батнике следующий текст: zbarcam.exe >rec.txt
Запускается консоль в которой показывает текст распознаного QR кода, а затем появляется окно с изображением с web камеры. если можно обойтись без батника то тоже буду очень признателен, если поделитесь кодом...

[cezer]

Поправочка: Запускаю программу она зависат подношу qr код он распознаёт но в memo1 не выводит после закрытия окна Zbarcam.exe в memo1 появляется распознаный текст...

[Bargest]

А мне почему-то копипаста помогла:

Код:

procedure TfrmAvrGui.StartAvrDude(StartStr: Widestring);
var
  si: STARTUPINFO;
  sa: SECURITY_ATTRIBUTES;
  sd: SECURITY_DESCRIPTOR; // структура security для пайпов
  pri: PROCESS_INFORMATION;
  texit: DWORD; // код завершения процесса
  bread: DWORD; // кол-во прочитанных байт
  avail: DWORD; // кол-во доступных байт
  newstdin, newstdout, read_stdout, write_stdin: THandle;
  buf: array [0 .. 1023] of AnsiChar;

begin
  mmLog.Lines.Add('');
  if not WT.Stop then
  begin
    mmLog.Lines.Add('*************************************');
    mmLog.Lines.Add('AvrDude уже запущен!');
    mmLog.Lines.Add('*************************************');
    exit;
  end;
  WT.Stop := false;

  InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
  SetSecurityDescriptorDacl(@sd, true, nil, false);
  sa.lpSecurityDescriptor := @sd;

  sa.nLength := SizeOf(SECURITY_ATTRIBUTES);
  sa.bInheritHandle := true; // разрешаем наследование дескрипторов

  if not CreatePipe(newstdin, write_stdin, @sa, 0) then
  begin
    ShowMessage('Ошибка создания Pipe');
    exit;
  end;
  if not CreatePipe(read_stdout, newstdout, @sa, 0) then
  begin
    CloseHandle(newstdin);
    CloseHandle(write_stdin);
    ShowMessage('Ошибка создания Pipe');
    exit;
  end;
  GetStartupInfo(si);
  si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  si.hStdOutput := newstdout;
  si.hStdError := newstdout; // подменяем дескрипторы для
  si.hStdInput := newstdin; // дочернего процесса
  if cbAvrDude.ItemIndex = 0 then
    S := 'avrdudeStd.exe'
  else if cbAvrDude.ItemIndex = 1 then
    S := 'avrdudeFTBB.exe';
  if not CreateAvrDudeProcess(S, StartStr, cbDisableBCT.Checked, si, pri) then
  begin
    ShowMessage('Ошибка при запуске AvrDude');
    exit;
  end;
  AvrDudeID := pri.dwProcessId;
  btnStop.Enabled := true;
  Zeromemory(@buf[0], 1024);
  texit := 0;
  while true do
  begin
    Application.ProcessMessages;
    PeekNamedPipe(read_stdout, @buf[0], 1023, @bread, @avail, NIL);
    // Проверяем, есть ли данные для чтения в stdout

    if (bread <> 0) then
    begin
      Zeromemory(@buf[0], 1024);
      if (avail > 1023) then
      begin
        while (bread >= 1023) do
        begin
          ReadFile(read_stdout, buf, 1023, bread, NIL); // читаем из
          mmLog.Lines.Add(buf); // пайпа stdout
          Zeromemory(@buf[0], 1024);
        end;
      end
      else
      begin
        ReadFile(read_stdout, buf, 1023, bread, NIL);
        mmLog.Lines.Add(buf);
      end;
    end;

    GetExitCodeProcess(pri.hProcess, texit); // пока дочерний процесс
    if (texit <> STILL_ACTIVE) then // не закрыт
      break;
    sleep(10);
  end;
  WT.Stop := true;
  btnStop.Enabled := false;
  CloseHandle(pri.hThread);
  CloseHandle(pri.hProcess);
  CloseHandle(newstdin); // небольшая уборка за собой
  CloseHandle(newstdout);
  CloseHandle(read_stdout);
  CloseHandle(write_stdin);
end;

Честно спиз сперто из гугла.

[cezer]

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

....

Спасибо за быстрый ответ ув. Bargest сейчас проверю отпишусь.

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

...

Пример использования можно? или лучше (если можно) ссыль на статью.

[Bargest]

Пример - StartAvrDude('Exe.exe -param1 -param2')
http://www.sources.ru/cpp/using_anonymous_pipes.shtml

[cezer]

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

...

Вы это все переписали с С++ на Delphi??? Так быстро? я поражён вами) Ну а теперь к делу выдаёт ошибку(((
Ругался сначало на TfrmAvrGui я поменял на TForm1 затем выдал ошибку на TfrmAvrGui.=>StartAvrDude<= я так понял нужно в приват или public обьявить что то... Но там в окне ещё куча ошибок:

Код:

Build
  [Error] Unit1.pas(33): Undeclared identifier: 'StartAvrDude'
  [Error] Unit1.pas(33): ';' expected but '(' found
  [Error] Unit1.pas(46): Undeclared identifier: 'mmLog'
  [Error] Unit1.pas(46): Missing operator or semicolon
  [Error] Unit1.pas(47): Undeclared identifier: 'WT'
  [Error] Unit1.pas(49): Missing operator or semicolon
  [Error] Unit1.pas(50): Missing operator or semicolon
  [Error] Unit1.pas(51): Missing operator or semicolon
  [Error] Unit1.pas(54): Missing operator or semicolon
  [Error] Unit1.pas(81): Undeclared identifier: 'cbAvrDude'
  [Error] Unit1.pas(83): 'THEN' expected but identifier 'ItemIndex' found
  [Error] Unit1.pas(85): Undeclared identifier: 'CreateAvrDudeProcess'
  [Error] Unit1.pas(85): Undeclared identifier: 'S'
  [Error] Unit1.pas(85): Undeclared identifier: 'cbDisableBCT'
  [Error] Unit1.pas(85): 'THEN' expected but identifier 'Checked' found
  [Error] Unit1.pas(90): Undeclared identifier: 'AvrDudeID'
  [Error] Unit1.pas(91): Undeclared identifier: 'btnStop'
  [Error] Unit1.pas(108): Missing operator or semicolon
  [Error] Unit1.pas(115): Missing operator or semicolon
  [Error] Unit1.pas(124): Missing operator or semicolon
  [Error] Unit1.pas(125): Missing operator or semicolon
  [Error] Unit1.pas(170): Undeclared identifier: 'StartAvrDude'
  [Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

memo1 имя сменил на mmlog
если есть скомпилированный проект поделитесь пожалуйста...

[Bargest]

А говоришь, что

Нет дело не в копипасте что куда подставить и дописать я в курсе...

Естественно, в таком виде не сработает. Это скопипасшено из одного моего проекта "на коленке", делал давно (год назад) по той статье.
StartAvrDude - разумеется, это название метода, и его нужно объявить.
mmLog - конечно, это TMemo, которое лежит на форме.
WT - поток, посторонний. Его можно снести.
CreateAvrDudeProcess - надстройка над CreateProcess с патчем запускаемой проги. Патч тебе не нужен.
S - строка. Не видно?
cbAvrDude - ComboBox, можно убрать.
cbDisableBCT тоже.
AvrDudeID - объявить или убрать.
btnStop - К.О.
Если бы нормально прочитал код и разобрался - 95% ошибок бы исчезли.

[cezer]

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

...

посносил то что не нужно... и ничего не происходит... видимо ничего у меня не получится ... Извини за беспокойство....

[Bargest]

Надо не посносить, а прочитать и понять код. Небось убрал создание процесса, вместо того, чтобы заменить, убрал строки и мемо?

[cezer]

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

...

Извините просто весь день парюсь бошка трещит... Нашёл по вашей наводке код запускается все отлично, но не показывает главное окно которое Видео изображение и не выводит текст в memo((( код прилагаю:

Код:

function RunAny(CommandLine: string; Str: TStrings): boolean;
var
   I: byte;
   S: string;
   Flag: boolean;
   tRead, cWrite, dwRead, dwAvail: cardinal;
   SA: TSecurityAttributes;
   PI: TProcessInformation;
   SI: TStartupInfo;
begin
   Result:=False;
   SA.nLength:=SizeOf(SECURITY_ATTRIBUTES);
   SA.bInheritHandle:=True;
   SA.lpSecurityDescriptor:=nil;
   if not CreatePipe(tRead, cWrite, @SA, 0) then Exit;
   ZeroMemory(@SI, SizeOf(TStartupInfo));
   SI.cb:=SizeOf(TStartupInfo);
   SI.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
   SI.wShowWindow:=SW_HIDE;
   SI.hStdOutput:=cWrite;
   if CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, nil, SI, PI) then begin
      CloseHandle(PI.hProcess);
      CloseHandle(PI.hThread);
      Str.Clear();
      Flag:=True;
      while Flag do begin
         for I:=0 to 9 do begin
            PeekNamedPipe(tRead, nil, 0, nil, @dwAvail, nil);
            if (dwAvail>0) then begin
               Flag:=True;
               Break;
            end
            else Flag:=False;
            Sleep(100);
         end; //for I:=
         if dwAvail>0 then begin
            SetLength(S, dwAvail);
            ReadFile(tRead, PChar(S)^, Length(S), dwRead, Nil);
            OemToChar(PChar(S), PChar(S));
            Str.Add(S);
            Application.ProcessMessages;
            Result:=True;
         end; // if dwAvail
      end;    // while Flag
   end;       // if CreateProcess
end;

вызываю так

Код:

procedure TForm1.Button4Click(Sender: TObject);
begin
runany('zbarcam.exe', mmlog.lines);
end;