Реализация анонимного канала в Delphi

Пытаюсь реализовать обмен данными между процессами через анонимный канал. Процесс-сервер создает функцией CreateProcess два процесса-клиента, которые обмениваются данными по анонимному каналу. Изначально код был на c++, а я перевел его на Delphi. На c++ работает прекрасно, а с реализацией на Delphi возникают сложности: клиент (1), который должен передавать данные первым, выглядит как пустая консоль, без какого-либо вывода в нее, и процесс обмена стопорится. Помогите пожалуйста решить проблему.

ИЗМЕНЕНО: Обмен данными реализован как перенаправление стандартного ввода-вывода. В C++ для этого используется iostream как стандартный поток. Я не знаю альтернатив для Delphi (функции writeln и readln не подходят).

Код процесса-сервера:

program pipeserver;
{$APPTYPE CONSOLE}

{$R *.res}
uses
SysUtils, Windows;

var
lpszComLine1, lpszComLine2: array [0..200] of Char;
si: STARTUPINFO;
pi: PROCESS_INFORMATION;
hWritePipe, hReadPipe: THandle;
sa: SECURITY_ATTRIBUTES;

begin
try
// имена исполняемых файлов
StrPCopy(lpszComLine1, 'F:\DELPHI PROJECTS\client1\Win32\Debug\client1.exe'); {здесь необходимо указать полный путь до исполняемого файла}
StrPCopy(lpszComLine2, 'F:\DELPHI PROJECTS\client2\Win32\Debug\client2.exe'); {здесь тоже}

// устанавливаем атрибуты защиты канала
sa.nLength := SizeOf(SECURITY_ATTRIBUTES);
sa.lpSecurityDescriptor := nil; // защита по умолчанию
sa.bInheritHandle := True;      // дескрипторы наследуемые

// создаем анонимный канал
if not CreatePipe(hReadPipe, hWritePipe, @sa, 0) then
begin
  WriteLn('Create pipe failed.');
  WriteLn('Press any key to finish.');
  ReadLn;
  Exit;
end;

// устанавливаем атрибуты нового процесса
ZeroMemory(@si, SizeOf(STARTUPINFO));
si.cb := SizeOf(STARTUPINFO);
// использовать стандартные дескрипторы
si.dwFlags := STARTF_USESTDHANDLES;
// устанавливаем стандартные дескрипторы
si.hStdInput := hReadPipe;
si.hStdOutput := hWritePipe;
si.hStdError := hWritePipe;

// запускаем первого клиента
if not CreateProcess(nil, lpszComLine1, nil, nil, True,
                     CREATE_NEW_CONSOLE, nil, nil, si, pi) then
begin
  WriteLn('Create process failed.');
  WriteLn('Press any key to finish.');
  ReadLn;
  Exit;
end;

// закрываем дескрипторы первого клиента
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);

// запускаем второго клиента
if not CreateProcess(nil, lpszComLine2, nil, nil, True,
                     CREATE_NEW_CONSOLE, nil, nil, si, pi) then
begin
  WriteLn('Create process failed.');
  WriteLn('Press any key to finish.');
  ReadLn;
  Exit;
end;

// закрываем дескрипторы второго клиента
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);

// закрываем дескрипторы канала
CloseHandle(hReadPipe);
CloseHandle(hWritePipe);

WriteLn('The clients are created.');
WriteLn('Press Enter to exit.');
ReadLn;


except
on E: Exception do
begin
  Writeln(E.ClassName, ': ', E.Message);
end;
end;
end.

Код процесса-клиента 1:

program client1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
SysUtils,  Windows;

var
hReadFloat, hReadText: THandle;
lpszReadFloat, lpszReadText: PChar;
i, j: Integer;
nData: Single;
dwWaitResult: DWORD;

begin
try
// события для синхронизации обмена данными
lpszReadFloat := 'ReadFloat';
lpszReadText := 'ReadText';
hReadFloat := CreateEvent(nil, False, False, lpszReadFloat);
hReadText := CreateEvent(nil, False, False, lpszReadText);

// ждем команды о начале записи в анонимный канал
WriteLn('Press any key to start communication.');
ReadLn;

// пишем целые числа в анонимный канал
for i := 0 to 4 do
begin
  Sleep(500);
  WriteLn(i);
end;

// ждем разрешения на чтение плавающих чисел из канала
dwWaitResult := WaitForSingleObject(hReadFloat, INFINITE);
if dwWaitResult = WAIT_OBJECT_0 then
begin
  // читаем плавающие числа из анонимного канала
  for j := 0 to 4 do
  begin
    ReadLn(nData);
    WriteLn(Format('The number %2.1f is read from the pipe.', [nData]));
  end;
end;

// отмечаем, что можно читать текст из анонимного канала
SetEvent(hReadText);
// теперь передаем текст
WriteLn('This is a demo sentence.');

WriteLn('The process finished transmission of data.');
WriteLn('Press Enter to exit.');
ReadLn;

CloseHandle(hReadFloat);
CloseHandle(hReadText);
except
on E: Exception do
  Writeln(E.ClassName, ': ', E.Message);
end;
end.

Код процесса-клиента 2:

program client2;

{$APPTYPE CONSOLE}
{$R *.res}

 uses
SysUtils, Windows;

var
hReadFloat, hReadText: THandle;
lpszReadFloat, lpszReadText: PChar;
i, j: Integer;
nData: Integer;
dwWaitResult: DWORD;
lpszInput: array [0..79] of Char;

begin
try
// события для синхронизации обмена данными
lpszReadFloat := 'ReadFloat';
lpszReadText := 'ReadText';
hReadFloat := CreateEvent(nil, False, False, lpszReadFloat);
hReadText := CreateEvent(nil, False, False, lpszReadText);

// читаем целые числа из анонимного канала
for i := 0 to 4 do
begin
  ReadLn(nData);
  WriteLn(Format('The number %d is read from the pipe.', [nData]));
end;

// разрешаем читать плавающие числа из анонимного канала
SetEvent(hReadFloat);

// пишем плавающие числа в анонимный канал
for j := 0 to 4 do
begin
  Sleep(500);
  WriteLn((j * 0.1));
end;

// ждем разрешения на чтение текста
dwWaitResult := WaitForSingleObject(hReadText, INFINITE);
if dwWaitResult = WAIT_OBJECT_0 then
begin
  Write('The process read the text: ');
  // теперь читаем текст
  repeat
    Sleep(500);
    ReadLn(lpszInput);
    Write(lpszInput);
    Write(' ');
  until lpszInput[0] = #0;
end;

WriteLn;
WriteLn('The process finished transmission of data.');
WriteLn('Press Enter to exit.');
ReadLn;

CloseHandle(hReadFloat);
CloseHandle(hReadText);
except
on E: Exception do
  Writeln(E.ClassName, ': ', E.Message);
end;
end.

Ответы (1 шт):

Автор решения: TheExtrips

Проблема заключалась в том, что на C++ возможно реализовать перенаправление стандартного ввода-вывода, а на Delphi - нет.

Оставил клиенты на C++, сервак на дельфи переписал. Все работает нормально. Вопрос для себя решил.

→ Ссылка