Обмен данными между процессами в Delphi XE3

Максим написал:

Максим — Fri, 06 Jan 2017 13:27:03 +0300

Если рассматривать функцию CompleteRead в отладчике, то при отправке с сервера: в клиенте она вызывается, входит в цикл, GetOverlappedResult возвращает в Result true и поэтому внутрь проверки мы не заходим, итерация завершается, а т.к. в начале цикла bContinue присвоили false, то и цикл завершается. Далее заходим в проверку if Result and not(FPendingRead) then Всё что там есть выполняется, далее мы попадаем в TPipeThread.Execute там опять-таки доходим до WaitForMultipleObjects и клиент виснет.

Максим написал:

Максим — Thu, 05 Jan 2017 18:35:41 +0300

При пошаговом выполнении в отадчике сообщения доходят и всё работает, но стоит запустить без отладчика, как сообщения перестают доходить, всё обрывается на отправке заголовка, как и раньше :sad:

Alex написал:

Alex — Thu, 05 Jan 2017 15:57:27 +0300

У меня всё работает поэтому мне сложно понять, что идёт не так. На какой строке кода виснет?

Максим написал:

Максим — Wed, 04 Jan 2017 22:44:46 +0300

Ещё немного потестил. Если сразу отправлять с заголовками данные с сервера или клиента, то ничего не доходит. А если сначала отправить без них с сервера несколько сообщений, потом с клиента тоже без заголовков несколько сообщений, то после этого и с заголовками начинает нормально отправлять.

Максим написал:

Максим — Wed, 04 Jan 2017 13:59:13 +0300

И на клиенте и на сервере получаю уведомление об отправке, но сообщения не доходят и клиент виснет. https://cloud.mail.ru/public/L2wM/dkiGFWanF

Alex написал:

Alex — Wed, 04 Jan 2017 11:18:56 +0300

У меня хорошо работает. Попробуйте мои тестовые проекты (в архиве исходники и exe-шники): https://yadi.sk/d/eZF1Iog536qCYv

Максим написал:

Максим — Tue, 03 Jan 2017 20:45:23 +0300

Как-то через раз работает. Если отправлять с клиента на сервер, то всё нормально, как только отсылаю с сервера на клиент - сообщение не доходит и после этого уже и с клиента не идёт.

Alex написал:

Alex — Tue, 03 Jan 2017 20:02:07 +0300

Ещё поковырялся с этой проблемой. Оказалось, что клиент зависает из-за зависания сервера в функции TPipeThread.CompleteRead в строке Result := GetOverlappedResult(FPipe, FOlapRead, FRcvRead, TRUE); Попробуйте заменить код функции на следующий (у меня так работает): function TPipeThread.CompleteRead : Boolean; var bContinue: boolean; begin // Reset the read event and pending flag ResetEvent(FOlapRead.hEvent); // Reset pending read FPendingRead := FALSE; // Check the overlapped results //Result := GetOverlappedResult(FPipe, FOlapRead, FRcvRead, TRUE); bContinue := true; while bContinue do begin bContinue := false; Result := GetOverlappedResult(FPipe, FOlapRead, FRcvRead, FALSE); // Handle failure if not(Result) then begin // Get the last error code FErrorCode := GetLastError; if (FErrorCode = ERROR_IO_INCOMPLETE) then begin // Operation is still pending, allow while loop bContinue := true; FErrorCode := 0; end else if (FErrorCode = ERROR_HANDLE_EOF) then begin FErrorCode := 0; Result := true; end // Check for more data else if (FErrorCode = ERROR_MORE_DATA) then begin // Write the current data to the stream FRcvStream.Write(FRcvBuffer^, FRcvSize); // Determine how much we need to expand the buffer to Result := PeekNamedPipe(FPipe, nil, 0, nil, nil, @FRcvSize); // Check result if Result then begin // Determine if required size is larger than allocated size if (FRcvSize > FRcvAlloc) then begin // Realloc buffer ReallocMem(FRcvBuffer, FRcvSize); // Update allocated size FRcvAlloc := FRcvSize; end; // Set overlapped fields ClearOverlapped(FOlapRead); // Read from the file again Result := ReadFile(FPipe, FRcvBuffer^, FRcvSize, FRcvRead, @FOlapRead); // Handle error if not(Result) then begin // Set error code FErrorCode := GetLastError; // Check for pending again, which means our state hasn't changed if (FErrorCode = ERROR_IO_PENDING) then begin // Still a pending read FPendingRead := TRUE; // Success Result := TRUE; end; end; end else // Set error code FErrorCode := GetLastError; end; end; end; // Check result and pending read flag if Result and not(FPendingRead) then begin // We have the full message FRcvStream.Write(FRcvBuffer^, FRcvRead); // Call the OnData DoMessage; end; end;

