Гость
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Перехват вывода консоли в Memo / 23 сообщений из 23, страница 1 из 1
22.07.2021, 17:01
    #40085475
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Люди добрые ))
Помогите найти рабочий исходник вывода консоли в MEMO например команды ping ...
Не могу найти информации много, но собрать проект не получается, оказалось, что это очень не просто ((
...
Рейтинг: 0 / 0
22.07.2021, 17:16
    #40085489
Dimitry Sibiryakov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Это действительно непросто. Тем не менее в гугле есть куча готового кода. Так что что
конкретно у тебя не получается?
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
22.07.2021, 17:32
    #40085504
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Вот об этом я и говорю, кода много весь разный, а собрать работающий проект на Delphi 10.4 не получается уже столько кодов перепробовал, проблема в том что код обычно выкладывают нерабочий, потом долго обсуждают, пробуют разные изменения, что-то кусками меняют меняют, потом автор кричит ЭВРИКА! я понял всем спасибо, а что он понял и где окончательный вариант непонятно, никто не выкладывает конечный результат "понял"
...
Рейтинг: 0 / 0
22.07.2021, 17:38
    #40085511
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDex,

Выбирайте код и говорите, какие конкретно проблемы он у вас вызвал
...
Рейтинг: 0 / 0
22.07.2021, 17:48
    #40085520
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Спасибо попробую, не получиться напишу )
...
Рейтинг: 0 / 0
22.07.2021, 17:52
    #40085522
Dimitry Sibiryakov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
А ты не бери "разный". Ключевые функции это CreatePipe, CreateProcess, ReadFile и (в
зависимости от сущности запускаемого процесса) OemToCharBuff.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
22.07.2021, 18:06
    #40085526
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function Win32ExecAndWait(const CommandLine, Directory:
string; out OutputString: string): integer;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  PDirectory: PChar;
  BytesRead: Cardinal;
begin
  Result := -1;
  OutputString := '';
  if Directory = '' then
    PDirectory := nil
  else
    PDirectory := PChar(Directory);

  FillChar(SA, SizeOf(SA), 0);
  FillChar(SI, SizeOf(SI), 0);

  with SA do
    begin
      nLength := SizeOf(SA);
      bInheritHandle := True;
      lpSecurityDescriptor := nil;
    end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
      begin
        cb := SizeOf(SI);
        dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
        wShowWindow := SW_HIDE;
        hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
        hStdOutput := StdOutPipeWrite;
        hStdError := StdOutPipeWrite;
      end;
    if not CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
      nil, nil, True, 0, nil, PDirectory, SI, PI) then
      Result := -1
    else
      begin
        CloseHandle(StdOutPipeWrite);
        try
          repeat
            WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
            if BytesRead > 0 then
              begin
                Buffer[BytesRead] := #0;
                OutputString := OutputString + Buffer;
              end;
          until not WasOK or (BytesRead = 0);
          WaitForSingleObject(PI.hProcess, INFINITE);
          GetExitCodeProcess(PI.hProcess, Cardinal(Result));
        finally
          CloseHandle(PI.hThread);
          CloseHandle(PI.hProcess);
        end;
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
  s: string;
  x: integer;

begin
  x:= Win32ExecAndWait('ping www.ya.ru','',s);
  Memo1.Lines.Add(s);
end;

end.



Вот нашёл вроде работает, но вместо русских букв мусор (
Конечно и так хорошо, но интересно было бы чтобы выводило не в конце результат, а построчно по мере поступления

Выкладываю рабочий проект ))
...
Рейтинг: 0 / 0
22.07.2021, 18:20
    #40085529
Dimitry Sibiryakov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDexВот нашёл вроде работает, но вместо русских букв мусор (

А ведь говорил я тебе выше про перекодировку...

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

Догадаться, что текст выводится по мере заполнения буфера и уменьшить его - совершенно
невозможно?..
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
22.07.2021, 18:34
    #40085532
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
авторДогадаться, что текст выводится по мере заполнения буфера и уменьшить его - совершенно
невозможно?..

Возможно )) будем разбираться! спасибо вам за наводку


