Форум: "Начинающим";
Текущий архив: 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
// Çäåñü çàãðóçêà äàííûõ â ïîòîê, âûãðóçêà îòòóäà èõ â Jpeg
// äåêîäèðîâàíèå è îòðèñîâêà
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; // Äëÿ 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;
// Âîçâðàò â áëîêèðóþùèé ðåæèì
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
// Åñëè áóôåð ñòàë ñëèøêîì áîëüøîé
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; // Äëÿ 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;
// Âîçâðàò â áëîêèðóþùèé ðåæèì
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
// Åñëè áóôåð ñòàë ñëèøêîì áîëüøîé
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
// ÎÁÐÀÁÎÒÊÀ ÀÓÄÈÎ - ÏÎÒÎÊÀ:
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); // ÂÎÑÏÐÎÈÇÂÎÄÈÌ ÇÂÓÊ
result := -1;// ×ÒÎÁÛ ÍÅ ÎÁÐÀÁÀÒÛÂÀËÎÑ&# 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 // ÎÁÐÀÁÎÒÊÀ ÂÈÄÅÎ - ÏÎÒÎÊÀ:
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 ©
Добрый день,
в процедуре
// Ñîçäàíèå îêíà è çàïóñê âèäåî-àóäèî òðàíñëÿöèè ïîëüçîâàòåëÿ:
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
// Çàãðóçêà äàííûõ â ïîòîê, âûãðóçêà îòòóäà èõ â Jpeg
// äåêîäèðîâàíèå è îòðèñîâêà
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;
Надо бы вместо 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.016 c