Максим написал:

Максим — Mon, 02 Jan 2017 22:32:02 +0300

Понятно, тогда получается нужно определить почему после записи заголовка перестают писаться данные. И судя по всему уже при записи заголовка, несмотря на то что функция WriteFile возвращает true, происходит что-то не по плану, потомучто в серверной компоненте не вызывается функция QueuedWrite после записи заголовка в клиенте.

Alex написал:

Alex — Mon, 02 Jan 2017 22:09:48 +0300

Да. Только в данном случае запись не в файл, а в канал. С помощью функции WriteFile данные пишутся не только в файл, но и в канал, почтовые слоты и т.п. 1 раз записывается голова (определённый набор байт, определяющий начало пакета данных). 2 раз записывается ваше сообщение. 3 раз записывается хвост (определённый набор байт, определяющий конец пакета данных). Почему так делается: Вы не можете записать в канал более 64Кб за один раз (такие ограничения). Поэтому разработчик компонента решил сделать так: всегда сначала писать заголовок (см. EnqueueStartPacket), затем сами данные разбитые на куски размером не более 64Кб, а затем хвост (см. EnqueueEndPacket). Таким образом, компонент может передавать серверу неограниченный объём данных. Можно было бы сделать проверку объёма данных и, если он меньше 64К, то не писать голову и хвост, но разработчик, видимо, поленился и пишет голову и хвост всегда, поэтому WriteFile вызывается три раза. Сервер TPipeServer, спокойно понимает как данные с головой и хвостом, так и данные без них. Кстати, моя функция SendMessageToServer пишет данные как есть, т.е. без добавления головы и хвоста. Поэтому вы не сможете с помощью неё передать за раз более 64К. 997 – это очень хорошо. 997 – это ERROR_IO_PENDING. Это значит, что данные пишутся и нужно подождать, когда запись завершится. Просто здесь запись происходит асинхронно (см. параметр lpOverlapped). Поэтому функция WriteFile, при успешном вызове, сразу возвращает true, а данные начинают записываться в отдельном потоке. А после того как данные запишутся, установится событие hEvent в структуре lpOverlapped: https://msdn.microsoft.com/en-us/library/windows/desktop/ms684342(v=vs.85).aspx.

Максим написал:

Максим — Mon, 02 Jan 2017 19:43:42 +0300

На берлине же после первого вызова WriteFile в клиенте флаг bWrite равен true, однако, вызова QueuedWrite на сервере не происходит и при следующих вызовах WriteFile на клиенте флаг bWrite становится false. При этом FErrorCode всё так же 997.

Максим написал:

Максим — Mon, 02 Jan 2017 19:41:03 +0300

А зачем вообще он производит запись в файл? Так и происходит общение что ли, один пишет в файл, другой читает? Посмотрел отладку на сиэтле, функция QueuedWrite, в которой находится WriteFile, вызывается три раза при попытке отправить данные небольшого размера, сразу же после первого вызова WriteFile в клиенте происходит вызов QueuedWrite на сервере, там доходит до проверки if (WaitForSingleObject(FEvents[3], 0) = WAIT_OBJECT_0) then и внутрь не заходит. Далее ещё два раза происходит ровно тоже самое, bWrite всегда true, а вот FErrorCode всегда 997, что не есть хорошо, как мне кажется. Продолжение в следующем сообщении.

Alex написал:

Alex — Mon, 02 Jan 2017 18:38:52 +0300

