Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2012.05.20;
Скачать: [xml.tar.bz2];

Вниз

Передача видео и звука с помощью Indy   Найти похожие ветки 

← →
3asys ©   (2011-11-26 15:48) [0]

На клиенте получаю видео и звук с web-камеры (с встроенным микрофоном) с помощью DirectShow.
Нужно передать их серверу для рассылки другим клиентам.
Видео и звук с Web-камеры получаю стандартным способом, описанным в примерах к DSPack, - примерно так:

var
 multiplexer: IBaseFilter;
 Writer: IFileSinkFilter;
 PinList: TPinList;
 i: integer;
begin
with MainForm do
begin
 CaptureGraph.Active := true;
 if AudioSourceFilter.FilterGraph <> nil then
 begin
   PinList := TPinList.Create(AudioSourceFilter as IBaseFilter);
   i := 0;
   while i < PinList.Count do
     if PinList.PinInfo[i].dir = PINDIR_OUTPUT then
       begin
         if AudioFormats.ItemIndex <> -1 then
           with (PinList.Items[i] as IAMStreamConfig) do
             SetFormat(AudioMediaTypes.Items[AudioFormats.ItemIndex].AMMediaType^);
         PinList.Delete(i);
       end else inc(i);
   if InputLines.ItemIndex <> -1 then
     with (PinList.Items[InputLines.ItemIndex] as IAMAudioInputMixer) do
       put_Enable(true);
   PinList.Free;
 end;

 if VideoSourceFilter.FilterGraph <> nil then
 begin
   PinList := TPinList.Create(VideoSourceFilter as IBaseFilter);
   if VideoFormats.ItemIndex <> -1 then
     with (PinList.First as IAMStreamConfig) do
       SetFormat(VideoMediaTypes.Items[VideoFormats.ItemIndex].AMMediaType^);
   PinList.Free;
 end;

 with CaptureGraph as IcaptureGraphBuilder2 do
 begin
   // set the output filename
   SetOutputFileName(MEDIASUBTYPE_Avi, PWideChar(CapFile), multiplexer, Writer);

   if VideoSourceFilter.BaseFilter.DataLength > 0 then
     RenderStream(@PIN_CATEGORY_PREVIEW, nil, VideoSourceFilter as IBaseFilter,
       nil , form1.VideoWindow as IBaseFilter);

   if VideoSourceFilter.FilterGraph <> nil then
     RenderStream(@PIN_CATEGORY_CAPTURE, nil, VideoSourceFilter as IBaseFilter,
       nil, multiplexer as IBaseFilter);

   if AudioSourceFilter.FilterGraph <> nil then
   begin

     RenderStream(nil, nil, AudioSourceFilter as IBaseFilter,
       nil, multiplexer as IBaseFilter);
   end;
 end;
 CaptureGraph.Play;

В RenderStream получаем потоки, но как их передать через IdTCPClient, IdTCPServer я сообразить не могу.
Как это сделать?

← →
Плохиш ©   (2011-11-26 17:07) [1]

Для начала надо изучить имеющиеся у используемого компонента методы.

← →
3asys ©   (2011-11-26 23:29) [2]

> Плохиш ©
я научился передавать в потоке через связку TIdTCPClient - TIdTCPServer отдельные картинки из TImage (по таймеру), но мне не ясно, как загрузить видео и звук в поток из TFilterGraph (DSPack).
Или нужно желать как-то по другому?

← →
3asys ©   (2011-11-27 12:51) [3]

Делать картинки с TVideoWindow не хотелось бы. Хочется передавать видео и звук в поток. А как это сделать в DSPack - никак не пойму. Может кто-нибудь это уже делал?

← →
3asys ©   (2011-11-27 22:55) [4]

МОЖЕТ КОМУ-НИБУДЬ ПРИГОДИТСЯ:
Нашел, как можно транслировать получаемое с помощью DSPack видео в потоке между TIdTCPClient и TIdTCPServer:
На Клиенте, при запущенном процессе получения видео с web-камеры (как получить видео с web-камеры - есть в примерах для Delphi, прилагаемых к библиотеке DSPack), выполняем в таймере (TTimer):

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 bm:=TBitmap.Create; //Это у меня происходит в Form1.OnCreate
 stream:=TMemoryStream.Create;
 SampleGrabber.GetBitmap(bm);
 bm.SaveToStream(stream);
 stream.Position:=0;
 IdTCPClient1.WriteStream(stream, true, true,0);
end;

На Сервере в событии Execute компонента TIdTCPServer пишем:

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
stream : TStream;
begin
try
 stream:=TMemoryStream.Create;
 AThread.Connection.ReadStream(stream,-1,False);
 stream.Position:=0;
 Image1.Picture.Bitmap.LoadFromStream(stream);
finally
 stream.Free;
end;

end;

Запускаем Сервер, затем запускаем Клиента и видим в TImage размещенном на Сервере видео с TVideoWindow находящегося на Клиенте.

← →
Сергей М. ©   (2011-11-28 12:53) [5]

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

Со звуком картина будет еще печальней.

← →
Dennis I. Komarov ©   (2011-11-28 13:35) [6]


> Со звуком картина будет еще печальней.

О каком звуке может идти речь, если передается простой Bitmap по таймеру?
Да и на клиенте "Out of memory" обеспечено...

← →
3asys ©   (2011-11-28 14:10) [7]

> Сергей М.
> Dennis I. Komarov

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

← →
Сергей М. ©   (2011-11-28 14:10) [8]


> Dennis I. Komarov ©   (28.11.11 13:35) [6]


> передается простой Bitmap по таймеру


Ну это у ТС пока в планах, ибо

> Нужно передать их серверу для рассылки другим клиентам


Я о том что ТС изначально движется неверной дорогой, стремясь передать медиаданные вот таким незамысловатым макаром)

← →
Сергей М. ©   (2011-11-28 14:14) [9]


> 3asys ©   (28.11.11 14:10) [7]


Кодировать передаваемые данные в соответствии с протоколами передачи медиа в режиме реального времени - RTP, RTSP и иже с ними.
Но они подразумевают UDP на трансп.уровне.

← →
3asys ©   (2011-11-28 14:28) [10]

> Сергей М.
Не могли бы вы привести пример такой реализации (или ее элементов) или ссылки на описание таких решений, если возможно, для delphi

← →
Dennis I. Komarov ©   (2011-11-28 14:57) [11]

http://www.google.ru/#hl=ru&cp=23&gs_id=6&xhr=t&q=%D0%BF%D1%80%D0%BE%D1%82%D0%BE%D0%BA%D0%BE%D0%BB+%D0%BF%D0%B5%D1%80%D0%B5%D0%B4%D0%B0%D1%87%D0%B8+%D0%B2%D0%B8%D0%B4%D0%B5%D0%BE&pf=p&sclient=psy-ab&newwindow=1&site=&source=hp&pbx=1&oq=%D0%BF%D1%80%D0%BE%D1%82%D0%BE%D0%BA%D0%BE%D0%BB+%D0%BF%D0%B5%D1%80%D0%B5%D0%B4%D0%B0%D1%87%D0%B8+%D0%B2%D0%B8%D0%B4%D0%B5%D0%BE&aq=0&aqi=g1g-v2&aql=&gs_sm=&gs_upl=&bav=on.2,or.r_gc.r_pw.r_cp.,cf.osb&fp=6b74bf870ecf0e8a&bi w=1280&bih=915

← →
3asys ©   (2011-11-28 15:35) [12]

> Dennis I. Komarov
Спасибо большое.
В виду того, что задача срочная, к сожалению, нет возможности сильно углубляться в изучение протокола, а способа ПРАКТИЧЕСКОЙ реализации я в интернете не нашел.
Хотел бы либо увидеть исходники полной или частичной реализации,
либо обсудить условия реализации соответствующего функционала (см. e-mail).

← →
Anatoly Podgoretsky ©   (2011-11-28 15:57) [13]

> 3asys  (28.11.2011 15:35:12)  [12]

Ты что в Интернете есть куча реализаций, от бесплатных до очень дорогих

← →
Dennis I. Komarov ©   (2011-11-28 16:06) [14]

[Form + ] WebBrowser + Flash = уже почти клиент

← →
DVM ©   (2011-11-28 16:10) [15]


> 3asys ©

Проще всего передавать видео и аудио по HTTP. Не самый быстрый и производительный способ, но самый простой.

Вот посмотри как это делают IP камеры, передавая MJPEG и аудио:
http://www.axis.com/files/manuals/VAPIX_3_HTTP_API_3_00.pdf

← →
DVM ©   (2011-11-28 16:13) [16]


> Anatoly Podgoretsky ©


> Ты что в Интернете есть куча реализаций, от бесплатных до
> очень дорогих

Все на C++


> 3asys ©

Из бесплатных достойных не очень много, точнее мне известна лишь одна реализация RTSP/RTP сервера и клиента - библиотека live555. И разумеется она на C++. Из нее вероятно можно попробовать сделать dll и использовать в Delphi (может кто-то уже и сделал dll) но трудоемко. И начинать надо с изучения RFC соответствующих. С HTTP проще на порядок все.

← →
Anatoly Podgoretsky ©   (2011-11-28 16:34) [17]

> DVM  (28.11.2011 16:13:16)  [16]

> Все на C++

Неправда есть в виде готовых программ. Кроме того чем С++ плох. Ты его не
любишь/Не занешь - твое горе

← →
DVM ©   (2011-11-28 16:46) [18]


> Anatoly Podgoretsky ©   (28.11.11 16:34) [17]


> Неправда есть в виде готовых программ.

Ему же надо в свою программу встраивать. То, что есть готовые программы никто не отрицает. Их немало. VLC например.


> Кроме того чем С++ плох. Ты его не
> любишь/Не занешь - твое горе

Я здесь причем? Автор программу на Delphi пишет.

← →
3asys ©   (2011-11-28 16:52) [19]

> All
Спасибо :)
Что реализовать можно - знаю, имел к практической реализации таких систем (не публичных) некоторое отношение. Но сейчас нужно сделать свою и "вчера".
Стал делать на Delphi просто потому, что работал на нем (не с мультимедиа) и какое-то кол-во граблей представляю.
Пробовал ActionScript, но в проекте есть компоненты, реализовать которые на нем мне показалось сложнее, чем на Delphi (для меня) - эти комопненты реализовал.
С предложенными здесь рекомендациями 100% согласен, но проблема на самом деле простая - отсутствие времени (нет пары месяцев чтобы во всем спокойно разобраться), поэтому и пытаюсь найти готовые фрагменты, дописывая только швы.
Если бы кто-то имеющий опыт практической реализации систем видеоконференцсвязи согласился бы поучаствовать в реализации, надеюсь смогли бы договориться.

← →
Gu   (2011-11-28 17:14) [20]

http://lakeofsoft.com/vc/
интересные компоненты, там похоже то что вам надо. в сети есть enterprise 2010 (последняя 2011) версия с исходниками.

← →
3asys ©   (2011-11-28 17:30) [21]

> Gu
Спасибо, очень интересно - попробую для работы со звуком

← →
DVM ©   (2011-11-28 18:22) [22]


> 3asys ©

Еще раз советую HTTP юзать, передача звукового потока и кадров реализуется элементарно, буквально 100 строк, прием тоже столько же примерно. Если решишь делать, задавай тут вопросы объясню как. По RTSP/RTP в принципе тоже мог бы объяснить, но эта тема очееень обширная.

← →
3asys ©   (2011-11-28 18:36) [23]

> DVM
Спасибо, с удовольствием. Поскольку времени практически нет - то чем быстрее реализация тем лучше.
Что нужно для реализации через http?

← →
Dennis I. Komarov ©   (2011-11-28 18:56) [24]

http-сервер, который будет получать поток с камеры и раздавать клиентам

← →
DVM ©   (2011-11-28 19:02) [25]

Первое что тебе понадобится - это сделать потокобезопасный кадровый буфер. Для начала сойдет буфер на один кадр. Потокобезопасность можно организовать через защиту буфера критической секцией. С одной стороны этот буфер будет обновляться источником кадров (твоей камерой ), с другой стороны оттуда вебсервер из клиентского потока будет забирать очередной кадр для передачи клиенту. Такая схема позволяет клиенту автоматически подстраиваться под ширину канала.

← →
DVM ©   (2011-11-28 19:12) [26]

Второё , что понадобится - это сервер TIDHttpServer, он у нас будет передавать клиенту бесконечный поток данных с особым типом контента multipart/x-mixed-relace. Этот тип контента позволяет передавать практически сколько угодно параллельных потоков чего угодно. То есть можно передавать видео звук субтитры и прочее вместе. Но можно сделать отдельные потоки для звука и видео, что. Проще при приеме.

← →
Dennis I. Komarov ©   (2011-11-28 19:13) [27]


> DVM ©   (28.11.11 19:02) [25]

А не накладно будет покадрово передавать, тем более с камеры?

← →
DVM ©   (2011-11-28 19:18) [28]

Как показывает практика не накладно. Мы же не будем для каждого кадра делать запрос, запрос будет сделан 1 раз.Остальное позже напишу - с телефона неудобно.

← →
3asys ©   (2011-11-28 19:22) [29]

В качестве http сервера IdHTTPServer подойдет?
Если буфер обмена создается на клиенте, как данные от клиента попадут на сервер? или каждый клиент одновременно и сервер?

← →
3asys ©   (2011-11-28 19:25) [30]

:) про  IdHTTPServer  понятно (написал не посмотрев сообшения)

← →
DVM ©   (2011-11-28 19:53) [31]

Если нужна двусторонняя передача видео, то для http каждый клиент должен быть одновременно сервером и клиентом для сервера другого клиента так как в http данные всегда передаются в основном канале в отличие от RTSP или SIP в котором RTP данные могут передаваться как поверх основного канала так и в независимых и в обоих направлениях.

← →
3asys ©   (2011-11-28 21:24) [32]

это видеоконференция и в ней каждый клиент передает другим видео и звук со своей web-камеры/микрофона.
я полагал, что должно быть N клиентов, каждый из которых передает свои видео и звук серверу, а сервер транслирует их всем остальным.  Это не так?

← →
DVM ©   (2011-11-28 22:09) [33]


> я полагал, что должно быть N клиентов, каждый из которых
> передает свои видео и звук серверу, а сервер транслирует
> их всем остальным.  Это не так?

Это может быть и так, а можно и по другому. Если все будет проходить через сервер, то нагрузка на него будет большая при большом числе клиентов, если видео не будет идти через сервер, то нагрузка на него будет минимальная, но будет меньше контроля. Вообще все это - это вопрос коммутации, это отдельный разговор. Вот SIP или RTSP и есть протоколы, которые предназначены для коммутации. У тебя задача пока хотя бы передать данные между 2-мя пользователями. А там дальше будешь думать.

← →
3asys ©   (2011-11-28 22:10) [34]

согласен

← →
DVM ©   (2011-11-28 22:18) [35]

Короче у тебя 3 пути:

1) Использовать самописный протокол для коммутации и передачи медиаданных.
2) Использовать HTTP и для передачи и для коммутации.
3) Использовать SIP для коммутации и RTP для передачи (вот этот вариант самый правильный, и вобщем то повсеместно используется в IP телефонии)
4) Использовать что-то типа http://ru.wikipedia.org/wiki/XMPP

Что выбираешь?

← →
3asys ©   (2011-11-28 22:25) [36]

мне необходимо реализовать конференцию в минимальные сроки и чтобы она работала с приемлемым качеством человек на 50. Как я понял, самый быстрый способ - http - поэтому HTTP

← →
DVM ©   (2011-11-28 22:30) [37]


> 3asys ©   (28.11.11 22:25) [36]

Ну HTTP так HTTP. Щас набросаю тебе пример.

← →
DVM ©   (2011-11-28 23:10) [38]


unit uMain;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.SyncObjs, Vcl.Imaging.jpeg,
 Vcl.ExtCtrls,

 IdBaseComponent, IdComponent, IdTCPServer, IdCustomHTTPServer, IdGlobal,
 IdHTTPServer, IdCustomTCPServer, IdContext, IdSchedulerOfThread, IdGlobalProtocols;