А вообще вам как специалисту, как вам этот код, или можно поискать и получше?
Я то чайник неделю только смотрю на Delphi 10.4 ))
...
Рейтинг: 0 / 0
22.07.2021, 18:47
    #40085539
Dimitry Sibiryakov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDexА вообще вам как специалисту, как вам этот код, или можно поискать и получше?

Лично меня от юниховой идеологии "запустим внешнюю утилиту и будем парсить её выхлоп"
тошнит. Я лучше поищу API для достижения нужной цели.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
22.07.2021, 19:14
    #40085546
Кроик Семён
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDex,

Код: pascal
1.
2.
3.
4.
5.
6.
   function Win32ExecAndWait(const CommandLine, Directory:string; 
     out OutputString: string): integer;
   begin
      ...
      OutputString := OutputString + Buffer;
      ...



если поменять аргумент на TStrings или вообще на вызов callback-функции, то можно было бы организовать вывод в TMemo ещё до завершения вызванного процесса, по мере поступления вывода так сказать. А так вы получаете вывод в конце сразу целиком.

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
type
   TOutputEvent = procedure(const ANext: string) of object;

   function Win32ExecAndWait(const CommandLine, Directory:string; 
     AOutputEvent: TOutputEvent): integer;
   begin
      ...
      if Assigned(AOutputEvent) then AOutputEvent(Buffer); // как то так
      ...
...
Рейтинг: 0 / 0
23.07.2021, 17:38
    #40085765
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Хорошо, попробую, что получиться отпишусь
...
Рейтинг: 0 / 0
23.07.2021, 18:02
    #40085773
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDex,
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TOutputEvent = procedure(const ANext: string) of object;
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function Win32ExecAndWait(const CommandLine, Directory:
string; AOutputEvent: TOutputEvent): integer;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  PDirectory: PChar;
  BytesRead: Cardinal;
begin
  Result := -1;
  //OutputString := '';
  if Directory = '' then
    PDirectory := nil
  else
    PDirectory := PChar(Directory);

  FillChar(SA, SizeOf(SA), 0);
  FillChar(SI, SizeOf(SI), 0);

  with SA do
    begin
      nLength := SizeOf(SA);
      bInheritHandle := True;
      lpSecurityDescriptor := nil;
    end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
      begin
        cb := SizeOf(SI);
        dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
        wShowWindow := SW_HIDE;
        hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
        hStdOutput := StdOutPipeWrite;
        hStdError := StdOutPipeWrite;
      end;
    if not CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
      nil, nil, True, 0, nil, PDirectory, SI, PI) then
      Result := -1
    else
      begin
        CloseHandle(StdOutPipeWrite);
        try
          repeat
            WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
            if BytesRead > 0 then
              begin
                Buffer[BytesRead] := #0;
                if Assigned(AOutputEvent) then AOutputEvent(Buffer); // как то так
              end;
          until not WasOK or (BytesRead = 0);
          WaitForSingleObject(PI.hProcess, INFINITE);
          GetExitCodeProcess(PI.hProcess, Cardinal(Result));
        finally
          CloseHandle(PI.hThread);
          CloseHandle(PI.hProcess);
        end;
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
  s: TOutputEvent;
  x: integer;

begin
  x:= Win32ExecAndWait('ping www.ya.ru','',s);
  //Memo1.Lines.Add(s);
end;

end.



Не понял на счёт TOutputEvent.
При запуске выдаёт ошибку, даже без вывода в мемо, а мемо вообще с этим типом TOutputEvent не работает
При запуске выдаёт ошибку
...
Рейтинг: 0 / 0
23.07.2021, 18:03
    #40085775
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Проект
...
Рейтинг: 0 / 0
23.07.2021, 18:04
    #40085776
Dmitry Arefiev
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
И что такое s ?
...
Рейтинг: 0 / 0
23.07.2021, 18:44
    #40085795
Кроик Семён
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDex,

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
 TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
    procedure OnProcessOutput(const ANext: string);
  public
    { Public declarations }
  end;

  ...

