[JackRu]

Всем доброго времени суток. Столкнулся с такой задачей, программа( уже готовая) запускается в консоли ( командная строка win )... я запускаю через батник при помощи команды

Код:

java -Xmx1536M -Xms1536M -Dfile.encoding=UTF-8 -jar program.jar

Задача следующая, перехватить все данные, которые выводятся в консоли.

Нашёл уже готовый код программы для перехвата

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:   
  TStringList);
var  
  sa: TSECURITYATTRIBUTES;   
  si: TSTARTUPINFO;   
  pi: TPROCESSINFORMATION;   
  hPipeOutputRead: THANDLE;   
  hPipeOutputWrite: THANDLE;   
  hPipeErrorsRead: THANDLE;   
  hPipeErrorsWrite: THANDLE;   
  Res, bTest: Boolean;   
  env: array[0..100] of Char;   
  szBuffer: array[0..256] of Char;
  dwNumberOfBytesRead: DWORD;   
  Stream: TMemoryStream;   
begin  
  sa.nLength := sizeof(sa);   
  sa.bInheritHandle := true;   
  sa.lpSecurityDescriptor := nil;   
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);   
  CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);   
  ZeroMemory(@env, SizeOf(env));   
  ZeroMemory(@si, SizeOf(si));   
  ZeroMemory(@pi, SizeOf(pi));   
  si.cb := SizeOf(si);   
  si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;   
  si.wShowWindow := SW_HIDE;
  si.hStdInput := 0;   
  si.hStdOutput := hPipeOutputWrite;   
  si.hStdError := hPipeErrorsWrite;   
    
  (* Remember that if you want to execute an app with no parameters you nil the  
     second parameter and use the first, you can also leave it as is with no  
     problems.                                                                 *)  
  Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,   
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);   
    
  // Procedure will exit if CreateProcess fail   
  if not Res then  
  begin  
    CloseHandle(hPipeOutputRead);
    CloseHandle(hPipeOutputWrite);   
    CloseHandle(hPipeErrorsRead);   
    CloseHandle(hPipeErrorsWrite);   
    Exit;   
  end;   
  CloseHandle(hPipeOutputWrite);   
  CloseHandle(hPipeErrorsWrite);   
    
  //Read output pipe   
  Stream := TMemoryStream.Create;   
  try  
    while true do  
    begin  
      bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
        nil);   
      if not bTest then  
      begin  
        break;   
      end;   
      Stream.Write(szBuffer, dwNumberOfBytesRead);   
    end;   
    Stream.Position := 0;   
    Output.LoadFromStream(Stream);   
  finally  
    Stream.Free;   
  end;   
    
  //Read error pipe
  Stream := TMemoryStream.Create;   
  try  
    while true do  
    begin  
      bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,   
        nil);   
      if not bTest then  
      begin  
        break;   
      end;   
      Stream.Write(szBuffer, dwNumberOfBytesRead);   
    end;   
    Stream.Position := 0;   
    Errors.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;

  WaitForSingleObject(pi.hProcess, INFINITE);
  CloseHandle(pi.hProcess);
  CloseHandle(hPipeOutputRead);
  CloseHandle(hPipeErrorsRead);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  OutP: TStringList;
  ErrorP: TStringList;
begin
  OutP := TStringList.Create;
  ErrorP := TstringList.Create;

  ExecConsoleApp('cmd.exe', OutP, ErrorP);
  Memo1.Lines.Assign(OutP);

  OutP.Free;
  ErrorP.Free;
end;

end.

Админ: Учимся пользоваться тегами грамотно!

Но загвоздка вот в чём, каким образом так скажем связать программу по перехвату и ту, данные которой нужно перехватить ?

[angvelem]

Куда вывести перехват нужно?

[JackRu]

в Мемо не плохо было бы )

[angvelem]

Посмотри эту и эту ссылки.

[JackRu]

Спасибо большое, воспользовался этим кодом

Код:

procedure RunDosInMemo(CmdLine: string; AMemo: TMemo);
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: Pchar;
  BytesRead: DWord;
  Apprunning: DWord;
begin
  Screen.Cursor := CrHourGlass;
  Form1.Button1.Enabled := False;
  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;
  if Createpipe(ReadPipe, WritePipe,
    @Security, 0) then
  begin
    Buffer := AllocMem(ReadBuffer + 1);
    FillChar(Start, Sizeof(Start), #0);
    start.cb := SizeOf(start);
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.dwFlags := STARTF_USESTDHANDLES +
      STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;

    if CreateProcess(nil,
      PChar(CmdLine),
      @Security,
      @Security,
      true,
      NORMAL_PRIORITY_CLASS,
      nil,
      nil,
      start,
      ProcessInfo) then
    begin
      repeat
        Apprunning := WaitForSingleObject
          (ProcessInfo.hProcess, 100);
        ReadFile(ReadPipe, Buffer[0],
          ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        OemToAnsi(Buffer, Buffer);
        AMemo.Text := AMemo.text + string(Buffer);

        Application.ProcessMessages;
      until (Apprunning <> WAIT_TIMEOUT);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
  Screen.Cursor := CrDefault;
  Form1.Button1.Enabled := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  RunDosInMemo('ping -t 192.168.28.200', Memo1);
end;

Но появился ещё 1 вопрос
- После начала перехвата данных, программа жутко зависает и невозможно использовать другие элементы. Возможно ли как нибудь решить этот вопрос ?

[angvelem]

Использовать
1. ProcessMessages
2. Thread