type

 TSafeBuffer = class(TMemoryStream)
 strict private
   FLock: TCriticalSection;
 public
   constructor Create;
   destructor Destroy; override;
   procedure Lock;
   procedure Unlock;
 end;

 TfrmMin = class(TForm)
   tmrUpdateFrame: TTimer;
   idhtpsrvrMain: TIdHTTPServer;
   procedure tmrUpdateFrameTimer(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure idhtpsrvrMainCommandGet(AContext: TIdContext;
     ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
 private
   { Private declarations }
 public
   Buffer: TSafeBuffer;
 end;

var
 frmMin: TfrmMin;

implementation

{$R *.dfm}

constructor TSafeBuffer.Create;
begin
 FLock := TCriticalSection.Create;
 inherited Create;
end;

destructor TSafeBuffer.Destroy;
begin
 inherited Destroy;
 FLock.Free;
end;

procedure TSafeBuffer.Lock;
begin
 FLock.Enter;
end;

procedure TSafeBuffer.Unlock;
begin
 FLock.Leave;
end;

procedure TfrmMin.FormCreate(Sender: TObject);
begin
 Buffer := TSafeBuffer.Create;
end;

procedure TfrmMin.FormDestroy(Sender: TObject);
begin
 Buffer.Free;
end;

procedure TfrmMin.idhtpsrvrMainCommandGet(AContext: TIdContext;
 ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
const
 Boundary = "--myboundary";
 CRLF = #13#10;
var
 Stream: TMemoryStream;
 SubHeader: AnsiString;
begin
 Stream := TMemoryStream.Create;
 try
   AResponseInfo.FreeContentStream := false;
   AResponseInfo.Server := "StreamServer";
   AResponseInfo.CacheControl := "no-cache";
   AResponseInfo.Pragma := "no-cache";
   AResponseInfo.Expires := Now;
   AResponseInfo.CharSet :="";
   AResponseInfo.Connection := "close";
   AResponseInfo.ContentType := "multipart/x-mixed-replace; boundary=" + Boundary;
   AResponseInfo.ContentLength := 1000000;
   AResponseInfo.WriteHeader;
   while ((not (AContext.Yarn as TIdYarnOfThread).Thread.Terminated) and (AContext.Connection.Connected)) do
     begin
       Buffer.Lock;
       try
         AResponseInfo.ContentLength := Buffer.Size;
         SubHeader := AnsiString(Boundary + CRLF +
                           "Content-Type: image/jpeg" + CRLF +
                           "Content-Length: " + IntToStr(AResponseInfo.ContentLength) + CRLF + CRLF);
         Stream.Size := 0;
         Stream.Write(SubHeader[1], length(SubHeader));
         Stream.Write(Buffer.Memory^, Buffer.Size);
       finally
         Buffer.Unlock;
       end;
        Stream.Position := 0;
       AResponseInfo.ContentStream := Stream;
       AResponseInfo.WriteContent;

       
       Sleep(100);
     end;
 finally
   Stream.Free;

 end;

end;

procedure TfrmMin.tmrUpdateFrameTimer(Sender: TObject);
var
 Bmp: TBitmap;
 JPG: TJPEGImage;
begin
 Bmp := TBitmap.Create;
 try
   Bmp.Width := 320;
   Bmp.Height := 240;
   Bmp.PixelFormat :=pf24bit;
   Bmp.Canvas.TextOut(50, 50, FormatDateTime("hh:nn:ss.zzz", Now));
   JPG := TJPEGImage.Create;
   try
     JPG.Assign(Bmp);
     Buffer.Lock;
     try
       Buffer.Size := 0;
       JPG.SaveToStream(Buffer);
       Buffer.Position :=0;
     finally
       Buffer.Unlock;
     end;
   finally
     JPG.Free;
   end;
 finally
   Bmp.Free;
 end;
end;

end.


← →
DVM ©   (2011-11-28 23:15) [39]

Итак, что тут к чему. Во-первых, это лишь пример, иллюстрирующий принцип. Не надо отсюда слепо копировать.
На форму кинуть таймер и TIdHTTPServer. Таймер нужен лишь для генерации картинок (типа кадры), интервал у таймера стоит 100.
TidHTTPServer слушает порт 8081.

Запускаем все это дело, берем Firefox (и только его, другие браузеры не понимают этот формат) и обращаемся в нем по адресу http://127.0.0.1:8081
Видим в окне браузера сменяющие друг друга картинки, фактически видео.

← →
DVM ©   (2011-11-28 23:19) [40]

Особые моменты в коде.

AResponseInfo.ContentLength := 1000000;
Indy всегда пытается всунуть в заголовок ответа сервера ContentLength, идеально было бы вообще без него, но от него не избавиться, поэтому ставим заведомо большое число, оно мало на что влияет, но 0 ставить нельзя.

Sleep(100);
Костыль. Ограничивает частоту кадров на клиенте. Частоту кадров стоит вычислять более умно. Хотя можно просто ограничить скажем величиной 25. Но все равно надо рассчитать тогда паузу между кадрами, чтоб получалось 25 кадров в секунду.

← →
DVM ©   (2011-11-28 23:23) [41]

Клиента завтра будем делать.
Ну и все объяснения тоже завтра.

← →
3asys ©   (2011-11-28 23:27) [42]

winapi.windows не находит что-то. что подключить?

← →
3asys ©   (2011-11-28 23:33) [43]

разобрался :)
СПАСИБО ВАМ ОГРОМНОЕ ЗА ВРЕМЯ И УСИЛИЯ

← →
Dennis I. Komarov ©   (2011-11-28 23:58) [44]


> У тебя задача пока хотя бы передать данные между 2-мя пользователями.
>  А там дальше будешь думать.

А потом он все с нуля переделвать будет... :)

> мне необходимо реализовать конференцию в минимальные сроки
> и чтобы она работала с приемлемым качеством человек на 50.
>  Как я понял, самый быстрый способ - http - поэтому HTTP

Вот 50 - (http)серверов каждый из которых будет слать 50-и клиентам видео, и не сжатый поток, а полные кадры...

З.Ы. Я конечно не делал видеоконференции, но в такую реализацию мне чего-то не верится... :)

← →
Германн ©   (2011-11-29 00:02) [45]


> winapi.windows не находит что-то


> DVM ©   (28.11.11 23:10) [38]

А в самом деле. Зачем вы, Дмитрий, добавили эти префиксы?

← →
DVM ©   (2011-11-29 00:19) [46]


> Dennis I. Komarov ©   (28.11.11 23:58) [44]


> Вот 50 - (http)серверов каждый из которых будет слать 50-
> и клиентам видео, и не сжатый поток, а полные кадры...

Да дался вам этот HTTP и 50 клиентов. Ну кто заставляет слать полные JPEG кадры? Можно сжимать в MPEG4 или H264 и слать P, I кадры, указывая, где какой в HTTP подзаголовках. Принцип тот же - multipart/x-mixed-replace. HTTP не такой медленный как многие думают, он же бинарный по сути, так что скорость сопоставима с просто TCP.
UDP же требует кучи кода, предназначенного для контроля ошибок и собственно в RTP и RTCP это и делается.

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


> Германн ©   (29.11.11 00:02) [45]


> Зачем вы, Дмитрий, добавили эти префиксы?

Это не я, это Delphi XE2. Пространства имен такие теперь там.

← →
Германн ©   (2011-11-29 00:28) [47]


> Это не я, это Delphi XE2. Пространства имен такие теперь
> там.

Хм. Спасибо за ответ.

← →
3asys ©   (2011-11-29 00:35) [48]

у вас Indy 10 ? - многие модули из uses не находятся

← →
DVM ©   (2011-11-29 00:37) [49]


> у вас Indy 10 ?

10

Советую 9 поменять на 10. Это возможно в любой версии Delphi. В 9 полно ошибок и она не развивается.

← →
3asys ©   (2011-11-29 00:50) [50]

ок меняю.

← →
3asys ©   (2011-11-29 12:09) [51]

На Indy 10 перешел. Все скомпилировалось. Правда, я убрал пространства имен в uses и удалил strict из объявления TSafeBuffer (выдавало ошибку - подумал, что опечатка).

Правильно ли я понимаю, что:
- процедура idhtpsrvrMainCommandGet задает структуру потока и отправляет его клиенту;
- в процедуре tmrUpdateFrameTimer создается bitmap, "конвертируется" в jpeg, который сохраняется в Buffer (он же поток);
- нужна отдельная процедура для получения видео и звука с web-камеры?

Если да, то:
- картинки с камеры сохраняем в bmp?
- как сохранять звук?

← →
DVM ©   (2011-11-29 13:40) [52]


> - процедура idhtpsrvrMainCommandGet задает структуру потока
> и отправляет его клиенту;

Это обработчик GET запросов к серверу, в принципе там можно еще проверять URI переданный серверу в запросе, чтоб обращаться например не к корню сервера а по какому то пути, например /GetVideo или /GetAudio . Да, он формирует структуру потока и отправляет его клиенту. Отправка не прекращается никогда.


> - в процедуре tmrUpdateFrameTimer создается bitmap, "конвертируется"
> в jpeg, который сохраняется в Buffer (он же поток);

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


> - нужна отдельная процедура для получения видео и звука
> с web-камеры?

Не обязательно, можно все сделать по аналогии с видео, но разделить обработчики GET запросов по переданному URL (он содержится в TRequestInfo вроде бы) . Я бы аудио стал передавать отдельно от видео, отдельным запросом у серверу по другому пути, так оно правильнее, так как кому то нужен только звук возможно, кому то только картинка.

Для аудио все делается аналогично, порция данных передается вместе с подзаголовком. Content-type там должен быть, что то вроде audio/что-то там, зависит от кодека. Вот выше в документе Axis можно поглядеть там есть про аудио.


> - картинки с камеры сохраняем в bmp?

По идее можно передавать и несжатый BMP тогда Content-Type надо указать: image/bitmap, но это имхо уже черезчур. Очень большой поток получиться, лучше сжимать в jpeg например. Intel Jpeg Library советую для сжатия - она в разы быстрее встроенного модуля jpeg.


> - как сохранять звук?

В каком формате сжатия ты хочешь сказать? Для начала попробуй просто PCM, потом можно перейти на несжатые кадры. Для перекодирования как звука так и видео, можно воспользоваться например ffmpeg (заголовочные файлы для него есть в интернет), но тут конечно придеться повозиться над изучением ffmpeg.

← →
DVM ©   (2011-11-29 13:46) [53]


> потом можно перейти на несжатые кадры.

на сжатые то есть

← →
DVM ©   (2011-11-29 13:48) [54]


> 3asys ©

Кстати, если натравить на этот сервер VideoLan VLC Player то оно тоже будет показывать. Звук он по идее тоже должен воспроизводить.

← →
3asys ©   (2011-11-29 14:27) [55]

Спасибо большое. Попробую расписать.
Правильно ли я понимаю, что в схеме, которая получается, клиент, имея сервер http на борту транслирует поток по 8081 порту и принимает такой же поток от другого клиента (я имею в виду, что возможно бросить на форму TWebBrowser и принимать поток контрагента).
Т.е. имеем двух активных клиентов-серверов и неограниченое число пассивных клиентов.
А как обеспечить участие 3х и более активных клиентов (которые и принимают потоки от всех других участников и сами передают участникам свое видео и звук)?

← →
3asys ©   (2011-11-29 14:32) [56]

я имею в виду, что портов должно стать больше, а если каждый будет вещать по своему порту, как всех принять. Если же все по одному порту - как разделить потоки от разных клиентов (которые будут смешиваться ... ?

И еще, было сказано "берем Firefox (и только его, другие браузеры не понимают этот формат)" - TWebBrowser - не подходит?

← →
DVM ©   (2011-11-29 15:36) [57]


> Правильно ли я понимаю, что в схеме, которая получается,
>  клиент, имея сервер http на борту транслирует поток по
> 8081 порту и принимает такой же поток от другого клиента
> (я имею в виду, что возможно бросить на форму TWebBrowser
> и принимать поток контрагента).

Каждый экземпляр твоей системы конференцсвязи имеет 1 сервер, который вещает видео+звук для всех кто к нему подключится. Также имеет N клиентов, которые получают данные от собеседников данного, подключаясь к их серверам.

Только кидать TWebBrowser не стоит. Во-первых, он не понимает такого типа передачи (понимает только Firefox да и то только jpeg). Надо написать своего клиента, который a) будет принимать поток с указанного сервера b) будет разбирать поток c) будет воспроизводить поток.


> А как обеспечить участие 3х и более активных клиентов (которые
> и принимают потоки от всех других участников и сами передают
> участникам свое видео и звук)?

По-моему, я уже ответил. Сколько угодно так может общаться людей. Их будет столько сколько потянет сеть и их комьютеры.


> я имею в виду, что портов должно стать больше, а если каждый
> будет вещать по своему порту, как всех принять. Если же
> все по одному порту - как разделить потоки от разных клиентов
> (которые будут смешиваться ... ?

Это все независимые друг от друга потоки, с какого перепуга они будут смешиваться.


> И еще, было сказано "берем Firefox (и только его, другие
> браузеры не понимают этот формат)" - TWebBrowser - не подходит?
>

Нет. И Firefox не подходит. Еще туда-сюда VLC ActiveX подойдет (вроде есть такой), но написать своего клиента не долго.

У тебя сервер то заработал? Пробовал его смотреть?

← →
3asys ©   (2011-11-29 15:52) [58]

> У тебя сервер то заработал? Пробовал его смотреть?

смогу увидеть сегодня вечером (к 21 по Москве)

← →
3asys ©   (2011-11-30 00:18) [59]

> DVM ©
Добрый день, наконец попробовал подключиться к запущенному серверу через FireFox - не может подключиться.
Что может быть?

← →
3asys ©   (2011-11-30 00:22) [60]

Может быть, поскольку для системы нужен будет собственный клиент, не тратить время на firefox, а сделать клиента и уже его отлаживать. Только с чего начать?

← →
Eraser ©   (2011-11-30 00:37) [61]

> [19] 3asys ©   (28.11.11 16:52)

это проект не на один день и не на один месяц думаю. по быстрому сделать скайп или тимвьювер не получится. все упрется в то, что нужно полностью прорабатывать каждую деталь, начиная от захвата/сжатия (для этого нужно привинтить современные кодеки) и заканчивая передачей данных. Не стоит забывать, что помимо картинки, нужно передавать еще и звук, также нужно чтобы они воспроизводились синхронно. Короче, сталкивался, не завидую )

← →
3asys ©   (2011-11-30 00:47) [62]

Удалось подключиться к серверу через FireFox и, кстати, через IE 8
Браузеры подключаются, но часы не визуализируются.

← →
3asys ©   (2011-11-30 00:52) [63]

> Eraser ©
Согласен, что непросто это все, но нужно достичь какого-то базового результата - видео и звук в минимально приемлемом качестве между несколькими участниками, а потом можно будет улучшать и допиливать ориентируясь на конкретные требования пользователей.

← →
Eraser ©   (2011-11-30 01:06) [64]

> [63] 3asys ©   (30.11.11 00:52)

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

← →
Германн ©   (2011-11-30 01:40) [65]

Проще, но дороже тут http://vidicor.ru/

← →
DVM ©   (2011-11-30 10:09) [66]


> 3asys ©   (30.11.11 00:47) [62]
> Удалось подключиться к серверу через FireFox и, кстати,
> через IE 8
> Браузеры подключаются, но часы не визуализируются.

Значит что-то еще у тебя не так. Отладчик бери и смотри. Еще снифер можно тоже, чтоб убедиться что все передается правильно. То что я тебе привел выше работало.


> Eraser ©   (30.11.11 00:37) [61]

При предложенном мной подходе с видео у него проблем не возникнет. Метод старый, проверенный десятилетием производителями сетевых камер. Ну и у меня есть софт кое-какой который в том же формате вещает. RTSP/RTP конечно лучше, но его не так просто реализовать. Да и JPEG передать по RTP сложнее, лучше брать MPEG4.

Сложнее будет со звуком. Звук он штука не дискретная как видео а непрерывная, поэтому надо будет городить более сложные буферы, иначе все будет заикаться.

С синхронизацие видео и звука проблем быть не должно, это же реалтайм видео, не запись и потоки не имеют возможности рассинхронизироваться сколько нибудь значительно.

← →
3asys ©   (2011-11-30 21:54) [67]

> DVM ©
При запуске выдается ошибка "Access violation" на включении критической секции FLock.Enter
Если комментирую включение и выключение критической секции, выдает такую же ошибку на JPG.SaveToStream(Buffer);

← →
DVM ©   (2011-11-30 22:18) [68]


> 3asys ©   (30.11.11 21:54) [67]

Ты буфер то создал где нибудь? Обращаешься к несуществующему объекту ведь.

← →
3asys ©   (2011-11-30 22:27) [69]

> DVM
procedure TfrmMin.FormCreate(Sender: TObject);
begin
Buffer := TSafeBuffer.Create;
end;

← →
3asys ©   (2011-11-30 22:39) [70]

это и есть создание буфера, насколько я понимаю... .

← →
DVM ©   (2011-11-30 22:41) [71]


> 3asys ©   (30.11.11 22:27) [69]

оно отрабатывает?

← →
3asys ©   (2011-11-30 22:48) [72]

> DVM ©

Заработало!
Действительно не отрабатывало. Стал создавать по кнопке, вместе с включением сервера:

procedure TfrmMin.Button1Click(Sender: TObject);
begin
Buffer := TSafeBuffer.Create;
idhtpsrvrMain.Active:=True;
tmrUpdateFrame.Enabled:=True;
end;


Теперь часы появились :)
Спасибо большое - я вообще-то не предполагал, что OnCreate может не отрабатывать. С чем это связано?

← →
DVM ©   (2011-11-30 22:50) [73]


>  я вообще-то не предполагал, что OnCreate может не отрабатывать.
>  С чем это связано?

Ты туда точку останова ставил? С копипастом не туда это может быть связано. ОБРАБОТЧИК НЕ НАЗНАЧЕН ФОРМЕ.

← →
3asys ©   (2011-11-30 22:52) [74]

:) да все так - не был назначен.

← →
DVM ©   (2011-11-30 22:54) [75]


> 3asys ©   (30.11.11 22:48) [72]


> Теперь часы появились :)

Ну вот теперь попробуй прикрутить свою камеру туда.

← →
DVM ©   (2011-11-30 22:56) [76]

А, и это надо придумать как сделать так, чтобы в ответе сервера не был указан Content-Length иначе тот же файерфокс после приема указанного количества байт остановится. Поэкспериментируй короче. Самодельный клиент конечно это поле может игнорировать.

← →
3asys ©   (2011-11-30 23:31) [77]