//-----------------------------------------------------------------------------
procedure TForm1.OnProcessOutput(const ANext: string);
begin
   Memo1.Text := Memo1.Text + ANext;
   Application.ProcessMessages();
end;
//-----------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
Var
  iExitCode: integer;
begin
  iExitCode:= Win32ExecAndWait('ping www.ya.ru','',OnProcessOutput);

  Memo1.Lines.Add('');
  Memo1.Lines.Add('======================');
  Memo1.Lines.Add('ExitCode = '+IntToStr(iExitCode));

end;
//-----------------------------------------------------------------------------
...
Рейтинг: 0 / 0
23.07.2021, 19:35
    #40085807
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Большое спасибо Кроик Семён всё получилось, ты гений ))

Кому надо берите для изучения готовый проект )

Правда русские буквы не выводит, но мне это не принципиально )
...
Рейтинг: 0 / 0
23.07.2021, 20:05
    #40085812
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDex,

Свое есть. На Лазаре. И с русскими буквами ;)
...
Рейтинг: 0 / 0
23.07.2021, 20:27
    #40085816
Кроик Семён
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDex,

сейчас не важно, но на будущее: к проекту так же отностся *.dfm и *.pas файлы. Причём они и есть та часть проекта, которую вы хотели продемонстрировать :)
...
Рейтинг: 0 / 0
24.07.2021, 09:21
    #40085883
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Док
RaDex,

Свое есть. На Лазаре. И с русскими буквами ;)


Если можно скиньте ссылочку )



Кроик Семён
RaDex,

сейчас не важно, но на будущее: к проекту так же отностся *.dfm и *.pas файлы. Причём они и есть та часть проекта, которую вы хотели продемонстрировать :)


Точно извиняюсь, не обратил внимание на очередную "классную" фишку, правда не понятно для какого удобства это сделано, но если поект сохранять в другую папку то эти файлы остаются в старой )) просто сам последний раз программировал 15 лет назад на Delphi 7 там такой ерунды не было ))
Выкладываю полный вариант (проверил):
...
Рейтинг: 0 / 0
24.07.2021, 13:32
    #40085913
Док
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDex
Если можно скиньте ссылочку )

увы, сделать не смогу, ибо придется выдирать с кровью из проекта. Но, вот ссылка на вики
https://wiki.lazarus.freepascal.org/Executing_External_Programs/ru#.D0.A7.D1.82.D0.B5.D0.BD.D0.B8.D0.B5_.D0.B1.D0.BE.D0.BB.D1.8C.D1.88.D0.B8.D1.85_.D0.BE.D0.B1.D1.8A.D0.B5.D0.BC.D0.BE.D0.B2_.D0.B2.D1.8B.D0.B2.D0.BE.D0.B4.D0.B0

там в примечаниях от меня есть примеры и ссылки
...
Рейтинг: 0 / 0
24.07.2021, 14:21
    #40085923
RaDex
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
Док
RaDex
Если можно скиньте ссылочку )

увы, сделать не смогу, ибо придется выдирать с кровью из проекта. Но, вот ссылка на вики
https://wiki.lazarus.freepascal.org/Executing_External_Programs/ru#.D0.A7.D1.82.D0.B5.D0.BD.D0.B8.D0.B5_.D0.B1.D0.BE.D0.BB.D1.8C.D1.88.D0.B8.D1.85_.D0.BE.D0.B1.D1.8A.D0.B5.D0.BC.D0.BE.D0.B2_.D0.B2.D1.8B.D0.B2.D0.BE.D0.B4.D0.B0

там в примечаниях от меня есть примеры и ссылки


Значит мой проект остаётся единственны\м материальным под современную Дельфю )))
...
Рейтинг: 0 / 0
26.07.2021, 10:22
    #40086142
Fr0sT-Brutal
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перехват вывода консоли в Memo
RaDex

Если можно скиньте ссылочку )

TUtf8Process из стандартной поставки, и ничего не надо мутить дополнительно)
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Перехват вывода консоли в Memo / 23 сообщений из 23, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]