Функция SendMessageToServer при каждом вызове сначала коннектится, потом отправляет данные, потом разрывает соедиение. Таймаут срабатывает из-за того, что у вас открыт диалог. По событию OnConnect просто пишите в Memo вот так: procedure TForm1.OnConnect(Sender: TObject; Pipe: HPIPE); begin //ShowMessage(Format('Коннект клиента %d', [Pipe])); Memo.Lines.Add(Format('Коннект клиента %d', [Pipe])); end;

Alex написал:

Alex — Mon, 02 Jan 2017 18:30:45 +0300

На другом компьютере с Win 7 у меня тоже не заработало. Поковырявшись в исходниках я нашёл, что работает не так, но как исправить не знаю. Дело в том, что функция WriteFile: https://msdn.microsoft.com/ru-ru/library/windows/desktop/aa365747(v=vs.85).aspx (строка 2791) возвращает false, что значит, что запись не прошла. При этом функция GetLastError, которая вызывается чуть ниже, возвращает 0, что значит, что ошибки нет. В общем данные не отправляются, а функция FlushPipeBuffers ждёт пока они отправятся, т.е. происходит зависание. Синхронная отправка у меня работает, просто я немного переписал функцию: procedure TForm1.SendMessageToServer(inputStream: TStringStream; timeout: DWORD); var lpNumberOfBytesWritten: DWORD; lpMode: DWORD; pipe: THandle; lastError: integer; olapRead: TOverlapped; olapWrite: TOverlapped; events: array [0 .. 0] of THandle; begin pipe := INVALID_HANDLE_VALUE; ClearOverlapped(olapRead, True); ClearOverlapped(olapWrite, True); try olapRead.hEvent := CreateEvent(nil, True, False, nil); olapWrite.hEvent := CreateEvent(nil, True, False, nil); try while True do begin pipe := CreateFile(PChar('\\.\pipe\' + Client.PipeName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); if pipe <> INVALID_HANDLE_VALUE then break; if GetLastError <> ERROR_PIPE_BUSY then RaiseLastOSError; Win32Check(WaitNamedPipe(PChar('\\.\pipe\' + Client.PipeName), timeout)); end; lpMode := PIPE_READMODE_MESSAGE; Win32Check(SetNamedPipeHandleState(pipe, lpMode, nil, nil)); if WriteFile(pipe, inputStream.Memory^, inputStream.Size, lpNumberOfBytesWritten, @olapWrite) then begin FlushFileBuffers(pipe); ResetEvent(olapWrite.hEvent); end else begin lastError := GetLastError; if lastError = ERROR_IO_PENDING then begin events[0] := olapWrite.hEvent; case WaitForMultipleObjects(1, @events, false, timeout) of WAIT_OBJECT_0: begin if GetOverlappedResult(pipe, olapWrite, lpNumberOfBytesWritten, True) then FlushFileBuffers(pipe) else RaiseLastOSError; end; WAIT_TIMEOUT: raise Exception.Create('За отведённое время не удалось отправить сообщение.'); else RaiseLastOSError; end; end else RaiseLastOSError(lastError); end; finally CloseHandle(olapRead.hEvent); CloseHandle(olapWrite.hEvent); end; finally if pipe <> INVALID_HANDLE_VALUE then CloseHandle(pipe); end; end; Вызывать вот так: procedure TForm1.Button2Click(Sender: TObject); var str: TStringStream; begin str := TStringStream.Create; str.WriteString(Edit.Text); SendMessageToServer(str, 2000); str.Free; end;

Максим написал:

Максим — Sun, 01 Jan 2017 21:46:33 +0300

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

Максим написал:

Максим — Thu, 29 Dec 2016 21:53:46 +0300

А вот это очень странно, теперь даже не знаю куда копать, на Win 7 же проверялось? Как уже говорил пробовал на двух виртуалках и двух физических машинах, а ещё просил другого человека проверить и у него так же не заработало на Win 7 :o Плюс сейчас запустил винду на виртуалке в безопасном режиме и опять клиент повис при отправке.

Alex написал:

Alex — Thu, 29 Dec 2016 15:05:11 +0300

Ваши exe-шники у меня тоже работают.

Максим написал:

Максим — Wed, 28 Dec 2016 19:59:00 +0300