Запустил. Работает. В FireFox транслируется видео :)
поставил
  AResponseInfo.ContentLength := -1;
работает :)

← →
3asys ©   (2011-11-30 23:35) [78]

вот полный код того, что получилось:

unit uMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, SyncObjs, jpeg,
ExtCtrls,

IdBaseComponent, IdComponent, IdTCPServer, IdCustomHTTPServer, IdGlobal,
IdHTTPServer, IdCustomTCPServer, IdContext, IdSchedulerOfThread, IdGlobalProtocols,
 StdCtrls,

DSUtil, DirectShow9, DSPack;

type

TSafeBuffer = class(TMemoryStream)
private
  FLock: TCriticalSection;
public
  constructor Create;
  destructor Destroy; override;
  procedure Lock;
  procedure Unlock;
end;

TfrmMin = class(TForm)
  tmrUpdateFrame: TTimer;
   idhtpsrvrMain: TIdHTTPServer;
   Button1: TButton;
   VideoWindow2: TVideoWindow;
   VideoSourceFilter: TFilter;
   CaptureGraph: TFilterGraph;
   SampleGrabber: TSampleGrabber;

  procedure tmrUpdateFrameTimer(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
  procedure idhtpsrvrMainCommandGet(AContext: TIdContext;
    ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
   procedure Button1Click(Sender: TObject);
private
  { Private declarations }
public
  Buffer: TSafeBuffer;
end;

var
frmMin: TfrmMin;
CompFilter : TFilterList;
CapFilters : TSysDevEnum;
CapEnum: TSysDevEnum;
VideoMediaTypes: TEnumMediaType;

implementation

{$R *.dfm}

constructor TSafeBuffer.Create;
begin
FLock := TCriticalSection.Create;
inherited Create;

end;

destructor TSafeBuffer.Destroy;
begin
inherited Destroy;
FLock.Free;
end;

// VIDEO
function SetVideoParams(CB_B2: ICaptureGraphBuilder2; Category: TGUID;
fSource: IBaseFilter): HResult;
var
 StreamConf: IAMStreamConfig;
 PAMT: PAMMediaType;
begin
 Result:= E_FAIL;
 StreamConf:= nil;
 PAMT:= nil;
 try
   Result:= CB_B2.FindInterface(@Category, @MEDIATYPE_Video, fSource,
   IID_IAMStreamConfig, StreamConf);
   if Assigned(StreamConf) then
   begin
     StreamConf.GetFormat(PAMT);
     if Assigned(PAMT) then
     begin
     if PAMT.cbFormat= sizeOf(TVideoInfoHeader) then
     begin
       PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biWidth:= 640;
       PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biHeight:= 480;
       PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biBitCount:= 24;
       PVIDEOINFOHEADER(PAMT^.pbFormat)^.AvgTimePerFrame:= 10000000 div 25;
       //fps
       with PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader do
         PAMT^.lSampleSize := ((biWidth + 3) and (not (3))) * biHeight * biBitCount
         shr 3;
         PVIDEOINFOHEADER(PAMT^.pbFormat)^.bmiHeader.biSizeImage:=PAMT^.lSampleSize;
       end;
       Result:= StreamConf.SetFormat(PAMT^)
     end;
     end;
   result:= S_OK;
  except
  on E: Exception do
  MessageBox(0, PChar(E.Message), "", MB_OK or MB_ICONERROR);
  end;
  StreamConf:= nil;
  if Assigned(PAMT) then
  DeleteMediaType(PAMT);
end;

procedure TfrmMin.FormCreate(Sender: TObject);
begin
Buffer := TSafeBuffer.Create;

 CompFilter := TFilterList.Create;
 CapFilters := TSysDevEnum.create(CLSID_VideoCompressorCategory);
 CapEnum := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
 CapEnum.SelectGUIDCategory(CLSID_AudioInputDeviceCategory);
 VideoMediaTypes := TEnumMediaType.Create;
end;

procedure TSafeBuffer.Lock;
begin
FLock.Enter;
end;

procedure TSafeBuffer.Unlock;
begin
FLock.Leave;
end;

procedure TfrmMin.FormDestroy(Sender: TObject);
begin
Buffer.Free;
end;

procedure TfrmMin.idhtpsrvrMainCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
const
Boundary = "--myboundary";
CRLF = #13#10;
var
Stream: TMemoryStream;
SubHeader: AnsiString;
begin
Stream := TMemoryStream.Create;
try
  AResponseInfo.FreeContentStream := false;
  AResponseInfo.Server := "StreamServer";
  AResponseInfo.CacheControl := "no-cache";
  AResponseInfo.Pragma := "no-cache";
  AResponseInfo.Expires := Now;
  AResponseInfo.CharSet :="";
  AResponseInfo.Connection := "close";
  AResponseInfo.ContentType := "multipart/x-mixed-replace; boundary=" + Boundary;
  AResponseInfo.ContentLength := -1;
  AResponseInfo.WriteHeader;
  while ((not (AContext.Yarn as TIdYarnOfThread).Thread.Terminated) and (AContext.Connection.Connected)) do
    begin
      Buffer.Lock;
      try
        AResponseInfo.ContentLength := Buffer.Size;
        SubHeader := AnsiString(Boundary + CRLF +
                          "Content-Type: image/jpeg" + CRLF +
                          "Content-Length: " + IntToStr(AResponseInfo.ContentLength) + CRLF + CRLF);
        Stream.Size := 0;
        Stream.Write(SubHeader[1], length(SubHeader));
        Stream.Write(Buffer.Memory^, Buffer.Size);
      finally
        Buffer.Unlock;
      end;
       Stream.Position := 0;
      AResponseInfo.ContentStream := Stream;
      AResponseInfo.WriteContent;

     
      Sleep(100);
    end;
finally
  Stream.Free;

end;

end;

procedure TfrmMin.tmrUpdateFrameTimer(Sender: TObject);
var
Bmp: TBitmap;
JPG: TJPEGImage;
begin
Bmp := TBitmap.Create;
try

 SampleGrabber.GetBitmap(Bmp);
{
  Bmp.Width := 320;
  Bmp.Height := 240;
  Bmp.PixelFormat :=pf24bit;
  Bmp.Canvas.TextOut(50, 50, FormatDateTime("hh:nn:ss.zzz", Now));
}
  JPG := TJPEGImage.Create;
  try
    JPG.Assign(Bmp);
    Buffer.Lock;
    try
      Buffer.Size := 0;
      JPG.SaveToStream(Buffer);
      Buffer.Position :=0;
    finally
      Buffer.Unlock;
    end;
  finally
    JPG.Free;
  end;
finally
  Bmp.Free;
end;
end;

procedure TfrmMin.Button1Click(Sender: TObject);
begin
idhtpsrvrMain.Active:=True;
tmrUpdateFrame.Enabled:=True;
 VideoWindow2.FilterGraph:=CaptureGraph;
 CapEnum:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
 CaptureGraph.ClearGraph;
 CaptureGraph.Active := false;
 VideoSourceFilter.BaseFilter.Moniker := CapEnum.GetMoniker(0);
 VideoSourceFilter.FilterGraph := CaptureGraph;
 CaptureGraph.Active := true;
 SetVideoParams(CaptureGraph as ICaptureGraphBuilder2,
 PIN_CATEGORY_CAPTURE, VideoSourceFilter as IBaseFilter);
 with CaptureGraph as ICaptureGraphBuilder2 do
 RenderStream(@PIN_CATEGORY_PREVIEW, nil, VideoSourceFilter as IBaseFilter, SampleGrabber as IBaseFilter, VideoWindow2 as IbaseFilter);
 CaptureGraph.Play;
end;

end.

написано на Delphi 7, использовалась библиотека DSPack

← →
3asys ©   (2011-11-30 23:41) [79]

Для тех кому это интересно, - это код http-сервера транслирующего видео с web-камеры. В качестве клиента используется FireFox.

← →
DVM ©   (2011-11-30 23:45) [80]

Ну таймер думаю отсюда надо убрать. Перенести получение очередного кадра в отдельный поток. И вообще все оформить в виде отдельного класса со своими методами, отделить от формы, веб сервер создавать в рантайм. Короче там есть что прикрутить.

Ты вот как то спрашивал про несколько клиентов. Открой пять вкладок в файерфоксе и во всех можешь наблюдать видео. Можешь открыть и 50.

← →
3asys ©   (2011-11-30 23:45) [81]

> DVM ©  
Спасибо, без Вас бы это не получилось :)

Как можно сделать клиента?

← →
3asys ©   (2011-11-30 23:49) [82]

Попробую :)
Я тогда имел в виду, что каждый участник конференции будет не только смотреть но и сам транслировать и вопрос был - если все будут по одному порту вещать, то не будут ли они мешать друг другу?

← →
DVM ©   (2011-11-30 23:55) [83]


> 3asys ©   (30.11.11 23:45) [81]


> Как можно сделать клиента?

Из TIdTCPClient или TIDHTTPClient (хотя насчет последнего не уверен). Можно и чистые Windows Sockets использовать.

Для начала поищи тут на форуме класс TBuffer я когда то выкладывал для Германн - это будет твой приемный буфер.

Подумай, как сделать TCP клиента, который бы принимал данные с твоего сервера и клал в этот буфер.

Остальное завтра.

← →
DVM ©   (2011-11-30 23:57) [84]


> если все будут по одному порту вещать, то не будут ли они
> мешать друг другу?

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

← →
3asys ©   (2011-11-30 23:58) [85]

Спасибо :)

← →
DVM ©   (2011-12-01 00:05) [86]


unit uBuffer;

interface

const
 MinAllocation = 1024;

type

 TBuffer = class(TObject)
 private
   FStorage: PAnsiChar;                    // Указатель на начало буфера
   FAllocation: integer;                   // Размер памяти, выделенной под буфер
   FHead: PAnsiChar;                       // Указатель на начало данных в буфере
   FTail: PAnsiChar;                       // Указатель на конец данных в буфере
   FSize: integer;                         // Размер данных в буфере
   function GetBytes(Index: Integer): PAnsiChar;
   procedure SetSize(ASize: integer);
 public
   constructor Create; overload;
   constructor Create(ASize: integer); overload;
   constructor Create(AStorage: PAnsiChar; ASize: integer); overload;
   constructor Create(ABuffer: TBuffer); overload;

   destructor Destroy; override;

   function Append(ABuffer: TBuffer): integer; overload;
   function Append(AStorage: PAnsiChar; ASize: integer): integer; overload;

   function Assign(AStorage: PAnsiChar; ASize: integer): integer; overload;
   function Assign(ABuffer: TBuffer): integer; overload;

   function Consume(ACount: integer): integer;
   procedure Empty;
   procedure Compact;
   function IsEmpty: boolean;
   function Expand(ACount: integer): integer;
   function Extract(ACount: integer): PAnsiChar;
   function Shrink(ACount: integer): integer;
   procedure Tidy;
   property Head: PAnsiChar read FHead;
   property Size: integer read FSize write SetSize;
   property Storage: PAnsiChar read FStorage;
   property Tail: PAnsiChar read FTail;
   property Allocation: integer read FAllocation;
   property Bytes[Index: Integer]: PAnsiChar read GetBytes;
 end;


← →
DVM ©   (2011-12-01 00:05) [87]


implementation

//------------------------------------------------------------------------------

constructor TBuffer.Create;
begin
 Create(0);
end;

//------------------------------------------------------------------------------

constructor TBuffer.Create(ASize: integer);
begin
 if ASize > 0 then
   FAllocation := ASize
 else
   FAllocation := MinAllocation;
 FSize := 0;
 GetMem(FStorage, FAllocation);
 FHead := FStorage;
 FTail := FHead;
end;

//------------------------------------------------------------------------------

constructor TBuffer.Create(AStorage: PAnsiChar; ASize: integer);
begin
 if (ASize > 0) and Assigned(AStorage) then
   begin
    FAllocation := ASize;
    FSize := ASize;
    GetMem(FStorage, FAllocation);
    FHead := FStorage;
    Move(AStorage^, FStorage^, ASize);
    FTail := FHead + FSize;
   end
 else
   Create;
end;

//------------------------------------------------------------------------------

constructor TBuffer.Create(ABuffer: TBuffer);
begin
 if (Assigned(ABuffer)) and (ABuffer.Size > 0) then
   begin
     FAllocation := ABuffer.Size;
     FSize := ABuffer.Size;
     GetMem(FStorage, FAllocation);
     FHead := FStorage;
     Move(ABuffer.Storage^, FStorage^, ABuffer.Size);
     FTail := FHead + FSize;
   end
 else
   Create;
end;

//------------------------------------------------------------------------------

procedure TBuffer.SetSize(ASize: integer);
begin
if FSize <> ASize then
   begin
     if FSize < ASize then
       Expand(ASize)
     else
       begin
         FSize := ASize;
         FTail := FHead + FSize;
       end;
   end;
end;

// Отсекает первые ACount символов ----------------------------------------------

function TBuffer.Consume(ACount: integer): integer;
begin
 if ACount > FSize then ACount := FSize;
 if ACount < 0 then ACount := 0;
 FHead := FHead + ACount;
 FSize := FSize - ACount;
 Result := ACount;
end;

// Отсекает последние ACount символов -------------------------------------------

function TBuffer.Shrink(ACount: integer): integer;
begin
 if ACount > FSize then ACount := FSize;
 if ACount < 0 then ACount := 0;
 FSize := FSize - ACount;
 if FTail > FHead + FSize then FTail := FHead + FSize;
 Result := ACount;
end;

// Расширение буфера -----------------------------------------------------------

function TBuffer.Expand(ACount: integer): integer;
var
 Spare, HeadSpace, TailSpace, Width, OldAllocation: integer;
 NewStorage: PAnsiChar;
begin
 result := FSize;
 if ACount <= 0 then exit;
 // Свободный (незанятый) объем буфера
 Spare := FAllocation - FSize;
 // Свободное место в начале буфера
 HeadSpace := FHead - FStorage;
 // Свободное место в конце буфера
 TailSpace := Spare - HeadSpace;
 // Размер (ширина) занятой части буфера
 Width := Tail - Head;
 // Если в буфере есть достаточно свободного места для добавления ACount байт
 if Spare >= ACount then
   begin
     // Если хвост меньше чем надо добавить
     if TailSpace < ACount then
       begin
         // Двигаем полезные данные в начало буфера
        Move(FHead^, FStorage^, FSize);
         // Начало данных совпадает с началом буфера
        FHead := FStorage;
         // Хвост данных на расстоянии width от головы
         FTail := FHead + Width;
       end;
   end
 else
   // Если в буфере недостаточно места для добавления count символов
   begin
     OldAllocation := FAllocation;
     // Общий объем буфера увеличиваем на count
     FAllocation := FAllocation + ACount;
     // Создаем временный буфер нужного размера
     GetMem(NewStorage, FAllocation);
     FillChar(NewStorage^, FAllocation, 0);
     if FStorage <> nil then
       begin
         // Копируем в него данные из старого буфера
         Move(FHead^, NewStorage^, FSize);
         // Старый буфер удаляем
         FreeMem(FStorage, OldAllocation);
       end;
     // Новый буфер заменяет старый
     FStorage := NewStorage;
     // Данные в начале буфера
     FHead := FStorage;
     // Хвоcт на расстоянии width от головы буфера
     FTail := FHead + Width;
   end;
 // Устанавливаем новый размер буфера
 FSize := FSize + ACount;
 // Возвращаем новый размер
 result := FSize;
end;


← →
DVM ©   (2011-12-01 00:08) [88]


// Добавление данных в конец буфера --------------------------------------------

function TBuffer.Append(AStorage: PAnsiChar; ASize: integer): integer;
begin
 if Assigned(AStorage) and (ASize > 0) then
   begin
     Expand(ASize);
     Move(AStorage^, FTail^, ASize);
     FTail := FTail + ASize;
   end;
 result := FSize;
end;

// Добавление данных в конец буфера --------------------------------------------

function TBuffer.Append(ABuffer: TBuffer): integer;
begin
 result := Append(ABuffer.Storage, ABuffer.Size);
end;

// Извлечение первых ACount символов с их удалением из буфера ------------------

function TBuffer.Extract(ACount: integer): PAnsiChar;
var
 OldHead: PAnsiChar;
begin
 if ACount > FSize then ACount := FSize;
 if ACount < 0 then ACount := 0;
 OldHead := FHead;
 Inc(FHead, ACount);
 Dec(FSize, ACount);
 result := OldHead;
end;

//------------------------------------------------------------------------------

procedure TBuffer.Empty;
begin
 FSize := 0;
 FHead := FStorage;
 FTail := FHead;
end;

//------------------------------------------------------------------------------

function TBuffer.Assign(AStorage: PAnsiChar; ASize: integer): integer;
begin
 if Assigned(AStorage) and (ASize > 0) then
   begin
     FreeMem(FStorage, FAllocation);
     FSize := ASize;
     FAllocation := FSize;
     GetMem(FStorage, FAllocation);
     FHead := FStorage;
     Move(AStorage^, FStorage^, FSize);
     FTail := FHead + FSize;
   end;
 result := FSize;
end;

//------------------------------------------------------------------------------

function TBuffer.Assign(ABuffer: TBuffer): integer;
begin
 result := Assign(ABuffer.Storage, ABuffer.Size);
end;

//------------------------------------------------------------------------------

destructor TBuffer.Destroy;
begin
 FreeMem(FStorage, FAllocation);
 inherited Destroy;
