NamedPipesFPC (
https://github.com/dezlov/NamedPipesFPC) от Дезлова заработал ... И даже влез на канал wmrcam (программа WMRViewer и example могут как то ""мешать друг другу" ) но предать и принять что-то кроме строк пока не выходит ...
- Код: Выделить всё
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls,NamedPipes;
...
Const
ServerInstances = 5;
ClientInstances = 20;
ClientDelayMin = 100;
ClientDelayMax = 500;
ClientNumMessages = 3;
ServerIdleTimeout = 5000;
UniquePipeName = 'wmrcam';
function GetInstanceInfo: String;
begin
Result := Format('$%x:$%x', [GetProcessID, GetThreadID]);
end;
...
procedure TForm1.Button3Click(Sender: TObject);
var
Server: TNamedPipeServerStream;
Client: TNamedPipeClientStream;
PB,PB2:Pointer;
BB,B1,b2:tBitmap ;
PBB^:Array[1..2] of byte;
begin
// На форму закинуты Image1 и Image2 , Image1 пустой
B1:=Image1.Picture.Bitmap ;b1.SetSize(640,480);
//... а в Image2 лежит тестовая картинка 640,480....
B2:=Image2.Picture.Bitmap ;
// Конверсия ( просто картинка попалась 32 бита )
bb:=tBitmap.Create; bb.SetSize(640,480);bb.PixelFormat:=pf24bit;; bb.Canvas.Draw(0,0,b2);
// Создаю сервер
Server := TNamedPipeServerStream.Create(UniquePipeName);
try
Server.Open; //Открываю канал на сервере ...
// Создаю клиент
Client := TNamedPipeClientStream.Create(UniquePipeName);
try
Client.Open; //Открываю канал на клиенте
// Тест передачи строк. Server-> Client
Server.WriteAnsiString('Server ->TEST');
Memo1.Lines.Add (Client.ReadAnsiString);
// Тест передачи строк. Client ->Server
Client.WriteAnsiString('Client -> Test message at ' + DateTimeToStr(Now));
Memo1.Lines.Add (Server.ReadAnsiString);
// Пытаюсь предать картину
B1.BeginUpdate;
PB:=B1.RawImage.Data;
PB2:=Bb.RawImage.Data;
GetMem(PBB,Bb.RawImage.DataSize);
move (pb2^,PBB^,Bb.RawImage.DataSize);
Server.WriteBuffer(pbb^ ,Bb.RawImage.DataSize ); // Весит тут!
FillChar(PBB^,Bb.RawImage.DataSize,0);
Client.ReadBuffer( pbb^,Bb.RawImage.DataSize);
move (PBB^,pb^,Bb.RawImage.DataSize);
FreeMem(PBB,Bb.RawImage.DataSize);
B1.EndUpdate;
bb.Free;
Image1.Refresh;
finally
Client.Free;
end;
finally
Server.Free;
end;
form1.Memo1.Lines.Add ('Finished. Press enter key...');
end;
На этапе Server.WriteBuffe прога вешается ...
(Кстати интересно то что канал двухсторонний передача идет как в строну Server-> Client так и Client ->Server )
Зы
Есть идея что нужно сделать два разных параллельных потока, но со строками все работает и так...
Добавлено спустя 37 минут 14 секунд:serbod писал(а):Самый простой способ использовать Named pipes через компонент DataPort (доступен через Online package manager).
Это он ?
https://github.com/serbod/dataport (Полезная штука, спасибо ! Но сомневаюсь, что она проще чем модуль NamedPipesFPC от Дезлова )
Ну до собственно чтения графических данных из WMRViewer-а я пока не добрался ...
Как я понял передача идет четырьмя протоками и из них два текстовые ... так что пока задача прочитать хотя-бы их (ну и разобраться с передачей "абстрактной картинки" ).
Добавлено спустя 54 минуты 36 секунд:Вообще, использование "трубо каналов" это личный заскок хука WMRInterceptHost.dll и по идее можно обойтись без них ...
Но сам хук зараза мрачная ....
Копнул исходники и тут-же получил весьма мрачную головную боль
Вопрос: как можно поучить доступ к видео потоку ( видимо несжатое покадровое видео 1280х480 8 бит ) в своей программе на Лазарусе ?
(Но мне вообще-то больше чтение нужно )
