Текущий архив: 2006.04.23;
Скачать: CL | DM;

Вниз

Передача данных по "именованным каналам"... Не идет.   Найти похожие ветки 

← →
DeadMeat ©   (2006-01-10 14:59) [0]

Здравствуйте!

Я тут все пытаюсь написать некое подобие передачи видео потока по сети. В начале использовал UDP (уже задавал по этому поводу вопрос), но сейчас обратил внимание на "именованные каналы". Учитывая, что вся работа будет вестись только в локальной сети в которой присутствуют лишь операционные системы семейства Microsoft (Windows XP/2k), я решил выбрать именно NamedPipes как основу для передачи.
Скачал пример Игоря Шевченко, который шел вместе с его статьей по использованию "именованных каналов". Почитал MSDN и вроде как "родил" чтото близкое к истине. И вроде даже работает.... На локальном компьютере. Стоило только вывести "это" в сеть, как столкнулся с проблемой. Отправляемый поток (картинка) имеет размер (примерно) 70кб. К клиенту приходит лишь (примерно) 4кб.
Вроде как все сделал как в обоих примерах (пример Игоря и из MSDN), но переделал немного под свои нужды. По идее все должно быть ровно. Но нет.
Привожу код (комментарии и большая часть кода сохранены с оригинала), разбитый на куски:

Создание канала на сервере:

procedure ServerProc (Param: Pointer); stdcall;
var
 Dummy: ULONG;
 hPipe: THANDLE;
 bytesRead: DWORD;
 rc: Boolean;
 LastError: DWORD;

 OverLapWrt: OVERLAPPED;
 hEventWrt: THANDLE;
 OverLapRd: OVERLAPPED;
 hEventRd: THANDLE;
 pSD: PSECURITY_DESCRIPTOR;
 sa: SECURITY_ATTRIBUTES;

 bufclient: PClientInfo;