end;

//------------------------------------------------------------------------------

function TBuffer.GetBytes(Index: Integer): PAnsiChar;
begin
 result := Head + Index;
end;

//------------------------------------------------------------------------------

procedure TBuffer.Tidy;
begin
 if FHead <> FStorage then
   begin
     if FSize = 0 then
       begin
         FHead := FStorage;
         FTail := FHead;
       end
     else
       begin
         Move(FHead^, FStorage, FSize);
         FHead := FStorage;
         FTail := FHead + FSize;
       end;
   end;
end;

//------------------------------------------------------------------------------

function TBuffer.IsEmpty: boolean;
begin
 result := FSize = 0;
end;

//------------------------------------------------------------------------------

procedure TBuffer.Compact;
var
 Temp: PAnsiChar;
begin
 if FSize > 0 then
   begin
     GetMem(Temp, FSize);
     Move(FHead^, Temp^, FSize);
     FreeMem(FStorage, FAllocation);
     FStorage := Temp;
     FAllocation := FSize;
   end
 else
   begin
     FreeMem(FStorage, FAllocation);
     FSize := 0;
     FAllocation := MinAllocation;
     GetMem(FStorage, FAllocation);
   end;
 FHead := FStorage;
 FTail := FHead + FSize;
 FAllocation := FSize;
end;

//------------------------------------------------------------------------------

end.



На кой ляд нам этот буфер нужен?
Он нужен чтобы данные добавлять в него с одной стороны, а с другой их забирать, причем с минимальными телодвижениями в памяти.

TMemoryStream к сожалению не подойдет.

← →
3asys ©   (2011-12-01 00:36) [89]

Спасибо,  а на чем визуализировать изображение? на TImage?

← →
brother ©   (2011-12-01 06:44) [90]

на canvas формы

← →
DVM ©   (2011-12-01 10:29) [91]


> 3asys ©   (01.12.11 00:36) [89]


> а на чем визуализировать изображение? на TImage?

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

На TImage лучше не выводить, этот компонент не предназначен для рисования и динамического содержимого, лучше TPaintBox. Или на канву формы (панели какой нить) даже.

← →
3asys ©   (2011-12-01 12:02) [92]

понял.
А как должна осуществляться трансляция звука - мы транслировали в поток jpeg-и, а звук как?

← →
DVM ©   (2011-12-01 12:13) [93]


> 3asys ©   (01.12.11 12:02) [92]


> а звук как?

Посмотрел документ от Axis ссылка на который дана выше? Это для начала.

← →
3asys ©   (2011-12-01 12:18) [94]

хорошо

← →
Anatoly Podgoretsky ©   (2011-12-01 12:58) [95]

> 3asys  (01.12.2011 12:02:32)  [92]

Звук - WAV, MP3

← →
DVM ©   (2011-12-01 14:19) [96]


> Anatoly Podgoretsky ©   (01.12.11 12:58) [95]


> Звук - WAV

это контейнер, в его случае нет файлов, значит нет и Wav.

← →
3asys ©   (2011-12-02 16:58) [97]

> DVM ©

Добрый день
вопрос по клиенту: пытаюсь организовать прием трафика от сервера. Как записать в Buffer данные? - запись вида IdTCPClient1.Socket.ReadStream(...) не подходит, т.к. TBuffer = class(TObject). Как быть?

← →
DVM ©   (2011-12-02 18:54) [98]

В этот мой буфер надо принимать данные чистым сокетом без инди.набросаю тебе вечером сегодня код приема упрощенный. Для инди надо по другому

← →
DVM ©   (2011-12-02 23:14) [99]


interface

uses
 Windows, Messages, Sysutils, Classes, SyncObjs, Winsock, EncdDecd;

const
 CR = #13;
 LF = #10;
 CRLF = #13#10;
 StartJpegMarker = #255#216;
 EndJpegMarker = #255#217;

type

 THTTPInputThread = class(TThread)
 private
   FHost: String;
   FPort: integer;
   FPath: String;
   FUsername: String;
   FPassword: String;
   FSock: integer;
   FAddr: TSockAddr;
   FTimeout: TTimeVal;
   FBuffer: TBuffer;
   FRequest: String;
   FContentLength: integer;
   function SocketConnect: integer;
   function Init: integer;
   function SendRequest(ASock: integer; ARequest: String): integer;
   function ReadData(ABuffer: TBuffer; BytesExpected: integer): integer;
   function GetResponse: integer;
   function SocketDisconnect: integer;
 protected
   procedure Execute; override;
 public
   constructor Create(AHost: string; APort: integer; APath: string; AUserName: string; APassword: string);
   destructor Destroy;  override;
 end;


.................................

← →
DVM ©   (2011-12-02 23:15) [100]


function MemStr2(const S, N: PAnsiChar; const Limit: Cardinal): PAnsiChar;
var
 I: Cardinal;
 pB1, pB2: PAnsiChar;
begin
 result := nil;
 if (s = nil) or (n = nil) then exit;
 if limit < 2 then exit;
 pB1 := S; pB2 := N;
 for I := 0 to Limit - 2 do
   if (pB1^ = pB2^) and ((pB1 + 1)^ = (pB2 + 1)^) then
     begin
       result := pB1;
       exit;
     end
   else
     inc(pB1);
end;

//------------------------------------------------------------------------------

constructor THTTPInputThread.Create(AHost: string; APort: integer;
                                   APath: string; AUserName: string; APassword: string);
begin
 inherited Create(true);
 FHost := AHost;
 FPort := APort;
 FPath := APath;
 FUserName := AUserName;
 FPassword := APassword;
 FBuffer := TBuffer.Create(0);
 Resume;
end;

//------------------------------------------------------------------------------

destructor THTTPInputThread.Destroy;
begin
 FBuffer.Free;
 inherited Destroy;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SocketConnect: integer;
var
 NoBlock: integer;
 Wfd, EFd: TFDSet;
 TimeVal: TTimeVal;
begin

 Result := socket(AF_INET, SOCK_STREAM, 0);
 if Result = INVALID_SOCKET then
   begin
     Result := -1;
     exit;
   end;

 NoBlock := 1;
 if ioctlsocket(Result, FIONBIO, NoBlock) = SOCKET_ERROR then
   begin
     CloseSocket(Result);
     Result := -1;
     exit;
   end;
 
 if Connect(Result, FAddr, SizeOf(FAddr)) = SOCKET_ERROR then
   begin  
     if WSAGetLastError =  WSAEWOULDBLOCK then
       begin
         while not Terminated do
           begin
             FD_ZERO(wfd);
             FD_SET(result, wfd);

             FD_ZERO(efd);
             FD_SET(result, efd);

             TimeVal.tv_sec := 0;
             TimeVal.tv_usec := 100;

             case select(0, nil, @wfd, @efd, @TimeVal) of
               0: sleep(50);
               1: if FD_ISSET(Result, wfd) then
                    break
                  else
                    if FD_ISSET(Result, efd) then
                      begin  
                        NoBlock := 0;
                        ioctlsocket(Result, FIONBIO, NoBlock);
                        CloseSocket(Result);
                        Result := -1;
                        exit;
                      end;
               SOCKET_ERROR:
                 begin
                   NoBlock := 0;
                   ioctlsocket(Result, FIONBIO, NoBlock);
                   CloseSocket(Result);
                   Result := -1;
                   exit
                 end;
             end;
           end;
        end
      else
        begin
          NoBlock := 0;
          ioctlsocket(Result, FIONBIO, NoBlock);
          CloseSocket(Result);
          Result := -1;
        end;
   end;

 //Возврат в блокирующий режим
 NoBlock := 0;
 if ioctlsocket(Result, FIONBIO, NoBlock) = SOCKET_ERROR then
   begin
     CloseSocket(Result);
     Result := -1;
   end;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SocketDisconnect(): integer;
begin
 if FSock <> -1 then
   begin
     ShutDown(FSock, SD_BOTH);
     CloseSocket(FSock);
     FSock := -1;
   end;
 Result := 0;
end;

//------------------------------------------------------------------------------


← →
DVM ©   (2011-12-02 23:16) [101]


function THTTPInputThread.Init: integer;
begin
 FBuffer.Empty;
 ZeroMemory(@FAddr, SizeOf(FAddr));
 FAddr.sin_family := PF_INET;
 FRequest := "GET " + FPath + " HTTP/1.1" + CRLF +
             "Host: " + FHost + ":" + inttostr(FPort) + CRLF +
             "User-Agent: Mozilla/5.0" + CRLF +
             "Accept: */*" + CRLF +
             "Keep-Alive: 300"  + CRLF +
             "Connection: keep-alive";
 FRequest := FRequest + CRLF + "Authorization: Basic " + EncodeString(FUserName + ":" + FPassword);
 FRequest := FRequest + CRLF + CRLF;
 FAddr.sin_addr.s_addr := InetAddr(AnsiString(FHost));
 FAddr.sin_port := htons(FPort);
 FTimeout.tv_sec := 20;
 FTimeout.tv_usec := 0;
 FSock := -1;
 Result := 0;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SendRequest(ASock: integer; ARequest: String): integer;
var
 ReturnCode: integer;
 Req: AnsiString;
begin
 Req := AnsiString(ARequest);
 ReturnCode := send(ASock, Req[1], Length(Req), 0);
 if ReturnCode = SOCKET_ERROR then
   begin
     Result := -1;
     SocketDisconnect();
   end
 else
   begin
     Result := 0;
   end;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.ReadData(ABuffer: TBuffer; BytesExpected: integer): integer;
const
 MaxLen = 262144;
var
 TotalBytesToRead, Found, TotalBytesRead, BytesToRead, BytesRead: integer;
 Rfds: TFDSet;
 TempBuff: array [0..Pred(MaxLen)] of AnsiChar;
begin
 FD_ZERO(Rfds);
 FD_SET(FSock, Rfds);
 Found := select(FSock, @Rfds, nil, nil, @FTimeout);
 if Found = 0 then
   begin
     // Select timed out
     Result := -1;
     exit;
   end
 else
   if Found = SOCKET_ERROR then
     begin
       // Select error
       Result := -1;
       exit;
     end;
 TotalBytesToRead := 0;
 if BytesExpected <> 0 then
   begin
     TotalBytesToRead := BytesExpected;
   end
 else
   begin
     if ioctlsocket(FSock, FIONREAD, TotalBytesToRead) = SOCKET_ERROR then
       begin
         // Cannot ioctl()
         Result := -1;
         exit;
       end;
     if TotalBytesToRead = 0  then
       begin
         SocketDisconnect();
         Result := 0;
         exit;
       end;
   end;
 TotalBytesRead := 0;
 repeat
   if TotalBytesToRead > MaxLen then
     BytesToRead := MaxLen
   else
     BytesToRead := TotalBytesToRead;
   ZeroMemory(@TempBuff[0], MaxLen);
   BytesRead := recv(FSock, TempBuff, BytesToRead, 0);
   if BytesRead = SOCKET_ERROR then
     begin
       // Read error
       SocketDisconnect();
       Result := -1;
       exit;
     end
   else
     if BytesRead = 0 then
       begin
         SocketDisconnect();
         Result := 0;
         exit;
       end
     else
       begin
         // Если буфер стал слишком большой
         if ABuffer.Size >= 2097152 then
           begin
             SocketDisconnect();
             Result := -1;
             exit;
           end;
         ABuffer.Append(@TempBuff[0], BytesRead);
         TotalBytesRead := TotalBytesRead + BytesRead;
         TotalBytesToRead := TotalBytesToRead - BytesRead;
       end;
 until TotalBytesToRead <= 0;
 Result := TotalBytesRead;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.GetResponse(): integer;
var
 StartPtr, EndPtr: PAnsiChar;
 BufferLen, Offset: integer;
 GotStartMarker: Boolean;
begin
 result := -1;
 Offset := 0;
 GotStartMarker := False;
 while (not Terminated) do
   begin
     if (not GotStartMarker) and (FBuffer.Size > 2) then
       begin
         StartPtr := MemStr2(FBuffer.Head, StartJpegMarker, FBuffer.Size);
         if StartPtr <> nil then
           begin
             FBuffer.Consume(StartPtr - FBuffer.Head);
             GotStartMarker := true;
           end
         else
           FBuffer.Empty;
       end;
     if GotStartMarker and (FBuffer.Size > 2) then
       begin
         EndPtr := MemStr2(FBuffer.Head + Offset, EndJpegMarker, FBuffer.Size - Offset);
         if EndPtr <> nil then
           begin
             Result := EndPtr - FBuffer.Head + 2;
             exit;
           end
         else
           Offset := FBuffer.Size - 2;
       end;
     BufferLen := ReadData(FBuffer, 0);
     if BufferLen < 0 then
       begin
         result := -1;
         exit;
       end;
   end;
end;

//------------------------------------------------------------------------------

← →
DVM ©   (2011-12-02 23:19) [102]


type

TFrameData = record
   FrameData: PAnsiChar;
   FrameDataLen: integer;
 end;
 PFrameData = ^TFrameData;

procedure THTTPInputThread.Execute;
var
 FrameData: PFrameData;
 Wsa: TWSADATA;
begin  
 WSAStartUp($0101, Wsa);
 try  
   while not Terminated do
     try
       Init;
       FSock := SocketConnect();
       if FSock <> -1 then
         try
           if SendRequest(FSock, FRequest) <> 0 then exit;
           repeat
             FContentLength := GetResponse;
             if FContentLength > 0 then
               begin
                 FrameData := New(PFrameData);
                 try
                   FrameData^.FrameData := FBuffer.Extract(FContentLength);
                   FrameData^.FrameDataLen := FContentLength;
                   SendMessage(FWindowHandle, WM_NEWFRAME, 0, Longint(FrameData));
                 finally
                   Dispose(FrameData);
                 end;
               end;
           until Terminated or (FContentLength = -1);
         finally
           SocketDisconnect;
         end
       else sleep(500);
     except
       sleep(500);
     end;
 finally
    WSACleanUp;
 end;
end;



разбирайся, если что непонятно спрашивай.

← →
3asys ©   (2011-12-03 00:06) [103]

Спасибо!

← →
Германн ©   (2011-12-03 00:11) [104]


> DVM ©   (02.12.11 18:54) [98]
>
> В этот мой буфер надо принимать данные чистым сокетом без
> инди.

Что-то мне подсказывает, что использование ICS вместо инди решило бы проблему без такой кучи писанины :)
Но могу и ошибаться.

← →
DVM ©   (2011-12-03 00:21) [105]


> Германн ©   (03.12.11 00:11) [104]


> Что-то мне подсказывает, что использование ICS вместо инди
> решило бы проблему без такой кучи писанины :)

Да можно и с инди и с ICS. Да не сильно короче бы вышло.

← →
3asys ©   (2011-12-03 00:39) [106]

не декларированный идентификатор InetAddr в выражении
FAddr.sin_addr.s_addr := InetAddr(AnsiString(FHost));
в функции:
function THTTPInputThread.Init: integer;

и также недекларированный идентификатор FWindowHandle в выражении
SendMessage(FWindowHandle, WM_NEWFRAME, 0, Longint(FrameData));
в профедуре: procedure THTTPInputThread.Execute;

← →
3asys ©   (2011-12-03 00:41) [107]

в остальном компилируется.
Что с этими идентификаторами делать?

← →
DVM ©   (2011-12-03 00:45) [108]


> 3asys ©   (03.12.11 00:39) [106]


function InetAddr(const AHost: AnsiString): DWORD;
var
 PHost: PAnsiChar;
 HostEnt: PHostEnt;
begin
 if AHost = "" then
   result := DWORD($FFFFFFFF)
 else
   begin
     PHost := PAnsiChar(AHost);
     Result := inet_addr(PHost);
     if Result = DWORD($FFFFFFFF) then
       begin
         HostEnt := GetHostByName(PHost);
         if HostEnt <> nil then
           Result := DWORD(pointer(HostEnt^.h_addr^)^);
       end;
   end;
end;


Ну а SendMessage пока просто убери. Или заведи поле FWindowHandle у класса потока и передавай в его конструктор хэндл окна которому будут приходить сообщения из потока. В конструкторе присваивай FWindowHandle переданное в конструктор значение.

Будь внимателен, код старый, пока постил сюда подправил кое-где на предмет PChar - > PAnsiChar, но мог пропустить что-то.

← →
DVM ©   (2011-12-03 00:46) [109]


> Что с этими идентификаторами делать?

с какими идентификаторами?

← →
3asys ©   (2011-12-03 00:50) [110]

если InetAddr - это Inet_Addr, то все равно несовпадение типов в выражении String и PAnsiChar

← →
3asys ©   (2011-12-03 00:51) [111]

понял - спасибо :)

← →
Германн ©   (2011-12-03 01:19) [112]


> Да можно и с инди и с ICS.

Не. ICS рассчитана исторически на асинхронную работу. Ну это то (примерно) что вы привели в [99] - [102].

← →
DVM ©   (2011-12-03 01:34) [113]


> Германн ©   (03.12.11 01:19) [112]


> Не.

C ICS можно было бы отказаться от потока. Но, это бы усложнило логику. Тут желательно чтобы все последовательно было,так оно нагляднее, особенно для примера. Indy потребовала бы поток, но можно было бы избавиться от рутины типа ReadData(). Но у Indy блокирующий коннект. Иногда это сильно мешает. А на сокетах все прозрачно и на виду. Для понимания процесса полезно имхо.