Ну да, версии студии и Pipes.pas (04.10.2013 - arno.garrels@gmx.de added 64-bit) те же, Windows то же естественно с SP1, но я тестировал и на виртуалке с семёркой, там вообще нет никаких программ, которые могли бы помешать и ещё на двух реальных машинах, нигде не работало. А вы не пробовали мои exe которые в архиве шли, может быть они у вас работают? Но вряд ли конечно. Ещё я на виртуалку с десяткой ставил Starter версию и результат был таким же плачевным.

Alex написал:

Alex — Wed, 28 Dec 2016 09:48:52 +0300

Проверил сейчас на Berlin Update 2 - у меня всё работает. С клиента сообщения прекрасно отправляются на сервер и обратно. Версия студии: Embarcadero® RAD Studio 10.1 Berlin Version 24.0.25048.9432 Установленные обновления: Delphi 10.1 Berlin and C++ Builder 10.1 Berlin Update 2 Операционка: Windows 7 SP 1 Версия файла Pipes.pas от 04.10.2013 (Win64). Может быть программа какая-нибудь мешает, установленная на вашем компьютере. Например, антивирус.

Maximus написал:

Maximus — Tue, 27 Dec 2016 07:53:20 +0300

И ещё странности. Если всё же в берлине что-то сломали, то почему в Win 10 этот же код работает без проблем? Так же заметил интересную зависимость, не знаю как это связано, но если на семёрке запустить TeamViewer в режиме управления, то сообщения начинают доходить, как только отключаем его - сообщения перестают пересылаться.

Maximus написал:

Maximus — Mon, 26 Dec 2016 23:12:40 +0300

На Seattle у меня тоже работало, но откатываться ради этого не хочется. С SendMessageToServer всё ещё более странно, при отправке с клиента, на сервере срабатывает событие OnConnect, потом данные всё же приходят, но через заданный таймаут клиентское приложение оповещает о том что сообщение не удалось отправить за отведённое время. Хотелось бы всё же исправить как-то работу на берлине.

Alex написал:

Alex — Mon, 26 Dec 2016 22:06:02 +0300

Я попробовал скомпилировать ваш пример на Delphi 10 Seattle - всё работает. Сообщения отправляются и приходят с клиента на сервер и обратно. Возможно в Berlin как-то по другому обрабатываются оконные сообщения Windows, ведь компоненты TPipeClient и TPipeServer работают именно с помощью оконных сообщений. Попробуйте послать сообщение серверу с помощью моей функции SendMessageToServer (в самом низу статьи). Параметр waitForAnswer поставьте в true.

Maximus написал:

Maximus — Sun, 25 Dec 2016 13:51:52 +0300

Есть вот такой примерчик https://cloud.mail.ru/public/AAim/bvbjLxHuB Сегодня даже с серверного приложения к клиентскому не пошли данные на Win 7, коннект проходит, а сообщения не идут. При этом переношу приложения на виртуалку с десяткой и всё работает. На виртуалке с Win 7 тоже проверялось и тоже не работает.

Alex написал:

Alex — Sun, 25 Dec 2016 09:26:07 +0300

Я не тестировал. А у вас есть готовый пример?

Maximus написал:

Maximus — Sat, 24 Dec 2016 21:36:13 +0300

Никто не тестировал на новой версии студии Berlin Update 2? Почему-то на Win 7 появилась проблема с отправкой данных (SendStream) от клиента к серверу. В процедуре TPipeClient.FlushPipeBuffers; происходит блокирование потока на втором вызове MsgWaitForMultipleObjects. Однако на Win 10 всё прекрасно. Раньше не было никаких проблем.

Sanders написал:

Sanders — Sat, 30 Jul 2016 00:43:55 +0300

Awesome!! Премного благодарен!

Alex написал:

Alex — Fri, 29 Jul 2016 14:31:23 +0300

Пожалуйста. Я уже сталкивался с нехваткой таймаута. Добавил в статью вариант функции с таймаутом.

Sanders написал:

Sanders — Thu, 28 Jul 2016 14:52:50 +0300

Спасибо за статью, и особенно за SendMessageToServer! Но в SendMessageToServer не хватает входного параметра Timeout. Скажем, если на стороне сервера exception и ответить он не смог, надо через какое-то время (Timeout) прекращать ожидание ответа и вываливаться...