begin
 lastError := 0;
 // Создать пустой дескриптор безопасности, позволяющий всем писать в канал.
 // Предупреждение: Указание nil в качестве последнего параметра функции
 // CreateNamedPipe() означает, что все клиенты, подсоединившиеся к каналу
 // будут иметь те же атрибуты безопасности, что и пользователь, чья учетная
 // запись использовалась при создании серверной стороны канала.
 pSD := PSECURITY_DESCRIPTOR(LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH));
 if not Assigned(pSD) then
 begin
   MessageBox (0, "Error allocation memory for SD", "Debug: ServerProc()", MB_OK);
   Exit;
 end;
 if not InitializeSecurityDescriptor (pSD, SECURITY_DESCRIPTOR_REVISION) then
 begin
   MessageBox (0, "Debug: ServerProc(): InitializeSecurityDescriptor", "Debug: ServerProc()", MB_OK);;
   LocalFree(HLOCAL(pSD));
   Exit;
 end;
 // Добавить NULL ACL к дескриптору безопасности
 if not SetSecurityDescriptorDacl(pSD, true, nil, false) then
 begin
   MessageBox (0, "Debug: ServerProc():SetSecurityDescriptorDacl", "Debug: ServerProc()", MB_OK);;
   LocalFree(HLOCAL(pSD));
   Exit;
 end;
 sa.nLength := sizeof(sa);
 sa.lpSecurityDescriptor := pSD;
 sa.bInheritHandle := true;
 // Создать серверную часть канала на локальной машине
 hPipe := CreateNamedPipe (pchar ("\\.\PIPE\"+pipename), // Имя канала
   PIPE_ACCESS_DUPLEX or          // Двусторонний канал
   FILE_FLAG_OVERLAPPED,          // Асинхронный ввод-вывод
   PIPE_WAIT or                   // Ожидать сообщений
   PIPE_READMODE_BYTE or          // Обмен в канале производится пакетами
   PIPE_TYPE_BYTE,
   PIPE_UNLIMITED_INSTANCES,      // Максимальное числе экземпляров канала.
   BUFSIZE,                       // Размеры буферов чтения/записи.
   BUFSIZE,
   TIME_OUT,                      // Тайм-аут.
   @sa);                          // Атрибуты безопасности.
//    nil);                          // Атрибуты безопасности.
 if hPipe = INVALID_HANDLE_VALUE then
 begin
   MessageBox (0, "Debug: ServerProc():CreateNamedPipeW", "Debug: ServerProc()", MB_OK);
   Exit;
 end;
 // Ожидаем подключения клиента.
 ConnectNamedPipe(hPipe, nil);
 // Создаем событие ожидания завершения записи в канал.
 hEventWrt := CreateEvent (nil, true, false, nil);
 FillChar(OverLapWrt, sizeof(OVERLAPPED), 0);
 OverLapWrt.hEvent := hEventWrt;
 // Создаем событие ожидания завершения чтения из канала.
 hEventRd := CreateEvent (nil, true, false, nil);
 FillChar(OverLapRd, sizeof(OVERLAPPED), 0);
 OverLapRd.hEvent := hEventRd;
 // Для подсоединившегося клиента заполним его описание

 New (bufclient);

 bufclient.hPipe := hPipe;
 bufclient.Live := true;
 bufclient.OverLap := OverLapWrt;
 bufclient.hEvent := hEventWrt;
 // первым сообщением от клиента должно быть его имя
 rc := ReadFile (hPipe, inBuf[0], BUFSIZE, bytesRead, @OverLapRd);
 if not rc then
   lastError := GetLastError;
 if lastError = ERROR_IO_PENDING then  // Ожидаем завершения ввода-вывода
   WaitForSingleObject (hEventRd, INFINITE);
 // Запоминаем имя текущего клиента.
 GetOverlappedResult (hPipe, OverLapRd, bytesRead, false);
//  FillChar (bufclient.Name,Length (bufclient.Name),#0);
 SetLength (bufclient.Name, bytesRead);
 CopyMemory (@bufclient.Name[1], @inBuf[0], bytesRead);

 Clients.Add (bufclient);

 bufclient.Index := Clients.Count-1;

 // Запускаем новый поток для ожидания нового клиента
 CreateThread (nil, 0, @ServerProc, Param, 0, Dummy); //Поток выполняется сразу

 repeat
   rc := ReadFile (hPipe, Dummy, 0, Dummy, @OverLapRd); //Тут мы крутимся пока клиент не закроется.
                                                        //Может есть и другой способ, но искать было влом.
                                                        //Все равно от клиента ничего не ждем
   lastError := 0;
   if not rc then
   begin
     lastError := GetLastError;
   end;
   if lastError = ERROR_IO_PENDING then WaitForSingleObject (hEventRd, INFINITE);
 until lastError = ERROR_BROKEN_PIPE;

 bufclient.Live := false;

 CloseHandle (hPipe);
 CloseHandle (hEventRd);
 CloseHandle (hEventWrt);
 DisconnectNamedPipe (hPipe);  // Разрушаем экземпляр канала
 ExitThread(0);                // Завершаем обслуживающий поток.
end;


---

← →
DeadMeat ©   (2006-01-10 14:59) [1]

[продолжение]
Отправка данных клиенту:

function SendToClient (bufnm: string; bufmem: TMemoryStream): boolean; //bufmem - это поток с одной картинкой
var
 bufclient: PClientInfo;
 rc: boolean;
 lastError: DWORD;
 bytesWritten: DWORD;
begin
 result := false;

 bufclient := FindClient (Clients, bufnm);

 if (bufclient <> nil) and (bufclient.Live) then
 begin
   bufmem.Position := 0;

   rc := WriteFile (bufclient.hPipe, bufmem.Memory^, bufmem.Size, bytesWritten, @bufclient.overLap);
     // Проверка на три вида ошибки: IO_PENDING, NO_DATA и остальные.
     // Для случая IO_PENDING ожидать завершения асинхронного ввода-вывода
     // на событии клиента, во всех остальных случаях, кроме NO_DATA
     // считать клиента умершим и отметить факт его смерти в описании клиента.

   if not rc then
   begin
     lastError := GetLastError;
     if lastError = ERROR_IO_PENDING then //Ждем завершения операции
       WaitForSingleObject (bufclient.hEvent, INFINITE)
     else
     begin
       if lastError <> ERROR_NO_DATA then //Клиент умер по причине lastError
         bufclient.Live := false;
     end;
     if (lastError <> ERROR_IO_PENDING) and (lastError <> ERROR_NO_DATA) then
       MessageBox(0, pchar (SysErrorMessage(lastError)), "SERVER: Debug WriteFile", MB_OK);
   end
   else
     result := true;
 end;
end;


Тип:

type
 PClientInfo = ^TClientInfo;
 TClientInfo = packed record
   hPipe: THANDLE;
   hEvent: THANDLE;
   overLap: OVERLAPPED;
   Live: LongBool;
   Index: Integer;
   Name: string[255];
 end;


Список клиентов - это простой TList (Clients: TList;)

inBuf - это промежуточный буфер (inBuf: array of byte;), который инициализируется при запуске (SetLength (inBuf, bufsize);)

bufsize равен 1024*1024 байт.

---

← →
DeadMeat ©   (2006-01-10 15:00) [2]

[продолжение]
Теперь клиентская часть....

Подключение к каналу:

function ConnectToPipe (host: string): boolean;
var
 retcode: DWORD;
 rc: boolean;
 ClntName: array [0..254] of Char; // Имя клиента
 nmsize: cardinal;
 bytesWritten: DWORD;
 Dummy: ULONG;
begin
 result := false;

 hPipe := CreateFile (pchar ("\\"+host+"\pipe\"+pipename),
   GENERIC_WRITE or // Доступ на чтение/запись
   GENERIC_READ,
   FILE_SHARE_READ or // Разделенный доступ
   FILE_SHARE_WRITE,
   nil,
   OPEN_EXISTING,   // Канал должен существовать
   FILE_FLAG_OVERLAPPED, // Использовать асинхронный ввод/вывод
   0);

 if hPipe = INVALID_HANDLE_VALUE then
 begin
   retCode := GetLastError;
   // Проверить попытку подключения к несуществующему каналу
   if (retCode = ERROR_SEEK_ON_DEVICE) or (retCode = ERROR_FILE_NOT_FOUND) then
//      MessageBox (0, "CANNOT FIND PIPE: Assure Server32 is started, check share name.", "", MB_OK)
     else
       begin
         // Не удалось подключиться по другой причине
         MessageBox(0, pchar (SysErrorMessage(retCode)), "Debug Window:CreateFile", MB_OK or MB_ICONINFORMATION or MB_APPLMODAL);
       end;
   Exit;
 end;

 hEventWrt := CreateEvent (nil, true, false, nil);
 OverLapWrt.hEvent := hEventWrt;
 // Сообщить серверу свое имя
 nmsize:=Length (ClntName);
 GetComputerName (ClntName, nmsize);

 rc := WriteFile (hPipe, ClntName, nmsize, bytesWritten, @OverLapWrt);
 if not rc then // Если IO_PENDING, ожидать звершения операции
   if GetLastError = ERROR_IO_PENDING then WaitForSingleObject (hEventWrt, INFINITE);

 // Создать поток чтения из канала.
 CreateThread (nil, 0, @ReadPipe, @hPipe, 0, Dummy);

 result := true;
end;


Обслуживающий поток:

procedure ReadPipe (hPipe: PHANDLE); stdcall;
var
 bytesRead: DWORD;
 rc: Boolean;
 lastError: DWORD;
 hEventRd: THANDLE;
 OverLapRd: OVERLAPPED;
 bytesTrans: DWORD;
begin
 hEventRd := CreateEvent (nil, true, false, nil);
 FillChar (OverLapRd, sizeof(OVERLAPPED), 0);
 OverLapRd.hEvent := hEventRd;
 // Бесконечный цикл чтения из канала, до тех пор,пока не разорвется соединение
 // Чтение происходит асинхронно, с ожиданием по событию. После того, как сооб-
 // щение прочитано, оно помещается в элемент редактирования.
 while true do
 begin
   rc := ReadFile (hPipe^, inBuf[0], bufsize, bytesRead, @OverLapRd);
   if not rc then
   begin
     lastError := GetLastError;
     // Проверка на три вида ошибки:
     // IO_PENDING (ожидать завершения операции), BROKEN_PIPE (выйти из цикла)
     // и остальные (выдать сообщение, выйти из цикла и умереть)
     if lastError = ERROR_IO_PENDING then
     begin
       WaitForSingleObject (hEventRd, INFINITE);
     end
     else
     begin
       if lastError = ERROR_BROKEN_PIPE then
//          MessageBox (0, "The connection to this client has been broken.", "", MB_OK)
         Form1.Timer1.Enabled := true
         else MessageBox (0, pchar (SysErrorMessage(lastError)), "Client: Debug():ReadFile", MB_OK);
       Break;
     end;
   end;

   if not GetOverlappedResult (hPipe^, OverLapRd, bytesTrans, false) then
     begin
       lastError := GetLastError;
       if lastError = ERROR_IO_INCOMPLETE then WaitForSingleObject (hEventRd, INFINITE)
         else MessageBox (0, pchar (SysErrorMessage(lastError)), "Client: Debug():GetOverlappedResult", MB_OK);
     end;

   if bytesTrans > 0 then //вот здесь и приходит лишь (примерно) 4кб
   begin
     mem.Clear;
     mem.Write(inBuf[0], bytesTrans);
     mem.Position := 0;

     currentframeJPG.LoadFromStream(mem);
     Form1.Canvas.StretchDraw(Form1.ClientRect,currentframeJPG);

//      currentframeBMP.LoadFromStream(mem);
//      Form1.Canvas.StretchDraw(Form1.ClientRect,currentframeBMP);

     newPing := random (65535);
   end;
 end;
 ExitThread(0);
end;


Нижайше прошу прощения за объем вопроса. Просто решил выложить весь код, дабы не возникло вопросов с уточнениями.
Я проверял и асинхронный режим и синхронный. При любом раскладе размер одинаков (входящих данных).

Что я упустил тут?

---

← →
DeadMeat ©   (2006-01-11 16:23) [3]

Немного упростил код.. Просто для проверки:
Сервер:
procedure TForm1.Button1Click(Sender: TObject);
var
 hPipe: THandle;
 mem: TMemoryStream;
 bytesWritten: DWORD;
 lastError: ULONG;
begin
 mem := TMemoryStream.Create;
 mem.LoadFromFile ("c:\bliss.bmp");

 hPipe := CreateNamedPipe ("\\.\PIPE\brd_new", PIPE_ACCESS_DUPLEX, PIPE_TYPE_BYTE or PIPE_WAIT, 10, bufsize, bufsize, 0, nil);

 if hPipe = INVALID_HANDLE_VALUE then
 begin
   lastError := GetLastError;
   ShowMessage (SysErrorMessage (lastError));
   Exit;
 end;

//  SetSecurityInfo (hPipe, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION or PROTECTED_DACL_SECURITY_INFORMATION, nil, nil, nil, nil);

 ConnectNamedPipe(hPipe, nil);

 while true do
 begin
   mem.Position := 0;
   if not WriteFile (hPipe, mem.Memory^, mem.Size, bytesWritten, nil) then
   begin
     lastError := GetLastError;
     ShowMessage (SysErrorMessage (lastError));
     Exit;
   end;
   caption := inttostr (bytesWritten);
   Application.ProcessMessages;
 end;
end;


Клиент:
procedure TForm1.Button2Click(Sender: TObject);
var
 hPipe: THandle;
 mem: TMemoryStream;
 bufer: array of byte;
 bytesRead: DWORD;
 bufpict: TBitmap;
 lastError: ULONG;
begin
 mem := TMemoryStream.Create;
 bufpict := TBitmap.Create;

 SetLength (bufer, bufsize);

 hPipe := CreateFile ("\\DeadMeat\PIPE\brd_new", GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);

 if hPipe = INVALID_HANDLE_VALUE then
 begin
   lastError := GetLastError;
   ShowMessage (SysErrorMessage (lastError));
   Exit;
 end;

 while true do
 begin
   if not ReadFile (hPipe, bufer[0], bufsize, bytesRead, nil) then
   begin
     lastError := GetLastError;
     ShowMessage (SysErrorMessage (lastError));
     Exit;
   end;

   mem.Clear;
   mem.Write(bufer[0], bytesRead);
   mem.Position := 0;
//    bufpict.LoadFromStream(mem);
//    Form1.Canvas.StretchDraw(Form1.ClientRect, bufpict);
   Label1.Caption := inttostr (bytesRead);
   Application.ProcessMessages;
 end;
end;

Отсылается (судя по bytesWritten) правильное количество байт (в данном случае - 30054).
А вот на приеме всегда - 4292. И никаких сообщений об ошибке.

Вопрос все еще остается открытым...
Надеюсь на Вашу помощь.

---

← →
Rouse_ ©   (2006-01-11 16:56) [4]

Ну, а дальше читать пробовал?

---

← →
Игорь Шевченко ©   (2006-01-11 17:12) [5]

> А вот на приеме всегда - 4292. И никаких сообщений об ошибке


А ты несколько раз почитай, прежде чем загружать картинку

---

← →
Игорь Шевченко ©   (2006-01-11 17:14) [6]

> PIPE_TYPE_BYTE


Кстати, я бы попробовал PIPE_TYPE_MESSAGE, тогда ты за один раз прочитаешь точно то количество, что записал (если буфер позволит, разумеется)

---

← →
Игорь Шевченко ©   (2006-01-11 17:15) [7]

Ну и PIPE_READMODE_MESSAGE

---

← →
DeadMeat ©   (2006-01-11 21:29) [8]

Читать дальше пробовал.. Но толи другие ошибки в программе не давали мне этого сделать, толи читал не так, вообщем не помогло.

А вот за PIPE_TYPE_MESSAGE спасибо.
Я в принципе его проверял, но опять же другие ошибки в программе не дали полностью понять чего это за такое. Все тормозило очень сильно, хотя картинка доходила как надо.

Сейчас все поправил и уже работает.

Большое всем спасибо, вопрос закрыт...
Благодарю.

---
...Death Is Only The Begining...

---

Страницы: 1 вся ветка

Текущий архив: 2006.04.23;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.03 c