← →
3asys ©   (2011-12-03 14:37) [114]

Добрый день :)
> DVM ©
Правильно ли я понял, что
1. При запуске клиента вызываем THTTPInputThread.Create
1.1. передаем ей
 адрес сервера,
 порт,
 имя пользователяи
 пароль пользователя
 ЧТО ТАКОЕ APath ?
2. При подключении к серверу вызываем THTTPInputThread.Execute
3. При выключении клиента вызываем THTTPInputThread.Destroy

Включил в проект модуль uBuffer (буфер) и модуль uClientFunctions (работа клиента)
Сейчас модуль клиента выглядит так:

unit uclnt;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, ComCtrls, ToolWin,

 IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,

 uBuffer, uClientFunctions;

type
 TfrmClient = class(TForm)
   ToolBar1: TToolBar;
   tbtnStart: TToolButton;
   Panel1: TPanel; // на нее буду выводить видео
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure tbtnStartClick(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 frmClient: TfrmClient;
 Host: string;
 Port: integer;
 Path: string;
 UserName: string;
 Password: string;

implementation

{$R *.dfm}

procedure TfrmClient.FormCreate(Sender: TObject);
begin
 Host := "127.0.0.1";
 Port := 8081;
 Path := "";
 UserName := "";
 Password := "";
 THTTPInputThread.Create(Host, Port, Path, UserName, Password);
end;

procedure TfrmClient.tbtnStartClick(Sender: TObject);
begin
 THTTPInputThread.Execute;
end;

procedure TfrmClient.FormDestroy(Sender: TObject);
begin
 THTTPInputThread.Destroy;
end;

end.

На вызов THTTPInputThread.Execute; сообщается "недекларированный идентификатор Execute",
На вызов THTTPInputThread.Destroy; сообщает "not enough actual parameters"
Что можно сделать?

← →
Германн ©   (2011-12-03 14:50) [115]


> Что можно сделать?
>

Создать THTTPInputThread правильно.

← →
DVM ©   (2011-12-03 15:05) [116]


> 3asys ©   (03.12.11 14:37) [114]


> Правильно ли я понял, что
> 1. При запуске клиента вызываем THTTPInputThread.Create
> 1.1. передаем ей
>  адрес сервера,
>  порт,
>  имя пользователяи
>  пароль пользователя

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


> ЧТО ТАКОЕ APath ?

в том сервере, что я тебе писал выше это игнорируется, ну передай туда "/", это путь на сервере, ну например, он мог бы быть /mjpeg.cgi или /GetVideo.


> 2. При подключении к серверу вызываем THTTPInputThread.Execute

При подключении к серверу ты должен создать поток.
VideoThread := THTTPInputThread.Create(...)

Execute protected метод его ты не вызовешь из кода программы, да это и не надо, он сам вызовется. Читай справку про потоки.


> 3. При выключении клиента вызываем THTTPInputThread.Destroy

при отключении вызывай метод Free у экземпляра этого потока, предварительно остановив его (вообще это азы и это в справке есть).

VideoThread.Terminate;
VideoThread.WaitFor;
FreeAndNil(VideoThread)


> Сейчас модуль клиента выглядит так:

Касательно использования потока там написан бред. См. как надо выше.

← →
DVM ©   (2011-12-03 15:12) [117]

Также, я хотел заметить, что приведенный выше метод function THTTPInputThread.GetResponse(): integer; сильно упрощен. Это даже не чтение ответа именно HTTP сервера, это чтение и попытка выделить JPEG из любого потока TCP в любом формате. По-хорошему, надо принимать и анализировать заголовки сервера, тип контента, длину контента в подзаголовках и на основании этого читать строго заданное количество данных, учитывать разделители. Все это положительным образом скажется на производительности. Но код усложниться в десяток раз. Поэтому пока так.

← →
3asys ©   (2011-12-04 01:00) [118]

Спасибо, создал поток, как было указано,
смотрю отладчиком - с сервером соединяется, данные получает,
а как вывести их на канву (для простоты использую TPaintBox) не могу сообразить.
Правильно ли я понимаю, что экземпляр буффера создается созданным экземпляром THTTPInputThread, так сказать находится внутри потока и мне его создавать самому не нужно?
Если это так, то каким образом до него (Buffer) достучаться? А если это не так, то создав VideoBuffer := TBuffer.Create, как связать его с потоком и канвой?

← →
DVM ©   (2011-12-04 01:09) [119]


> 3asys ©   (04.12.11 01:00) [118]

Достукиваться лучше не до самого буфера:

 FrameData^.FrameData := FBuffer.Extract(FContentLength);
                  FrameData^.FrameDataLen := FContentLength;^.FrameData := FBuffer.Extract(FContentLength);
FrameData^.FrameDataLen := FContentLength;

Вот здесь в первой строке из буфера извлекается очередной кадр и помещается в структуру FrameData. Указатель на эту структуру можно с сообщением Windows передать в основной поток программы окну твоей формы например. Можно в принципе с сообщением передавать и сам буфер, так как SendMessage все равно синхронизирует доступ к нему, но наверное лучше вот так со структурой.
Как получать окном формы пользовательские сообщения давай сам думай, это не сложно и примеров интернет масса.

Когда получишь сообщение, тебе лишь надо будет декодировать из JPEG данных кадр и отрисовать его. Т.е придется сначала загнать данные в поток, загрузить оттуда их в JPEG потом декодировать и отрисовать на BMP.

← →
3asys ©   (2011-12-04 01:13) [120]

Спасибо, буду стараться :)

← →
3asys ©   (2011-12-10 15:43) [121]

Добрый день )

> DVM ©
Реализовал получение окном формы пользовательского сообщения (procedure TfrmClient.WndProc(var Msg: TMessage)):

unit uclnt;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, ComCtrls, ToolWin, StdCtrls, jpeg,

 IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,

 uClientFunctions, uBuffer;

type
 TfrmClient = class(TForm)
   ToolBar1: TToolBar;
   tbtnStart: TToolButton;
   PaintBox1: TPaintBox;
   Splitter1: TSplitter;
   Image1: TImage;
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure tbtnStartClick(Sender: TObject);
//    procedure GetVideoMsg(var Msg: TMsg; var Handled: Boolean);
   procedure WndProc(var Msg: TMessage); override;
 private
   { Private declarations }
 public
   { Public declarations }

 end;

var
 frmClient: TfrmClient;
 Host: string;
 Port: integer;
 Path: string;
 UserName: string;
 Password: string;
 VideoThread : THTTPInputThread;
 VideoStream : TMemoryStream;

implementation

{$R *.dfm}

procedure TfrmClient.FormCreate(Sender: TObject);
begin
 Host := "127.0.0.1";
 Port := 8081;
 Path := "/";
 UserName := "";
 Password := "";
 VideoStream:=TMemoryStream.Create;
end;

procedure TfrmClient.tbtnStartClick(Sender: TObject);
begin
 VideoThread := THTTPInputThread.Create(Host, Port, Path, UserName, Password);
end;

procedure TfrmClient.WndProc(var Msg: TMessage);
begin
 if Msg.Msg = FSendNewFrameMessage then
 begin
   // Здесь загрузка данных в поток, выгрузка оттуда их в Jpeg
   // декодирование и отрисовка
 end
 else
   inherited;

end;

procedure TfrmClient.FormDestroy(Sender: TObject);
begin
 VideoThread.Terminate;
 VideoThread.WaitFor;
 FreeAndNil(VideoThread);
end;

end.

Для упрощения обработки, с сообщением передаю сам кадр:

SendMessage(frmClient.Handle, FSendNewFrameMessage, 0, Longint(FrameData^.FrameData));

Далее пробовал по разному, но не смог загрузить данные в поток и не понимаю, как преобразовать их в jpg/
Как загрузить принятые данные в поток (передается Longint) и преобразовать их в jpg ?

← →
DVM ©   (2011-12-10 21:29) [122]


> Как загрузить принятые данные в поток (передается Longint)
> и преобразовать их в jpg ?

Наверное лучше (на будущее) будет не LongInt там использовать, а LParam. Но пока суть не в этом. Ты неправильно написал немного. Ты передаешь с сообщением указатель на сам кадр, но не передаешь размер кадра. Такое в поток не загрузить. Нужно и размер передавать LParam(FrameData). Я подразумеваю, что FrameData у тебя это указатель на запись в которой есть поле FrameData - указатель на данные, и есть там еще одно поле - размер.

В WndProc ты получаешь код сообщения, LPARAM и WPARAM. Твой LPARAM это на самом деле указатель на структуру с данными. Просто приведи его обратно к типу структуры:

var
 FrameData: PFrameData; // считаем, что PFrameData = ^TFrameData

...

FrameData := PFrameData(Msg.Lparam);

Вуаля. В твоем распоряжении указатель на структуру с данными. Тебе остается скопировать данные в TMemoryStream. Смотри методы TMemoryStream которые могу загрузить данные из буфера.

Потом можешь грузить данные обратно в JPEG. Не забудь предварительно только позицию в TMemoryStream выставить на начало его.

Все описанное выше десяток строк.

Вообще я бы не стал туда сюда гонять данные между буфером и стримом потом TJpegImage - можно сразу передать с сообщением буфер и прямо из него декодировать, например с помощью Intel Jpeg Library. Юудет быстрее. Но это потом. Сначала разберись по простому.

← →
3asys ©   (2011-12-11 18:39) [123]

Пробую создавать сообщение:
SendMessage(frmClient.Handle, FSendNewFrameMessage, 0, LParam(FBuffer));
В WndProc принимаю таким образом:

   FrameData := PFrameData(Msg.Lparam);
   VideoStream.WriteBuffer(FrameData,FrameData^.FrameDataLen);

расчитывая в дальнейшем сделать что-то вроде:

   jpg:=TJPEGImage.Create;
   VideoStream.Position:=0;
   jpg.LoadFromStream(VideoStream);
   b:=TBitmap.Create;
   b.Assign(jpg);
   Image1.Picture.Assign(b);

При обработки строки
VideoStream.WriteBuffer(FrameData,FrameData^.FrameDataLen);
выдается ошибка "Access violation".
Что я делаю неправильно?

← →
DVM ©   (2011-12-11 19:19) [124]


> Что я делаю неправильно?

с какого перепуга ты приводишь FBuffer типа TBuffer к PFrameData ???

в [102] же все написано было. Не торопись, сделай сначала так как я написал, потом будешь пытаться улучшать.

Это раз.

type

TFrameData = record
  FrameData: PAnsiChar;
  FrameDataLen: integer;
end;
PFrameData = ^TFrameData;

  FrameData := PFrameData(Msg.Lparam);
  VideoStream.WriteBuffer(FrameData^.FrameData,FrameData^.FrameDataLen);



Это два.

← →
3asys ©   (2011-12-11 21:53) [125]

Создаю сообщение в соответствии с [102]:

SendMessage(frmClient.Handle, FSendNewFrameMessage, 0, Longint(FrameData));

Принимаю сообщение в модуле:

unit uclnt;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, ComCtrls, ToolWin, StdCtrls, jpeg,

 IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,

 uClientFunctions, uBuffer;

type
 TfrmClient = class(TForm)
   ToolBar1: TToolBar;
   tbtnStart: TToolButton;
   Splitter1: TSplitter;
   Image: TImage;
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure tbtnStartClick(Sender: TObject);
//    procedure GetVideoMsg(var Msg: TMsg; var Handled: Boolean);
   procedure WndProc(var Msg: TMessage); override;
 private
   { Private declarations }
 public
   { Public declarations }
 end;

 TFrameData = record
   FrameData: PAnsiChar;
   FrameDataLen: integer;
 end;
 PFrameData = ^TFrameData;

var
 frmClient: TfrmClient;
 Host: string;
 Port: integer;
 Path: string;
 UserName: string;
 Password: string;
 VideoThread : THTTPInputThread;
 VideoStream : TMemoryStream;

implementation

{$R *.dfm}

procedure TfrmClient.FormCreate(Sender: TObject);
begin
 Host := "127.0.0.1";
 Port := 8081;
 Path := "/";
 UserName := "";
 Password := "";
 VideoStream:=TMemoryStream.Create;
end;

procedure TfrmClient.tbtnStartClick(Sender: TObject);
begin
 VideoThread := THTTPInputThread.Create(Host, Port, Path, UserName, Password);
end;

procedure TfrmClient.WndProc(var Msg: TMessage);
var
 FrameData: PFrameData;
 jpeg : TJPEGImage;
 b : TBitmap;
begin
 if Msg.Msg = FSendNewFrameMessage then
 begin
   FrameData := PFrameData(Msg.Lparam);
   VideoStream.WriteBuffer(FrameData^.FrameData, FrameData^.FrameDataLen);

   jpeg:=TJPEGImage.Create;
   VideoStream.Position:=0;
   jpeg.LoadFromStream(VideoStream);
   b:=TBitmap.Create;
   b.Assign(jpeg);
   Image.Picture.Assign(b);
   jpeg.Free;
   b.Free;
 end
 else
   inherited;
end;

procedure TfrmClient.FormDestroy(Sender: TObject);
begin
 VideoThread.Terminate;
 VideoThread.WaitFor;
 FreeAndNil(VideoThread);
end;

end.

При выполнении строки

VideoStream.WriteBuffer(FrameData^.FrameData, FrameData^.FrameDataLen);

выдается сообщение "Access Violation". Иногда эту строку проходит благополучно, но тогда при выполнении строки

jpeg.LoadFromStream(VideoStream);

выдается сообщение "Exception class EJPEG with message "JPEG error #53" ".
Точного значения этой ошибки найти не удалось (но, насколько я понял - общий смысл в несоответствии данных формату jpeg).
На входе (от сервера) во время тестирования - видео с web-камеры.
Что тут теперь может быть?

← →
DVM ©   (2011-12-11 22:03) [126]


> 3asys ©   (11.12.11 21:53) [125]

А FSendNewFrameMessage у тебя чему равен?

← →
DVM ©   (2011-12-11 22:07) [127]

И еще VideoStream очищай каждый раз перед записью в него

← →
3asys ©   (2011-12-11 22:21) [128]

FSendNewFrameMessage регистрируется в
constructor THTTPInputThread.Create  
  FSendNewFrameMessage := RegisterWindowMessage("WM_NEW_FRAME");
При выполнении программы оно = 49778 всегда.

Перед
VideoStream.WriteBuffer(FrameData^.FrameData, FrameData^.FrameDataLen);
поставил:
VideoStream.Clear;
Результат не изменился, к сожалению. Опять Access violation и error #53
Что еще может быть?

← →
DVM ©   (2011-12-11 22:24) [129]


> 3asys ©   (11.12.11 22:21) [128]


> Что еще может быть?

VideoStream.WriteBuffer(FrameData^.FrameData^, FrameData^.FrameDataLen);

← →
3asys ©   (2011-12-11 22:30) [130]

ЕСТЬ !!!
РАБОТАЕТ :)
СПАСИБО БОЛЬШОЕ !!!

← →
3asys ©   (2011-12-11 22:36) [131]

Для интересующихся, вот полный код клиента (сервер в [78]):

unit uclnt;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, ComCtrls, ToolWin, StdCtrls, jpeg,

 IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,

 uClientFunctions, uBuffer;

type
 TfrmClient = class(TForm)
   ToolBar1: TToolBar;
   tbtnStart: TToolButton;
   Splitter1: TSplitter;
   Image: TImage;
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure tbtnStartClick(Sender: TObject);
//    procedure GetVideoMsg(var Msg: TMsg; var Handled: Boolean);
   procedure WndProc(var Msg: TMessage); override;
 private
   { Private declarations }
 public
   { Public declarations }
 end;

 TFrameData = record
   FrameData: PAnsiChar;
   FrameDataLen: integer;
 end;
 PFrameData = ^TFrameData;

var
 frmClient: TfrmClient;
 Host: string;
 Port: integer;
 Path: string;
 UserName: string;
 Password: string;
 VideoThread : THTTPInputThread;
 VideoStream : TMemoryStream;

implementation

{$R *.dfm}

procedure TfrmClient.FormCreate(Sender: TObject);
begin
 Host := "127.0.0.1";
 Port := 8081;
 Path := "/";
 UserName := "";
 Password := "";
 VideoStream:=TMemoryStream.Create;
end;

procedure TfrmClient.tbtnStartClick(Sender: TObject);
begin
 VideoThread := THTTPInputThread.Create(Host, Port, Path, UserName, Password);
end;

procedure TfrmClient.WndProc(var Msg: TMessage);
var
 FrameData: PFrameData;
 jpeg : TJPEGImage;
 b : TBitmap;
begin
 if Msg.Msg = FSendNewFrameMessage then
 begin
   // &#199;&#228;&#229;&#241;&#252; &#231;&#224;&#227;&#240;&#243;&#231;&#234;&#224; &#228;&#224;&#237;&#237;&#251;&#245; &#226; &#239;&#238;&#242;&#238;&#234;, &#226;&#251;&#227;&#240;&#243;&#231;&#234;&#224; &#238;&#242;&#242;&#243;&#228;&#224; &#232;&#245; &#226; Jpeg
   // &#228;&#229;&#234;&#238;&#228;&#232;&#240;&#238;&#226;&#224;&#237;&#232;&#229; &#232; &#238;&#242;&#240;&#232;&#241;&#238;&#226;&#234;&#224;
   FrameData := PFrameData(Msg.Lparam);
   VideoStream.Clear;
   VideoStream.WriteBuffer(FrameData^.FrameData^, FrameData^.FrameDataLen);

   jpeg:=TJPEGImage.Create;
   VideoStream.Position:=0;
   jpeg.LoadFromStream(VideoStream);
   b:=TBitmap.Create;
   b.Assign(jpeg);
   Image.Picture.Assign(b);
   jpeg.Free;
   b.Free;
 end
 else
   inherited;