Alex написал:

Alex — Wed, 30 Mar 2016 18:55:51 +0300

Этот метод не будет работать внутри любых оконных сообщений/событий. Например, если вы по событию кнопки OnClick отправляете сообщение серверу и затем хотите дождаться ответа с помощью метода WaitForReply, то у вас ничего не получится. А вот, если вы сделаете клиента в потоке и пошлёте с помощью этого клиента сообщение серверу, то этот метод должен будет работать. Читайте комментарии в начале файла Pipes.pas.

ht написал:

ht — Wed, 30 Mar 2016 16:22:34 +0300

а WaitForReply у класса TPipeClient не решает задачу с ожиданием ответа от сервера?

Alex написал:

Alex — Fri, 29 Jan 2016 09:36:08 +0300

Это я уже понял. А реально сделать что то типа полностью асинхронного обмена. Задача стоит такая: Сервер, написанный на дельфях получает котировки (структура полей double) от многих клиентов, что то там считает, и по результатам этих расчетов передает клиентам соответствующие команды (в идеале - строки, но можно и целые числа, а-ля коды). Причем этот обмен в сторону сервера идет с приличной скоростью (несколько тиков в секунду), а обратно одному Богу известно, может и ни одной команды в день, а может и по несколько в минуту. Реально это с помощью пайпов сделать? Если да, был бы признателен за наводку :-). Это сделать реально. Только учтите, что пайпы предназначены для взаимодействия процессов работающих на одном компьютере. Если клиенты удалённые, то нужно взаимодействовать через сокеты.

Дмитрий написал:

Дмитрий — Thu, 28 Jan 2016 22:09:40 +0300

Alex написал:

Alex — Thu, 28 Jan 2016 20:07:21 +0300

Вообще работает это примерно так: сервер и клиент устанавливают соединение и после этого оба ждут друг от друга сообщений. Т.е. пока один из них чего нибудь не пошлёт, другой будет висеть и ждать. Если вы пытаетесь клиентом, прочесть что нибудь из канала, то клиент естественно зависнет и будет ждать, пока сервер что-нибудь запишет в этот канал. Это нормальная ситуация.

Дмитрий написал:

Дмитрий — Thu, 28 Jan 2016 15:58:57 +0300

Спасибо вам за полезную информацию в статье. Если позволите, вопрос: Сервер реализован на RAD XE7. Клиенты - суть разные приложения. Например, MetaTreader4. Связь с сервером устанавливается нормально, данные от клиентов он получает, но как только со стороны клиента идет попытка прочитать что нибудь от сервера, весь процесс стопорится (. Сервер чего то ждет.

Alex написал:

Alex — Fri, 08 May 2015 14:37:57 +0300

Добавлен юнит Pipes.pas с поддержкой платформы Win64. В архиве с юнитом присутствуют также примеры и runttime и designtime библиотеки.

Alex написал:

Alex — Wed, 06 May 2015 19:19:31 +0300

Написал вам письмо на почту.

Андрей написал:

Андрей — Wed, 06 May 2015 19:13:08 +0300

Доброго времени Суток! Если Вы скинете мне свой e-mail я Вам перекину пример проекта... По поводу Оконных Событий я понял... Но вот как это реализовать... ? Конечно можно сделать, клиент подключился, передал данные отключился... так все будет работать но в этой логике есть неправильность или незавершенность что-ли )))) Благодарю, что откликнулись!

Alex написал:

Alex — Wed, 06 May 2015 18:44:52 +0300

Сложно сказать, что у вас не так. События компонентов TPipeClient и TPipeServer функционируют на основе оконных сообщений Windows. Именно здесь узкое место. Нужно смотреть, что происходит у вас в программе между отправкой данных первый и второй раз. Как вы обрабатываете события компонентов. Присылайте пример сервера и клиента.

Андрей написал:

Андрей — Tue, 05 May 2015 17:42:40 +0300

Приветвую! Попробовал использовать PIPEClient в Dll, проблемма с Передачей информации серверу, Проходит первые данные, потом Клиент пишет данные уходят, К серверу не доходят... Если компонент Клинета на форме, то проблемм с работой нет, переношу код в DLL проблема всплывает =(