Траблы с NamedPipes

[NetDigger]

Здравствуйте, уважаемые! Помогите разобраться с Named Pipes. Сделал простенькую программу - сервер и клиент. Сервер - окно с кнопарем CreateServer и клиент - с двумя Едитами и кнопарями Send и Receive. Запускаю сервер, нажимаю Create, запускаю клиент, набирают в одном Edit'е текст, жму на Send, затем на Receive - виснет клиент. Стоит закрыть сервер, вылетает ошибка(на клиенте), что типа не могу прочесть из канала ( ReadFile возвращает False) - чего только не перепробовал - не получается. Исходники:

Сервер

HP := CreateNamedPipe( '\\.\PIPE\test', PIPE_ACCESS_DUPLEX, PIPE_TYPE_BYTE or PIPE_READMODE_BYTE or
PIPE_NOWAIT, 255, 1000*SizeOf(AnsiChar), 1000*SizeOf(AnsiChar), 0, nil );
If HP = INVALID_HANDLE_VALUE then Begin
ShowMessage('Cannot create pipe!');
Halt;
End;

Клиент

Var
HPipe: Thandle;

procedure TForm1.Button1Click(Sender: TObject);
var
res: Boolean;
BytesWrt: DWORD;
BytesRd: DWORD;

len : DWORD;
begin
HPipe := CreateFile( '\\.\Pipe\test', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0 );
If HPipe = INVALID_HANDLE_VALUE then begin
ShowMessage('Cannot create file!');
halt;
End;

Messag := PAnsiChar(Edit1.Text + #0);
Len := Length( Messag) * SizeOf(AnsiChar) + 1;

res := WriteFile( Hpipe, Messag^, Len, BytesWrt, nil );
If not(res) then Begin
ShowMessage('Cannot write to pipe!');
halt;
End;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
res: Boolean;
BytesRd: DWORD;
InBuf: Array[0..512] of AnsiChar;
Begin

InBuf[0] := #0;
Res := ReadFile( hPipe, InBuf, 512, BytesRd, nil );
If not(res) then Begin
ShowMessage('Cannot read from pipe!');
halt;
End
Else
ShowMessage( StrPas( InBuf ) );

closeHandle( HPipe );


end;

 

[Guest]

NetDigger

набирают в одном Edit'е текст, жму на Send, затем на Receive - виснет клиент.

а причина зависона какая???

 

[Barmutik]

Ну так он её и ищет :huh:

Я пробовал .. у меня аналогичный вис ... так просто с ходу разобраться не смог ...

 

[Guest]

А у мя такая трабла:
Короче создаю пайп:

sNamePipe:= '\\.\pipe\' + Trim(sNamePipe);
dwMaxInstances:= 100;
dwOutBufferSize:= 1024;
dwInBufferSize:= 1024;
dwDefaultTimeOut:= 1000;
SetSecurityAttributes(sa, sd);
hNamedPipe:= Windows.CreateNamedPipe(PChar(sNamePipe), PIPE_ACCESS_DUPLEX,
PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE,
dwMaxInstances, dwOutBufferSize, dwInBufferSize, dwDefaultTimeOut, @sa);
if hNamedPipe = INVALID_HANDLE_VALUE then
begin
ShowMessage(SysErrorMessage(GetLastError));
CloseHandle(hNamedPipe);
Result:= (-3);
end
else
begin
SetSecurityInfo(hNamedPipe, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION or PROTECTED_DACL_SECURITY_INFORMATION, nil, nil, nil, nil);
Result:= 1;
end;


Когда запускаю сервер на своей машине и прошу с другой ко мне приконнектиться - все ок.
Когда запускаю сервер на чужой машине а со своей коннекчусь - ошибка что все экземпляры канала заняты - ERROR_PIPE_BUSY.

Хотя вроде как ConnectNamedPipe(hNamedPipe,nil); срабатывает.

В чем дело?

 

[klizardin]

Ты на сервер отправляешь данные, а кто их будет читать?
Читаешь с сервера данные, а то их на сервере будет записывать в pipe?

А у мя такая трабла:
Когда запускаю сервер на своей машине и прошу с другой ко мне приконнектиться - все ок.
Когда запускаю сервер на чужой машине а со своей коннекчусь - ошибка что все экземпляры канала заняты - ERROR_PIPE_BUSY.

Хотя вроде как ConnectNamedPipe(hNamedPipe,nil); срабатывает.

В чем дело?

Да очень просто нужно создавать pipe для каждого коннекта клиента. Т.е. вообще-то нет pipe-ов, которые сразу обращаются с несколькими клиентами. Глянь примеры из msdn-а о многопоточных серверах pipe-ов.

Ссылка скрыта от гостей

 

[Guest]

Ряд замечаний:
1) Лучше использовать блокируемый пайп (параметр PIPE_WAIT). В этом случае последующий код программы отрабатывается после подключения клиента.
2) Пропущена обязательная функция ConnectNamedPipe на стороне сервера, активирующая созданный пайп.
3) Инициализировать пайп нужно обязательно в отдельном потоке, иначе произойдет подвисание главного – режим ожидания подключения со стороны клиента.

Ко всему сказанному привожу куски рабочего кода:

Сервер:

[codebox]
var
hP: THandle;

procedure CloseChannel;
begin
if Assigned(@hP) then begin
CloseHandle(hP);
DisconnectNamedPipe(hP);
end;
end;

procedure CreateChannel; stdcall;
var
fConnected, fSuccess: Boolean;
cbBytesRead: Cardinal;
LocalBuffer : array [0..$FF] of Char;
tmpStr: string;
begin
hP:=CreateNamedPipe('\\.\PIPE\test',
PIPE_ACCESS_DUPLEX,
PIPE_TYPE_BYTE or PIPE_READMODE_BYTE or PIPE_WAIT,
255,
$FF,
$FF,
0,
nil);
if hP=INVALID_HANDLE_VALUE then begin
Form1.Memo1.Lines.Add('Unable to create the pipe.');
Exit;
end;
Form1.Memo1.Lines.Add('The pipe has been created.');
fConnected:=ConnectNamedPipe(hP, nil);
if fConnected then
repeat
fSuccess:=ReadFile(hP,
LocalBuffer,
SizeOf(LocalBuffer),
cbBytesRead,
nil);
until (not fSuccess) or (cbBytesRead=0);
begin
tmpStr:=StrPas(LocalBuffer);
Form1.Memo1.Lines.Add(tmpStr);
CloseChannel;
end;
end;

procedure TForm1.CloseButtonClick(Sender: TObject);
begin
CloseChannel;
end;

procedure TForm1.StartButtonClick(Sender: TObject);
var
dwThreadId: Thandle;
begin
CreateThread(
nil,
0,
@CreateChannel,
nil,
0,
dwThreadId);
end;
[/codebox]
Клиент:

[codebox]
procedure TForm1.SendButtonClick(Sender: TObject);
var
hPipe : Thandle;
fSuccess : boolean;
cbWritten : cardinal;
LocalBuffer : array [0..$FF] of Char;
begin
ZeroMemory(@LocalBuffer,SizeOf(LocalBuffer));
StrPCopy(LocalBuffer,Edit1.Text);
hPipe:=CreateFile('\\.\pipe\test',
GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
0,
0);
if hPipe = INVALID_HANDLE_VALUE then Exit;
fSuccess:=WriteFile(hPipe,
LocalBuffer,
SizeOf(LocalBuffer),
cbWritten,
nil);
CloseHandle(hPipe);
end;
[/codebox]