end;

procedure TfrmClient.FormDestroy(Sender: TObject);
begin
 VideoThread.Terminate;
 VideoThread.WaitFor;
 FreeAndNil(VideoThread);
end;

end.

← →
3asys ©   (2011-12-11 22:39) [132]


unit uClientFunctions;

interface

uses
Windows, Messages, Sysutils, Classes, SyncObjs, Winsock, EncdDecd,

uBuffer;

const
CR = #13;
LF = #10;
CRLF = #13#10;
StartJpegMarker = #255#216;
EndJpegMarker = #255#217;

type

THTTPInputThread = class(TThread)
private
  FHost: String;
  FPort: integer;
  FPath: String;
  FUsername: String;
  FPassword: String;
  FSock: integer;
  FAddr: TSockAddr;
  FTimeout: TTimeVal;
  FBuffer: TBuffer;
  FRequest: String;
  FContentLength: integer;
  function SocketConnect: integer;
  function Init: integer;
  function SendRequest(ASock: integer; ARequest: String): integer;
  function ReadData(ABuffer: TBuffer; BytesExpected: integer): integer;
  function GetResponse: integer;
  function SocketDisconnect: integer;
protected
  procedure Execute; override;
public
  constructor Create(AHost: string; APort: integer; APath: string; AUserName: string; APassword: string);
  destructor Destroy;  override;
end;

var
FSendNewFrameMessage: Cardinal; // &#196;&#235;&#255; Win32API

implementation

uses uclnt;

function MemStr2(const S, N: PAnsiChar; const Limit: Cardinal): PAnsiChar;
var
I: Cardinal;
pB1, pB2: PAnsiChar;
begin
result := nil;
if (s = nil) or (n = nil) then exit;
if limit < 2 then exit;
pB1 := S; pB2 := N;
for I := 0 to Limit - 2 do
  if (pB1^ = pB2^) and ((pB1 + 1)^ = (pB2 + 1)^) then
    begin
      result := pB1;
      exit;
    end
  else
    inc(pB1);
end;

//------------------------------------------------------------------------------

constructor THTTPInputThread.Create(AHost: string; APort: integer;
                                  APath: string; AUserName: string; APassword: string);
begin
inherited Create(true);
FHost := AHost;
FPort := APort;
FPath := APath;
FUserName := AUserName;
FPassword := APassword;
FBuffer := TBuffer.Create(0);
Resume;
FSendNewFrameMessage := RegisterWindowMessage("WM_NEW_FRAME");
end;

//------------------------------------------------------------------------------

destructor THTTPInputThread.Destroy;
begin
FBuffer.Free;
inherited Destroy;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SocketConnect: integer;
var
NoBlock: integer;
Wfd, EFd: TFDSet;
TimeVal: TTimeVal;
begin

Result := socket(AF_INET, SOCK_STREAM, 0);
if Result = INVALID_SOCKET then
  begin
    Result := -1;
    exit;
  end;

NoBlock := 1;
if ioctlsocket(Result, FIONBIO, NoBlock) = SOCKET_ERROR then
  begin
    CloseSocket(Result);
    Result := -1;
    exit;
  end;

if Connect(Result, FAddr, SizeOf(FAddr)) = SOCKET_ERROR then
  begin  
    if WSAGetLastError =  WSAEWOULDBLOCK then
      begin
        while not Terminated do
          begin
            FD_ZERO(wfd);
            FD_SET(result, wfd);

            FD_ZERO(efd);
            FD_SET(result, efd);

            TimeVal.tv_sec := 0;
            TimeVal.tv_usec := 100;

            case select(0, nil, @wfd, @efd, @TimeVal) of
              0: sleep(50);
              1: if FD_ISSET(Result, wfd) then
                   break
                 else
                   if FD_ISSET(Result, efd) then
                     begin  
                       NoBlock := 0;
                       ioctlsocket(Result, FIONBIO, NoBlock);
                       CloseSocket(Result);
                       Result := -1;
                       exit;
                     end;
              SOCKET_ERROR:
                begin
                  NoBlock := 0;
                  ioctlsocket(Result, FIONBIO, NoBlock);
                  CloseSocket(Result);
                  Result := -1;
                  exit
                end;
            end;
          end;
       end
     else
       begin
         NoBlock := 0;
         ioctlsocket(Result, FIONBIO, NoBlock);
         CloseSocket(Result);
         Result := -1;
       end;
  end;

// &#194;&#238;&#231;&#226;&#240;&#224;&#242; &#226; &#225;&#235;&#238;&#234;&#232;&#240;&#243;&#254;&#249;&#232;&#233; &#240;&#229;&#230;&#232;&#236;
NoBlock := 0;
if ioctlsocket(Result, FIONBIO, NoBlock) = SOCKET_ERROR then
  begin
    CloseSocket(Result);
    Result := -1;
  end;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SocketDisconnect(): integer;
begin
if FSock <> -1 then
  begin
    ShutDown(FSock, SD_BOTH);
    CloseSocket(FSock);
    FSock := -1;
  end;
Result := 0;
end;

//------------------------------------------------------------------------------

← →
3asys ©   (2011-12-11 22:41) [133]



function InetAddr(const AHost: AnsiString): DWORD;
var
PHost: PAnsiChar;
HostEnt: PHostEnt;
begin
if AHost = "" then
  result := DWORD($FFFFFFFF)
else
  begin
    PHost := PAnsiChar(AHost);
    Result := inet_addr(PHost);
    if Result = DWORD($FFFFFFFF) then
      begin
        HostEnt := GetHostByName(PHost);
        if HostEnt <> nil then
          Result := DWORD(pointer(HostEnt^.h_addr^)^);
      end;
  end;
end;

function THTTPInputThread.Init: integer;
begin
FBuffer.Empty;
ZeroMemory(@FAddr, SizeOf(FAddr));
FAddr.sin_family := PF_INET;
FRequest := "GET " + FPath + " HTTP/1.1" + CRLF +
            "Host: " + FHost + ":" + inttostr(FPort) + CRLF +
            "User-Agent: Mozilla/5.0" + CRLF +
            "Accept: */*" + CRLF +
            "Keep-Alive: 300"  + CRLF +
            "Connection: keep-alive";
FRequest := FRequest + CRLF + "Authorization: Basic " + EncodeString(FUserName + ":" + FPassword);
FRequest := FRequest + CRLF + CRLF;
FAddr.sin_addr.s_addr := InetAddr(AnsiString(FHost));
FAddr.sin_port := htons(FPort);
FTimeout.tv_sec := 20;
FTimeout.tv_usec := 0;
FSock := -1;
Result := 0;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SendRequest(ASock: integer; ARequest: String): integer;
var
ReturnCode: integer;
Req: AnsiString;
begin
Req := AnsiString(ARequest);
ReturnCode := send(ASock, Req[1], Length(Req), 0);
if ReturnCode = SOCKET_ERROR then
  begin
    Result := -1;
    SocketDisconnect();
  end
else
  begin
    Result := 0;
  end;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.ReadData(ABuffer: TBuffer; BytesExpected: integer): integer;
const
MaxLen = 262144;
var
TotalBytesToRead, Found, TotalBytesRead, BytesToRead, BytesRead: integer;
Rfds: TFDSet;
TempBuff: array [0..Pred(MaxLen)] of AnsiChar;
begin
FD_ZERO(Rfds);
FD_SET(FSock, Rfds);
Found := select(FSock, @Rfds, nil, nil, @FTimeout);
if Found = 0 then
  begin
    // Select timed out
    Result := -1;
    exit;
  end
else
  if Found = SOCKET_ERROR then
    begin
      // Select error
      Result := -1;
      exit;
    end;
TotalBytesToRead := 0;
if BytesExpected <> 0 then
  begin
    TotalBytesToRead := BytesExpected;
  end
else
  begin
    if ioctlsocket(FSock, FIONREAD, TotalBytesToRead) = SOCKET_ERROR then
      begin
        // Cannot ioctl()
        Result := -1;
        exit;
      end;
    if TotalBytesToRead = 0  then
      begin
        SocketDisconnect();
        Result := 0;
        exit;
      end;
  end;
TotalBytesRead := 0;
repeat
  if TotalBytesToRead > MaxLen then
    BytesToRead := MaxLen
  else
    BytesToRead := TotalBytesToRead;
  ZeroMemory(@TempBuff[0], MaxLen);
  BytesRead := recv(FSock, TempBuff, BytesToRead, 0);
  if BytesRead = SOCKET_ERROR then
    begin
      // Read error
      SocketDisconnect();
      Result := -1;
      exit;
    end
  else
    if BytesRead = 0 then
      begin
        SocketDisconnect();
        Result := 0;
        exit;
      end
    else
      begin
        // &#197;&#241;&#235;&#232; &#225;&#243;&#244;&#229;&#240; &#241;&#242;&#224;&#235; &#241;&#235;&#232;&#248;&#234;&#238;&#236; &#225;&#238;&#235;&#252;&#248;&#238;&#233;
        if ABuffer.Size >= 2097152 then
          begin
            SocketDisconnect();
            Result := -1;
            exit;
          end;
        ABuffer.Append(@TempBuff[0], BytesRead);
        TotalBytesRead := TotalBytesRead + BytesRead;
        TotalBytesToRead := TotalBytesToRead - BytesRead;
      end;
until TotalBytesToRead <= 0;
Result := TotalBytesRead;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.GetResponse(): integer;
var
StartPtr, EndPtr: PAnsiChar;
BufferLen, Offset: integer;
GotStartMarker: Boolean;
begin
result := -1;
Offset := 0;
GotStartMarker := False;
while (not Terminated) do
  begin
    if (not GotStartMarker) and (FBuffer.Size > 2) then
      begin
        StartPtr := MemStr2(FBuffer.Head, StartJpegMarker, FBuffer.Size);
        if StartPtr <> nil then
          begin
            FBuffer.Consume(StartPtr - FBuffer.Head);
            GotStartMarker := true;
          end
        else
          FBuffer.Empty;
      end;
    if GotStartMarker and (FBuffer.Size > 2) then
      begin
        EndPtr := MemStr2(FBuffer.Head + Offset, EndJpegMarker, FBuffer.Size - Offset);
        if EndPtr <> nil then
          begin
            Result := EndPtr - FBuffer.Head + 2;
            exit;
          end
        else
          Offset := FBuffer.Size - 2;
      end;
    BufferLen := ReadData(FBuffer, 0);
    if BufferLen < 0 then
      begin
        result := -1;
        exit;
      end;
  end;
end;

//------------------------------------------------------------------------------

type

TFrameData = record
  FrameData: PAnsiChar;
  FrameDataLen: integer;
end;
PFrameData = ^TFrameData;

procedure THTTPInputThread.Execute;
var
FrameData: PFrameData;
Wsa: TWSADATA;
begin  
WSAStartUp($0101, Wsa);
try  
  while not Terminated do
    try
      Init;
      FSock := SocketConnect();
      if FSock <> -1 then
        try
          if SendRequest(FSock, FRequest) <> 0 then exit;
          repeat
            FContentLength := GetResponse;
            if FContentLength > 0 then
              begin
                FrameData := New(PFrameData);
                try
                  FrameData^.FrameData := FBuffer.Extract(FContentLength);
                  FrameData^.FrameDataLen := FContentLength;
                  // Передаем указать на данные форме клиента:
                  SendMessage(frmClient.Handle, FSendNewFrameMessage, 0, Longint(FrameData));
                finally
                  Dispose(FrameData);
                end;
              end;
          until Terminated or (FContentLength = -1);
        finally
          SocketDisconnect;
        end
      else sleep(500);
    except
      sleep(500);
    end;
finally
   WSACleanUp;
end;
end;

end.


← →
DVM ©   (2011-12-11 22:45) [134]


> 3asys ©

вот тут чем то похожим человек занимается
http://delphimaster.net/view/8-1322690080/

← →
3asys ©   (2011-12-11 22:46) [135]

код модуля uBuffer см. [86],[87],[88].
Все тестировалось на Delphi7.

← →
3asys ©   (2011-12-11 22:58) [136]

> DVM ©
Да, спасибо, сегодня увидел.

Я смотрю Ваши рекомендации по улучшению/доработке.
Что бы Вы порекомендовали в первую очередь для уменьшения задержек (чуть подтормаживает, даже при нахождении сервера и клиента на одной и той же машине) и снижения трафика?

← →
DVM ©   (2011-12-11 23:08) [137]


> 3asys ©   (11.12.11 22:58) [136]


> Что бы Вы порекомендовали в первую очередь для уменьшения
> задержек

Отказаться от модуля jpeg в пользу Intel Jpeg Library 1.5. Она бесплатная в этой версии. В интернете есть заголовочные файлы для нее и есть модуль-переходник для кодирования-декодирования в-из TBitamp. Правда замечены за ней проблемы с многопоточностью, но это решаемо.


> и снижения трафика?

Переходить на MPEG4 ? Осваивать какой-то кодер-декодер придется. Метод передачи можно оставить тот же. Кодер-декодер FFMPEG можно взять.
Ну или FPS можно понижать.

Вообще данный метод позволяет выжать на средней машине 400 FPS (640x480) суммарно легко при использовании IJL.

← →
DVM ©   (2011-12-11 23:12) [138]


> 3asys ©   (11.12.11 22:58) [136]
>

Еще метод GetResponse совершенствовать надо. Сейчас он никак не учитывает Content-Length присылаемый ему с каждым кадром, а должен вообще то. Используя Content-Length мы можем не пытаться искать маркеры начала и конца кадра получив очередную порцию данных, что положительно скажется на производительности. Но это ты если хочешь сам уже пытайся.

← →
3asys ©   (2011-12-11 23:26) [139]

Спасибо Вам БОЛЬШОЕ

← →
3asys ©   (2011-12-19 12:17) [140]

Добрый день :)

> DVM ©
Насколько я понимаю, в связи  тем, что в рамках системы видеоконференцсвязи, вещание (видео-аудио потока) ведется клиентами (на борту у каждого из которых находится и локальный сервер отдающий поток и локальный клиент принимающий потоки от других участников конференции) независимо друг от друга, то информировать участников об IP-адресах с которых вещают участники конференции должен глобальный (для этой конференции) сервер. При этом IP по которому можно подключиться к серверу есть только у глобального сервера, а у локальных серверов (на борту клиентов) таких IP нет.
Как организовать подключение участников конференции к локальным серверам друг друга?

← →
DVM ©   (2011-12-19 18:06) [141]


> 3asys ©   (19.12.11 12:17) [140]

Попробуй для начала разбить задачу на части.

1) Определи, в каких состояниях может находится клиент (ожидание, исходящий вызов, входящий вызов, присоединение к конференции, создание конференции и т.д.)

2) Определи, что клиенту надо знать самому в каждом состоянии и что надо сообщить другим.

Вот все эти данные и должны отправляться/приниматься на/с сервер/а

Сервер можно тоже HTTP раз уж начали его использовать.

← →
3asys ©   (2011-12-19 22:22) [142]

> DVM ©  
я имел в виду несколько другое:
для того, чтобы получить поток от сервера, клиент должен к нему подключиться, а для этого он должен быть настроен на IP сервера и определенный порт, но как клиент подключится к серверу имеющему динамический IP? Как он получит с него поток?

← →
DVM ©   (2011-12-19 22:34) [143]


> 3asys ©   (19.12.11 22:22) [142]


> а для этого он должен быть настроен на IP сервера и определенный
> порт, но как клиент подключится к серверу имеющему динамический
> IP? Как он получит с него поток?
>
>

У кого динамический IP у одного из участников видеоконференции или у центрального сервера?

← →
3asys ©   (2011-12-19 22:39) [144]

> У кого динамический IP у одного из участников видеоконференции или у центрального сервера?

у участников конференции. Уцентрального сервера - статический IP

← →
DVM ©   (2011-12-19 22:43) [145]


> 3asys ©   (19.12.11 22:39) [144]

Я ж в 141 вроде бы все написал:


> Вот все эти данные и должны отправляться/приниматься на/с
> сервер/а

Клиент регистрируется на сервере и сообщает ему свой IP. Остальные участники конференции могут его там же получить.

← →
DVM ©   (2011-12-19 22:45) [146]

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

← →
3asys ©   (2011-12-19 22:54) [147]

:)
наверно я непавильно объяснил, что имею в виду:
допустим , я уже знаю и IP и порт сервера (одного из участников), с которого мне нужно получить поток. IP у этого сервера динамический и DNS не настроен. Как мой клиент сможет получить поток от этого сервера? - ведь достучаться к этому серверу, ввиду отсутствия DNS из интернета невозможно. Как же мой клиент получит от этого сервера поток? (может я чего-то не догоняю...)

← →
DVM ©   (2011-12-19 23:20) [148]


> 3asys ©   (19.12.11 22:54) [147]


>  (может я чего-то не догоняю...)

не догоняешь, попробуй прочитать мой пост выше еще раз. :) Сервером я всегда называю центральный сервер с постоянным IP который всем известен.

