[dim302004]

Всем добрый день! Нужна помощь в устранении ошибки . Имеется исходник старой скада системы написанной на Delphi под х32.
Система клиент-сервер. После установки клиентской программы на вин 10 х64 начались проблемы. а именно при отправке запроса на сервер виснет наглухо. Анализ ошибок вин 10 выявил зависание named pipes. Клиентская программа компилирует скрипты на языке Tcl и отправляет и получает данные с сервера linux. Вот кусок кода с Pipes. Может что подправить для работы с вин 10?

Код:

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

procedure ThreadLoop;   var     WiteObj: Cardinal;   begin     // Создаем сокет-клиент     fSocketClnt := TWSocket.Create(nil);     with fSocketClnt do begin       MultiThreaded   := False;       OnBgException   := SocketClntBgException;       OnError         := SocketClntError;     end;     // Создаем сокет-сервер     fSocketSrv := TWSocket.Create(nil);     with fSocketSrv do begin       Proto := 'tcp';       Port := '0';       Addr := '127.0.0.1';       LineMode := False;       LineEnd := #0;       MultiThreaded := False;       OnSessionAvailable := SocketSrvSessionAvailable;       OnBgException := SocketSrvBgException;       OnError := SocketSrvError;       Listen;     end;     fServerPort := GetAssignedPortBySocket_ntohs(fSocketSrv);     SendLog(petInfo, [], 0, Format(LOG_SRVSTART, [ThreadID, fSocketSrv.Proto, fSocketSrv.Addr, GetAssignedPortBySocket_htons(fSocketSrv),       fServerPort]));     fReconnecting := False;     // Стартуем скриптер и зацикливаем сервер     if Start and not (fSIState in [sisStoping, sisTerminating]) then begin       SendLog(petInfo, [], 0, 'Запуск скриптового движка...');       FPipeHandle := CreateNamedPipe(         PWideChar('\\.\pipe\pipe_server_' + IntToStr(fProcessInfo.dwProcessId)),         PIPE_ACCESS_DUPLEX or FILE_FLAG_OVERLAPPED,         PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_WAIT,         PIPE_UNLIMITED_INSTANCES,         SizeOf(Integer),         SizeOf(Integer),         NMPWAIT_USE_DEFAULT_WAIT,         nil       );       if FPipeHandle <> INVALID_HANDLE_VALUE then       begin         FPipeDataEvent := TEvent.Create(nil, False, False, '');         RegisterWaitForSingleObject(WiteObj, FPipeDataEvent.Handle, WaitCallback, Self, INFINITE, WT_EXECUTEDEFAULT);         FillMemory(@FOPData, SizeOf(TOverlapped), 0);         FOPData.hEvent := FPipeDataEvent.Handle;         ConnectNamedPipe(FPipeHandle, @FOPData);         fSocketSrv.MessageLoop;         UnregisterWait(WiteObj);         CloseHandle(FPipeHandle);         FreeAndNil(FPipeDataEvent);       end;     end;     // Отключаем и уничтожаем клиента     fSocketClnt.Abort;     FreeAndNil(fSocketClnt);     // Отключаем и уничтожаем сервер     fSocketSrv.Abort;     FreeAndNil(fSocketSrv);     if fReconnecting then ThreadLoop;   end;    begin   for i := 0 to High(fSoundAlarmList) do   begin     fSoundAlarmList[i] := TSountAlarmListItem.Create;     with fSoundAlarmList[i] do     begin       DevStr := 'alarm_' + IntToStr(i) + '_' + IntToStr(Integer(Pointer(Self)));       DevID := 0;       IsPlay := False;     end;   end;   fThreadMsgWindow := CreateWindowEx(0, 'Message', PChar('MsgWindow_' + IntToStr(Integer(Pointer(Self)))), 0, 0, 0, 1, 1, HWND_MESSAGE, 0, 0, nil);   fThreadMsgWindowProc:= Classes.MakeObjectInstance(ThreadWndProc);   SetWindowLong(fThreadMsgWindow, GWL_WNDPROC, LongInt(fThreadMsgWindowProc));   fDTEStream := TXDRStream.Create;      ThreadLoop;      fDTEStream.Clear;   FreeAndNil(fDTEStream);   for i := 0 to High(fSoundAlarmList) do   begin     DoSoundAlarm('', False, 0, i);     fSoundAlarmList[i].Free;   end;   DestroyWindow(fThreadMsgWindow);   Classes.FreeObjectInstance(fThreadMsgWindowProc);   SendLog(petInfo, [], 0, SCR_STOP);   ReturnValue := 0; end; dim302004 вне форума Обратить внимание администрации на это сообщение   0

[lmikle]

Есть подозрение, что дело в правах доступа. В доке сказано следующее:

To create an instance of a named pipe by using CreateNamedPipe, the user must have FILE_CREATE_PIPE_INSTANCE access to the named pipe object. If a new named pipe is being created, the access control list (ACL) from the security attributes parameter defines the discretionary access control for the named pipe.

А у тебя последний аттрибут (как раз lpSecurityAttributes) вообще пустой.

попробуй создать пайп с PIPE_NOWAIT и через GetLastError получить ошибку. Подозреваю, что получишь ERROR_ACCESS_DENIED.

Хотя, мож и ошибаюсь.
Создай маленькое приложение только с этим пайпом и попробуй прогнать его в дебагере как простое приложение, а не в потоке. Посмотри что получится, почитай ошибки.

Вот тут есть неплохой пример:
https://stackoverflow.com/questions/...pipe-c-windows
Он на С++, но там в основном API, так что все понятно должно быть.