← →
3asys ©   (2011-12-19 23:38) [149]

прочитал Ваш пост несколько раз, правильно ли я понимаю, что
1.каждый клиент заходит на центральный сервер и сообщает ему свой IP и порт
2.центральный сервер передает IP и порт каждого клиента другим клиентам
3. каждый клиент обращается к серверам других клиентов (а у них IP динамический) по их полученным от центрального сервера IP и принимают от них видео-аудио поток

Если все это так, то единственное, что мне не понятно в этой схеме - как клиенты подключатся к динамическому IP серверов? Или зжесб еще что-то подразумевается?

← →
3asys ©   (2011-12-19 23:40) [150]

:) простите опечатался - последнее предложение -  "Или же здесь еще что-то подразумевается?"

← →
DVM ©   (2011-12-19 23:48) [151]


> Если все это так, то единственное, что мне не понятно в
> этой схеме - как клиенты подключатся к динамическому IP
> серверов?

Динамический IP - это такой же IP как и статический, он ничем не отличается от статического с той лишь разницей, что он периодически меняется. А меняется он как правило при очередном подключении компьютера пользователя к провайдеру. Зная этот IP точно так же можно подключиться к серверу, расположенному на этом IP.

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

← →
3asys ©   (2011-12-19 23:49) [152]

т.е. после получения от центрального сервера IP других участников, клиент обращается к их серверам напрямую, так?

← →
3asys ©   (2011-12-19 23:50) [153]

понял Вас.

← →
DVM ©   (2011-12-19 23:54) [154]


> 3asys ©   (19.12.11 23:49) [152]


> клиент обращается к их серверам напрямую, так?

ну да, как все и делают, скайп например.

← →
3asys ©   (2011-12-20 00:02) [155]

Спасибо Большое
Буду пробовать

← →
Германн ©   (2011-12-20 02:47) [156]

Похоже что Дима Муратов в свободное время наконец-то напишет работу для 3asys :)

← →
3asys ©   (2011-12-25 22:09) [157]

Добрый день
> DVM ©
В соответствии с Вашими рекомендациями разделил потоки видео и аудио.
Возникли следующие вопросы:
1. Как выделить звук из http сообщения (есть ли, например, какие-то метки, как с Jpeg-ом (сейчас делаю это по аналогии))?
2. Как воспроизводить звук?
(сейчас воспроизвожу:

soundTest:=FBuffer.Extract(FContentLength);
PlaySound(soundTest, 0, SND_SYNC);
в function THTTPInputThread.GetResponse(): integer; )

← →
3asys ©   (2011-12-29 17:39) [158]

Добрый день!
> DVM ©
выделение звука из http-сообщения вроде добился (ставлю свои метки), но никак не удается воспроизвести собственно звук.
Не могли бы Вы подсказать, каким образом это лучше сделать?

← →
DVM ©   (2012-01-05 11:32) [159]


> 3asys ©   (25.12.11 22:09) [157]


> 1. Как выделить звук из http сообщения (есть ли, например,
>  какие-то метки, как с Jpeg-ом (сейчас делаю это по аналогии))?
>

в принципе там же есть уже разделитель boundary вот все что между ним и очередным HTTP подзаголовком собственно и есть твои данные. Это по замыслу так. Если ты будешь ставить какие то свои метки, то поток станет нестандартным и его не сможет никто воспроизвести кроме тебя.


> 2. Как воспроизводить звук?

Для начала попробуй воспроизвести полученное скажем с помощью VLC Media Player (он вроде бы понимает такой формат). Разумеется без твоих меток.


> (сейчас воспроизвожу:
>
> soundTest:=FBuffer.Extract(FContentLength);
> PlaySound(soundTest, 0, SND_SYNC);

И что воспроизводится? :)

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

Я по DirectShow и DSPack в частности не большой специалист, но могу посоветовать использовать обертку кроссплатформенную для аудио и видео - SDL. Работа с медиаподсистемами в ней сильно упрощена по сравнению с оригинальными API имеющимися в ОС, к тому же приведена к едином для различных ОС виду.
Вот например для аудио http://www.libsdl.org/intro.ru/usingsound.html
Сразу хочу сказать, что для использования ее в Delphi понадобится заголовочный файл для Делфи - он есть в интернет.

← →
3asys ©   (2012-01-05 11:57) [160]

> DVM ©
Спасибо Большое

> Во первых ты должен где то сообщить подсистеме аудио как
> трактовать данные которые ты ей подсовываешь, т.е указать
> какая частота дискретизации у тебя, сколько каналов, сколько
> разрядов и т.д. После проинициализировать систему. Потом
> уже начинать подсовывать ей куски аудиоданных. Только тогда
> она сможет их воспроизводить.

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

← →
3asys ©   (2012-01-05 12:05) [161]

> DVM ©

> Вот например для аудио http://www.libsdl.org/intro.ru/usingsound.
> html

Насколько я понял из описания, это API не работает на Win64, т.е. на клиентских машинах с 64-битной Win она работать не будет :(
К сожалению очень мало времени для преодоления нестыковок :) поэтому и возникает вопрос о существовании готового примера, который можно было бы прикрутить без серьезных сложностей.

← →
DVM ©   (2012-01-05 12:06) [162]


> 3asys ©   (05.01.12 11:57) [160]


> Может быть есть какой-то пример или подробное описание?

я со звуком тоже не особенно много работал, описания конечно же есть:

Олег Гордеев - Программирование звука в Windows.
Н.Секунов - Обработка звука на PC.
Кинтцель Т. - Руководство программиста по работе со звуком.

В документации по DSPack описано как воспроизводить звук, в документации по SDL тоже. Но начни с книг, с первой вот например. После изучения твои вопросы станут более конкретными. Аудио данные у тебя уже есть.

← →
DVM ©   (2012-01-05 12:07) [163]


> 3asys ©   (05.01.12 12:05) [161]


> Насколько я понял из описания, это API не работает на Win64

у нас работал, в одном проекте и на Win64 и на Linux 64 бит.

← →
DVM ©   (2012-01-05 12:16) [164]

а вот книга по SDL
http://freecodingtutorial.files.wordpress.com/2011/10/premier-press-focus-on-sdl.pdf

← →
3asys ©   (2012-01-05 12:23) [165]

> DVM ©
Спасибо Вам большое

← →
DVM ©   (2012-01-05 12:26) [166]

Для SDL в двух словах работа выглядит следующим образом:
1) Инициализация SDL
2) Открываем аудио устройство и инициализируем его
3) Передаем SDL указатель на функцию обратного вызова, которую SDL будет дергать через определенные интервалы времени, внутри этой функции мы должны обеспечить SDL данными, заполнив передаваемый нам буфер, если данные у нас есть или заполнив его тишиной.

все. Остальное ложится на плечи SDL.

← →
3asys ©   (2012-01-05 12:49) [167]

Спасибо, попробую сделать

← →
3asys ©   (2012-01-07 16:20) [168]

> DVM ©
Добрый день,
не могли бы Вы подсказать:
создаю экземпляр клиента видеотрансляции:

procedure CreateNewUserTranslation(Host : String; Port : Integer; UserName : String);
var
 NewClntTransl : TfVideoClient;
begin
 NewClntTransl:=TfVideoClient.Create(fVideoClient);
 NewClntTransl.Host:=Host;
 NewClntTransl.Port := Port;
 NewClntTransl.Caption:=UserName;
 NewClntTransl.Show;
 NewClntTransl.StartTranslation(NewClntTransl);
end;

где StartTranslation(NewClntTransl)

procedure TfVideoClient.StartTranslation(Sender: TObject);
begin
 VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password);
 AudioThread := THTTPInputThread.Create(Host, Port, AudioPath, UserName, Password);
end;

а дальше все, как в Вашем примере.
Форма создается, а трансляция не начинается. При этом, если вызываю StartTranslation напрямую (без создания формы), то все отлично работает.
Поскольку Вы единственный, кроме меня, кто представляет код клиента, не могли бы Вы подсказать, как следует создавать экземпляр клиента для получения на этом экземпляре трансляции?

← →
DVM ©   (2012-01-08 12:35) [169]


> 3asys ©   (07.01.12 16:20) [168]

1) Отладчиком посмотри, на строку

VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password);

ты попадаешь вообще?

2) Какому окну шлются сообщения о приходе новых кадров?

Т.е. как THTTPInputThread узнает куда ему слать сообщения?

← →
3asys ©   (2012-01-08 14:28) [170]

> DVM ©  

> 1) Отладчиком посмотри, на строку
>
> VideoThread := THTTPInputThread.Create(Host, Port, VideoPath,
>  UserName, Password);
>
> ты попадаешь вообще?

Да, строка инициализируется нормально, все параметры правильные.

> 2) Какому окну шлются сообщения о приходе новых кадров?
>
> Т.е. как THTTPInputThread узнает куда ему слать сообщения?
>

Кажется Вы правы, сообщения отправляются SendMessage:

SendMessage(fVideoClient.Handle, FSendNewFrameMessage, 0, Longint(FrameData));

т.е. идут к fVideoClient, а, по идее, должны отправляться NewClntTransl, который создается в run-time.
Код приема сообщения формы fVideoClient полностью отрабатывается.Весь цикл проходится до самого конца, но картинка не появляется.
Действительно в этой строчке ошибка?
Как, если это так, передать Handle?

← →
DVM ©   (2012-01-08 15:37) [171]


> Как, если это так, передать Handle?

в конструктор потока, там где то выше вроде даже было так в коде

← →
3asys ©   (2012-01-08 16:14) [172]

Переписал. Теперь SendMessage передает окну с нужным handle, но трансляция не происходит :(  Что здесь может быть?
На всякий случай привожу полный код:
Запуск показа видеотрансляции:

procedure TfMain.N2Click(Sender: TObject);
var
 host, username : String;
 port : Integer;
begin
 host:=dmData.sp_UserList.Fields.fieldByName("user_ip").AsString;
 port:=Port_Video;
 username:=dmData.sp_UserList.Fields.fieldByName("user_name").AsString;
 fVideoClient.CreateNewUserTranslation(host, port, username);
end;

Создание окна и запуск видеотрансляции

procedure TfVideoClient.CreateNewUserTranslation(Host : String; Port : Integer; UserName : String);
var
 NewClntTransl : TfVideoClient;
begin
 NewClntTransl:=TfVideoClient.Create(fVideoClient);
 NewClntTransl.Host:=Host;
 NewClntTransl.Port := Port;
 NewClntTransl.Caption:=UserName;
 VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password, NewClntTransl.Handle);
 AudioThread := THTTPInputThread.Create(Host, Port, AudioPath, UserName, Password, NewClntTransl.Handle);
 NewClntTransl.Show;
end;

← →
3asys ©   (2012-01-08 16:17) [173]

Теперь работа потока (полный текст unit-а:

unit uClientFunctions;

interface

uses
Windows, Messages, Sysutils, Classes, SyncObjs, Winsock, EncdDecd, mmsystem,

uBuffer;

const
CR = #13;
LF = #10;
CRLF = #13#10;
StartJpegMarker = #255#216;
EndJpegMarker = #255#217;
HttpResponseHeaderDelimiter = "$%#&$";

type

THTTPInputThread = class(TThread)
private
  FHost: String;
  FPort: integer;
  FPath: String;
  FUsername: String;
  FPassword: String;
  FHandle: HWND;
  FSock: integer;
  FAddr: TSockAddr;
  FTimeout: TTimeVal;
  FBuffer: TBuffer;
  FRequest: String;
  FContentLength: integer;
  function SocketConnect: integer;
  function Init: integer;
  function SendRequest(ASock: integer; ARequest: String): integer;
  function ReadData(ABuffer: TBuffer; BytesExpected: integer): integer;
  function GetResponse: integer;
  function SocketDisconnect: integer;
protected
  procedure Execute; override;
public
  constructor Create(AHost: string; APort: integer; APath: string; AUserName: string; APassword: string; AHendle : HWND);
  destructor Destroy;  override;
end;

var
FSendNewFrameMessage: Cardinal; // &#196;&#235;&#255; Win32API

implementation

uses uVideoClient;

function MemStr2(const S, N: PAnsiChar; const Limit: Cardinal): PAnsiChar;
var
I: Cardinal;
pB1, pB2: PAnsiChar;
begin
result := nil;
if (s = nil) or (n = nil) then exit;
if limit < 2 then exit;
pB1 := S; pB2 := N;
for I := 0 to Limit - 2 do
  if (pB1^ = pB2^) and ((pB1 + 1)^ = (pB2 + 1)^) then
    begin
      result := pB1;
      exit;
    end
  else
    inc(pB1);
end;

//------------------------------------------------------------------------------

constructor THTTPInputThread.Create(AHost: string; APort: integer;
                                  APath: string; AUserName: string; APassword: string; AHendle : HWND);
begin
inherited Create(true);
FHost := AHost;
FPort := APort;
FPath := APath;
FUserName := AUserName;
FPassword := APassword;
FHandle := AHendle;
FBuffer := TBuffer.Create(0);
Resume;
FSendNewFrameMessage := RegisterWindowMessage("WM_NEW_FRAME");
end;

//------------------------------------------------------------------------------

destructor THTTPInputThread.Destroy;
begin
FBuffer.Free;
inherited Destroy;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SocketConnect: integer;
var
NoBlock: integer;
Wfd, EFd: TFDSet;
TimeVal: TTimeVal;
begin

Result := socket(AF_INET, SOCK_STREAM, 0);
if Result = INVALID_SOCKET then
  begin
    Result := -1;
    exit;
  end;

NoBlock := 1;
if ioctlsocket(Result, FIONBIO, NoBlock) = SOCKET_ERROR then
  begin
    CloseSocket(Result);
    Result := -1;
    exit;
  end;

if Connect(Result, FAddr, SizeOf(FAddr)) = SOCKET_ERROR then
  begin  
    if WSAGetLastError =  WSAEWOULDBLOCK then
      begin
        while not Terminated do
          begin
            FD_ZERO(wfd);
            FD_SET(result, wfd);

            FD_ZERO(efd);
            FD_SET(result, efd);

            TimeVal.tv_sec := 0;
            TimeVal.tv_usec := 100;

            case select(0, nil, @wfd, @efd, @TimeVal) of
              0: sleep(50);
              1: if FD_ISSET(Result, wfd) then
                   break
                 else
                   if FD_ISSET(Result, efd) then
                     begin  
                       NoBlock := 0;
                       ioctlsocket(Result, FIONBIO, NoBlock);
                       CloseSocket(Result);
                       Result := -1;
                       exit;
                     end;
              SOCKET_ERROR:
                begin
                  NoBlock := 0;
                  ioctlsocket(Result, FIONBIO, NoBlock);
                  CloseSocket(Result);
                  Result := -1;
                  exit
                end;
            end;
          end;
       end
     else
       begin
         NoBlock := 0;
         ioctlsocket(Result, FIONBIO, NoBlock);
         CloseSocket(Result);
         Result := -1;
       end;
  end;

// &#194;&#238;&#231;&#226;&#240;&#224;&#242; &#226; &#225;&#235;&#238;&#234;&#232;&#240;&#243;&#254;&#249;&#232;&#233; &#240;&#229;&#230;&#232;&#236;
NoBlock := 0;
if ioctlsocket(Result, FIONBIO, NoBlock) = SOCKET_ERROR then
  begin
    CloseSocket(Result);
    Result := -1;
  end;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SocketDisconnect(): integer;
begin
if FSock <> -1 then
  begin
    ShutDown(FSock, SD_BOTH);
    CloseSocket(FSock);
    FSock := -1;
  end;
Result := 0;
end;

//------------------------------------------------------------------------------

← →
3asys ©   (2012-01-08 16:19) [174]

function InetAddr(const AHost: AnsiString): DWORD;
var
PHost: PAnsiChar;
HostEnt: PHostEnt;
begin
if AHost = "" then
  result := DWORD($FFFFFFFF)
else
  begin
    PHost := PAnsiChar(AHost);
    Result := inet_addr(PHost);
    if Result = DWORD($FFFFFFFF) then
      begin
        HostEnt := GetHostByName(PHost);
        if HostEnt <> nil then
          Result := DWORD(pointer(HostEnt^.h_addr^)^);
      end;
  end;
end;

function THTTPInputThread.Init: integer;
begin
FBuffer.Empty;
ZeroMemory(@FAddr, SizeOf(FAddr));
FAddr.sin_family := PF_INET;
FRequest := "GET " + FPath + " HTTP/1.1" + CRLF +
            "Host: " + FHost + ":" + inttostr(FPort) + CRLF +
            "User-Agent: Mozilla/5.0" + CRLF +
            "Accept: */*" + CRLF +
            "Keep-Alive: 300"  + CRLF +
            "Connection: keep-alive";
FRequest := FRequest + CRLF + "Authorization: Basic " + EncodeString(FUserName + ":" + FPassword);
FRequest := FRequest + CRLF + CRLF;
FAddr.sin_addr.s_addr := InetAddr(AnsiString(FHost));
FAddr.sin_port := htons(FPort);
FTimeout.tv_sec := 20;
FTimeout.tv_usec := 0;
FSock := -1;
Result := 0;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.SendRequest(ASock: integer; ARequest: String): integer;
var
ReturnCode: integer;
Req: AnsiString;
begin
Req := AnsiString(ARequest);
ReturnCode := send(ASock, Req[1], Length(Req), 0);
if ReturnCode = SOCKET_ERROR then
  begin
    Result := -1;
    SocketDisconnect();
  end
else
  begin
    Result := 0;
  end;
end;

//------------------------------------------------------------------------------

function THTTPInputThread.ReadData(ABuffer: TBuffer; BytesExpected: integer): integer;
const
MaxLen = 262144;
var
TotalBytesToRead, Found, TotalBytesRead, BytesToRead, BytesRead: integer;
Rfds: TFDSet;
TempBuff: array [0..Pred(MaxLen)] of AnsiChar;
begin
FD_ZERO(Rfds);
FD_SET(FSock, Rfds);
Found := select(FSock, @Rfds, nil, nil, @FTimeout);
if Found = 0 then
  begin
    // Select timed out
    Result := -1;
    exit;
  end
else
  if Found = SOCKET_ERROR then
    begin
      // Select error
      Result := -1;
      exit;
    end;
TotalBytesToRead := 0;
if BytesExpected <> 0 then
  begin
    TotalBytesToRead := BytesExpected;
  end
else
  begin
    if ioctlsocket(FSock, FIONREAD, TotalBytesToRead) = SOCKET_ERROR then
      begin
        // Cannot ioctl()
        Result := -1;
        exit;
      end;
    if TotalBytesToRead = 0  then
      begin
        SocketDisconnect();
        Result := 0;
        exit;
      end;
  end;
TotalBytesRead := 0;
repeat
  if TotalBytesToRead > MaxLen then
    BytesToRead := MaxLen
  else
  BytesToRead := TotalBytesToRead;
  ZeroMemory(@TempBuff[0], MaxLen);
  BytesRead := recv(FSock, TempBuff, BytesToRead, 0);
  if BytesRead = SOCKET_ERROR then
    begin
      // Read error
      SocketDisconnect();
      Result := -1;
      exit;
    end
  else
    if BytesRead = 0 then
      begin
        SocketDisconnect();
        Result := 0;
        exit;
      end
    else
      begin
        // &#197;&#241;&#235;&#232; &#225;&#243;&#244;&#229;&#240; &#241;&#242;&#224;&#235; &#241;&#235;&#232;&#248;&#234;&#238;&#236; &#225;&#238;&#235;&#252;&#248;&#238;&#233;
        if ABuffer.Size >= 2097152 then
          begin
            SocketDisconnect();
            Result := -1;
            exit;
          end;
        ABuffer.Append(@TempBuff[0], BytesRead);
        TotalBytesRead := TotalBytesRead + BytesRead;
        TotalBytesToRead := TotalBytesToRead - BytesRead;

      end;
until TotalBytesToRead <= 0;
Result := TotalBytesRead;
end;

← →
3asys ©   (2012-01-08 16:19) [175]

//------------------------------------------------------------------------------

function THTTPInputThread.GetResponse(): integer;
var
StartPtr, EndPtr: PAnsiChar;
BufferLen, Offset: integer;
GotStartMarker: Boolean;
begin
// &#206;&#193;&#208;&#192;&#193;&#206;&#210;&#202;&#192; &#192;&#211;&#196;&#200;&#206; - &#207;&#206;&#210;&#206;&#202;&#192;:
If FPath = "/GetAudio" Then
begin
result := -1;
Offset := 0;
GotStartMarker := False;
while (not Terminated) do
  begin
    if (not GotStartMarker) and (FBuffer.Size > 2) then
      begin
        StartPtr := MemStr2(FBuffer.Head, StartJpegMarker, FBuffer.Size);
        if StartPtr <> nil then
          begin
            FBuffer.Consume(StartPtr - FBuffer.Head);
            GotStartMarker := true;
          end
        else
          FBuffer.Empty;
      end;
    if GotStartMarker and (FBuffer.Size > 2) then
      begin
        EndPtr := MemStr2(FBuffer.Head + Offset, EndJpegMarker, FBuffer.Size - Offset);
        if EndPtr <> nil then
          begin
            Result := EndPtr - FBuffer.Head + 2;
         //   waveOutWrite(0, Addr(soundTest), FContentLength);
        //    playsound(buf.Memory, 0, SND_MEMORY  or SND_ASYNC); // &#194;&#206;&#209;&#207;&#208;&#206;&#200;&#199;&#194;&#206;&#196;&#200;&#204; &#199;&#194;&#211;&#202;
            result := -1;// &#215;&#210;&#206;&#193;&#219; &#205;&#197; &#206;&#193;&#208;&#192;&#193;&#192;&#210;&#219;&#194;&#192;&#203;&#206;&#209;&# 220; SendMessage

            exit;
          end
        else
          Offset := FBuffer.Size - 2;
      end;
    BufferLen := ReadData(FBuffer, 0);
    if BufferLen < 0 then
      begin
        result := -1;
        exit;
      end;
  end;
end
else If FPath = "/GetVideo" Then // &#206;&#193;&#208;&#192;&#193;&#206;&#210;&#202;&#192; &#194;&#200;&#196;&#197;&#206; - &#207;&#206;&#210;&#206;&#202;&#192;:
begin
result := -1;
Offset := 0;
GotStartMarker := False;
while (not Terminated) do
  begin
    if (not GotStartMarker) and (FBuffer.Size > 2) then
      begin
        StartPtr := MemStr2(FBuffer.Head, StartJpegMarker, FBuffer.Size);
        if StartPtr <> nil then
          begin
            FBuffer.Consume(StartPtr - FBuffer.Head);
            GotStartMarker := true;
          end
        else
          FBuffer.Empty;
      end;
    if GotStartMarker and (FBuffer.Size > 2) then
      begin
        EndPtr := MemStr2(FBuffer.Head + Offset, EndJpegMarker, FBuffer.Size - Offset);
        if EndPtr <> nil then
          begin
            Result := EndPtr - FBuffer.Head + 2;
            exit;
          end
        else
          Offset := FBuffer.Size - 2;
      end;
    BufferLen := ReadData(FBuffer, 0);
    if BufferLen < 0 then
      begin
        result := -1;
        exit;
      end;
  end;
end
else
 result:=-1;

end;

//------------------------------------------------------------------------------
type

TFrameData = record
  FrameData: PAnsiChar;
  FrameDataLen: integer;
end;
PFrameData = ^TFrameData;

procedure THTTPInputThread.Execute;
var
FrameData: PFrameData;
Wsa: TWSADATA;
begin
WSAStartUp($0101, Wsa);
try
  while not Terminated do
    try
      Init;
      FSock := SocketConnect();
      if FSock <> -1 then
        try
          if SendRequest(FSock, FRequest) <> 0 then exit;
          repeat
            FContentLength := GetResponse;
            if FContentLength > 0 then
              begin
                FrameData := New(PFrameData);
                try
                  FrameData^.FrameData := FBuffer.Extract(FContentLength);
                  FrameData^.FrameDataLen := FContentLength;
                  // Передаем указатель на данные форме клиента:
                  SendMessage(FHandle, FSendNewFrameMessage, 0, Longint(FrameData));
                finally
                  Dispose(FrameData);
                end;
              end;
          until Terminated or (FContentLength = -1);
        finally
          SocketDisconnect;
        end
      else sleep(500);
    except
      sleep(500);
    end;
finally
   WSACleanUp;
end;
end;

end.

И, наконец, отрисовка на форме:

procedure TfVideoClient.WndProc(var Msg: TMessage);
var
 FrameData: PFrameData;
 jpeg : TJPEGImage;
 b : TBitmap;
begin
 if Msg.Msg = FSendNewFrameMessage then
 begin
   FrameData := PFrameData(Msg.Lparam);
   VideoStream.Clear;
   VideoStream.WriteBuffer(FrameData^.FrameData^, FrameData^.FrameDataLen);

   jpeg:=TJPEGImage.Create;
   VideoStream.Position:=0;
   jpeg.LoadFromStream(VideoStream);
   b:=TBitmap.Create;
   b.Assign(jpeg);
   // Подгонка размера формы под размер изображения:
   fVideoClient.Width:=b.Width;
   fVideoClient.Height:=b.Height;
   // Вывод картинки на канву:
   fVideoClient.Canvas.Draw(0,0,b);

   jpeg.Free;
   b.Free;
 end
 else
   inherited;
end;

← →
3asys ©   (2012-01-08 16:25) [176]

Unit работы с потоком практически не менялся (только добавил Handle в конструктор.
Handle фориы которой отправляет сообщение SendMessage совпадает с Handle формы, которая выводится (в методе OnShow клиента пишу Caption:=IntToStr(Handle);) :)
Вожусь с этим третий день :(
Что еще можно сделать?

← →
3asys ©   (2012-01-08 23:40) [177]

Данные какие-то по SendMessage приходят, картинка bitmap создается, но не отрисовывается.
В упор ничего не вижу. Больше 10 раз всю цепочку просмотрел - и не вижу, где может быть ошибка, хотя конечно есть, только где? :)

← →
DVM ©   (2012-01-09 00:23) [178]


> Данные какие-то по SendMessage приходят, картинка bitmap
> создается, но не отрисовывается.

раз создается, значит отрисовывается не там, где должен

fVideoClient.Canvas.Draw(0,0,b);

вот здесь fVideoClient - это что?

← →
3asys ©   (2012-01-09 00:28) [179]

это форма клиента

← →
3asys ©   (2012-01-09 00:30) [180]

у нее тот handle , который задается Thread при инициировании [172] (Создание окна и запуск видеотрансляции)

← →
DVM ©   (2012-01-09 00:39) [181]


> 3asys ©   (09.01.12 00:28) [179]

Их много что ли одновременно одинаковых?

← →
DVM ©   (2012-01-09 00:43) [182]

Че то ты как то не так сделал. Надо было бы сделать отдельный класс-компонент наследник TWinControl например и его экземпляры создавать на форме, у каждого такого класса должен быть свой поток поставляющий данные для отрисовки и свой постоянно живущий в нем TBitmap который потоком обновляется, этот же TBitmap должен отрисовываться по WM_PAINT на окне этого компонента.

Ладно завтра разберемся. Это весьма все просто.

← →
3asys ©   (2012-01-09 00:44) [183]

их должно быть по числу участников конференции - у каждого -свое окно в котором транслируется видео этого участника.
Смотрите, в отмеченном Вами куске действительно стоит форма клиента, а не та, которую я создаю в run-time. НО - создаю я форму в одной процедуре (CreateNewUserTranslation), а рисую на ней в другой (WndProc).
Тогда, как передать именно созданную форму в процедуру рисования?

← →
3asys ©   (2012-01-09 00:46) [184]

Спасибоб, сейчас попробую написать.

← →
DVM ©   (2012-01-09 00:47) [185]


> Тогда, как передать именно созданную форму в процедуру рисования?

переделать надо, завтра объясню как

← →
3asys ©   (2012-01-09 11:58) [186]

> DVM ©
Добрый день,
в процедуре

// &#209;&#238;&#231;&#228;&#224;&#237;&#232;&#229; &#238;&#234;&#237;&#224; &#232; &#231;&#224;&#239;&#243;&#241;&#234; &#226;&#232;&#228;&#229;&#238;-&#224;&#243;&#228;&#232;&#238; &#242;&#240;&#224;&#237;&#241;&#235;&#255;&#246;&#232;&#232; &#239;&#238;&#235;&#252;&#231;&#238;&#226;&#224;&#242;&#229;&#235;&#255;:
procedure TfVideoClient.CreateNewUserTranslation(Host : String; Port : Integer; UserName : String);
var
 NewClntTransl : TfVideoClient;
 Handle : HWND;
 b : TBitmap;
begin
 NewClntTransl:=TfVideoClient.Create(fVideoClient);
 NewClntTransl.Host:=Host;
 NewClntTransl.Port := Port;
 NewClntTransl.Caption:=UserName;
 NewClntTransl.Show;
 b:=TBitmap.Create;
 Handle:=NewClntTransl.Handle;
 VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password, Handle);
 AudioThread := THTTPInputThread.Create(Host, Port, AudioPath, UserName, Password, Handle);
end;

я создаю экземпляр клиента и его собственные видео и аудио потоки (VideoThread, AudioThread).
Далее эти потоки обрабатываются THTTPInputThread. В ходе обработки видеопотока создается

SendMessage(FHandle, FSendNewFrameMessage, 0, Longint(FrameData));

которая передает картинку форме с handle = FHandle
Далее в обработчике

procedure TfVideoClient.WndProc(var Msg: TMessage);
var
 FrameData: PFrameData;
 jpeg : TJPEGImage;
 b : TBitmap;
begin
 if Msg.Msg = FSendNewFrameMessage then
 begin
   // &#199;&#224;&#227;&#240;&#243;&#231;&#234;&#224; &#228;&#224;&#237;&#237;&#251;&#245; &#226; &#239;&#238;&#242;&#238;&#234;, &#226;&#251;&#227;&#240;&#243;&#231;&#234;&#224; &#238;&#242;&#242;&#243;&#228;&#224; &#232;&#245; &#226; Jpeg
   // &#228;&#229;&#234;&#238;&#228;&#232;&#240;&#238;&#226;&#224;&#237;&#232;&#229; &#232; &#238;&#242;&#240;&#232;&#241;&#238;&#226;&#234;&#224;
   FrameData := PFrameData(Msg.Lparam);
   VideoStream.Clear;
   VideoStream.WriteBuffer(FrameData^.FrameData^, FrameData^.FrameDataLen);

   jpeg:=TJPEGImage.Create;
   VideoStream.Position:=0;
   jpeg.LoadFromStream(VideoStream);
   b:=TBitmap.Create;
   b.Assign(jpeg);
   // &#207;&#238;&#228;&#227;&#238;&#237;&#234;&#224; &#240;&#224;&#231;&#236;&#229;&#240;&#224; &#244;&#238;&#240;&#236;&#251; &#239;&#238;&#228; &#240;&#224;&#231;&#236;&#229;&#240; &#232;&#231;&#238;&#225;&#240;&#224;&#230;&#229;&#237;&#232;&#255;:
   fVideoClient.Width:=b.Width;
   fVideoClient.Height:=b.Height;
   // &#194;&#251;&#226;&#238;&#228; &#234;&#224;&#240;&#242;&#232;&#237;&#234;&#232; &#237;&#224; &#234;&#224;&#237;&#226;&#243;:
   fVideoClient.Canvas.Draw(0,0,b);

   jpeg.Free;
   b.Free;
 end
 else
   inherited;
end;
Надо бы вместо fVideoClient указать форму с FHandle, но как это сделать ?
пробовал FindWindow (по имени окна), но как на ней обновить bitmap? (и как при создании привязать bitmap к форме?)

← →
3asys ©   (2012-01-15 12:41) [187]

> DVM ©  
Сделал передачу Handle:
Передаю в ветвь hanle:

procedure TfVideoClient.CreateNewUserTranslation(Host : String; Port : Integer; UserName : String);
var
 NewClntTransl : TfVideoClient;
 Handle : HWND;
 b : TBitmap;
begin
 NewClntTransl:=TfVideoClient.Create(fVideoClient);
 NewClntTransl.Host:=Host;
 NewClntTransl.Port := Port;
 NewClntTransl.Caption:=UserName;
 NewClntTransl.Show;
 Handle:=NewClntTransl.Handle;
 VideoThread := THTTPInputThread.Create(Host, Port, VideoPath, UserName, Password, Handle);
 AudioThread := THTTPInputThread.Create(Host, Port, AudioPath, UserName, Password, Handle);
end;

Из ветви передаю в WndProc hanle в WParam:

SendMessage(FHandle, FSendNewFrameMessage, FHandle, Longint(FrameData));

В WndProc обрабатываю:

procedure TfVideoClient.WndProc(var Msg: TMessage);
var
 FrameData: PFrameData;
 jpeg : TJPEGImage;
 b : TBitmap;
 h : HWND;
begin
 if Msg.Msg = FSendNewFrameMessage then
 begin
   FrameData := PFrameData(Msg.Lparam);
   h:=Msg.WParam;
   VideoStream.Clear;
   VideoStream.WriteBuffer(FrameData^.FrameData^, FrameData^.FrameDataLen);

   jpeg:=TJPEGImage.Create;
   VideoStream.Position:=0;
   jpeg.LoadFromStream(VideoStream);
   b:=TBitmap.Create;
   b.Assign(jpeg);
   TForm(FindControl(h)).Width:=b.Width;
   TForm(FindControl(h)).Height:=b.Height;
   TForm(FindControl(h)).Canvas.Draw(0,0,b);

   jpeg.Free;
   b.Free;
 end
 else
   inherited;
end;


Вроде все работает.
Но хотелось бы более красиво - как Вы предлагали.
Как это сделать?


Страницы: 1 2 3 4 5 вся ветка

Форум: "Начинающим";
Текущий архив: 2012.05.20;
Скачать: [xml.tar.bz2];

Наверх





Память: 1.4 MB
Время: 0.012 c
2-1326953184
OW
2012-01-19 10:06
2012.05.20
Из потока надо передать строку в VCL сообщением

4-1256831521
reactor
2009-10-29 18:52
2012.05.20
Как считать информацию из Combobox-а

15-1326141003
Юрий
2012-01-10 00:30
2012.05.20
С днем рождения ! 10 января 2012 вторник

15-1326400202
Юрий
2012-01-13 00:30
2012.05.20
С днем рождения ! 13 января 2012 пятница

15-1326573005
Юрий
2012-01-15 00:30
2012.05.20
С днем рождения ! 15 января 2012 воскресенье




Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский