| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Передача видео и звука с помощью Indy [D7]
3asys © (2011-11-26 15:48:00)
Страницы: < 1 2 3 4 5 6 7 8 9 10 >
На клиенте получаю видео и звук с 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 я сообразить не могу.
Как это сделать?
3asys (2011-12-19 22:54:00) [41]:)
наверно я непавильно объяснил, что имею в виду:
допустим , я уже знаю и IP и порт сервера (одного из участников), с которого мне нужно получить поток. IP у этого сервера динамический и DNS не настроен. Как мой клиент сможет получить поток от этого сервера? - ведь достучаться к этому серверу, ввиду отсутствия DNS из интернета невозможно. Как же мой клиент получит от этого сервера поток? (может я чего-то не догоняю...)
DVM (2011-12-19 22:45:00) [42]А если участник конференции сидит за NAT то он еще должен сообщать серверу и порт, на который надо стучаться. А сам порт у него в настройках должен запоминаться.
DVM (2011-12-19 22:43:00) [43]
> 3asys © (19.12.11 22:39) [144]
Я ж в 141 вроде бы все написал:
> Вот все эти данные и должны отправляться/приниматься на/с
> сервер/а
Клиент регистрируется на сервере и сообщает ему свой IP. Остальные участники конференции могут его там же получить.
3asys (2011-12-19 22:39:00) [44]> У кого динамический IP у одного из участников видеоконференции или у центрального сервера?
у участников конференции. Уцентрального сервера - статический IP
DVM (2011-12-19 22:34:00) [45]
> 3asys © (19.12.11 22:22) [142]
> а для этого он должен быть настроен на IP сервера и определенный
> порт, но как клиент подключится к серверу имеющему динамический
> IP? Как он получит с него поток?
>
>
У кого динамический IP у одного из участников видеоконференции или у центрального сервера?
3asys (2011-12-19 22:22:00) [46]> DVM ©
я имел в виду несколько другое:
для того, чтобы получить поток от сервера, клиент должен к нему подключиться, а для этого он должен быть настроен на IP сервера и определенный порт, но как клиент подключится к серверу имеющему динамический IP? Как он получит с него поток?
DVM (2011-12-19 18:06:00) [47]
> 3asys © (19.12.11 12:17) [140]
Попробуй для начала разбить задачу на части.
1) Определи, в каких состояниях может находится клиент (ожидание, исходящий вызов, входящий вызов, присоединение к конференции, создание конференции и т.д.)
2) Определи, что клиенту надо знать самому в каждом состоянии и что надо сообщить другим.
Вот все эти данные и должны отправляться/приниматься на/с сервер/а
Сервер можно тоже HTTP раз уж начали его использовать.
3asys (2011-12-19 12:17:00) [48]Добрый день :)
> DVM ©
Насколько я понимаю, в связи тем, что в рамках системы видеоконференцсвязи, вещание (видео-аудио потока) ведется клиентами (на борту у каждого из которых находится и локальный сервер отдающий поток и локальный клиент принимающий потоки от других участников конференции) независимо друг от друга, то информировать участников об IP-адресах с которых вещают участники конференции должен глобальный (для этой конференции) сервер. При этом IP по которому можно подключиться к серверу есть только у глобального сервера, а у локальных серверов (на борту клиентов) таких IP нет.
Как организовать подключение участников конференции к локальным серверам друг друга?
3asys (2011-12-11 23:26:00) [49]Спасибо Вам БОЛЬШОЕ
DVM (2011-12-11 23:12:00) [50]
> 3asys © (11.12.11 22:58) [136]
>
Еще метод GetResponse совершенствовать надо. Сейчас он никак не учитывает Content-Length присылаемый ему с каждым кадром, а должен вообще то. Используя Content-Length мы можем не пытаться искать маркеры начала и конца кадра получив очередную порцию данных, что положительно скажется на производительности. Но это ты если хочешь сам уже пытайся.
DVM (2011-12-11 23:08:00) [51]
> 3asys © (11.12.11 22:58) [136]
> Что бы Вы порекомендовали в первую очередь для уменьшения
> задержек
Отказаться от модуля jpeg в пользу Intel Jpeg Library 1.5. Она бесплатная в этой версии. В интернете есть заголовочные файлы для нее и есть модуль-переходник для кодирования-декодирования в-из TBitamp. Правда замечены за ней проблемы с многопоточностью, но это решаемо.
> и снижения трафика?
Переходить на MPEG4 ? Осваивать какой-то кодер-декодер придется. Метод передачи можно оставить тот же. Кодер-декодер FFMPEG можно взять.
Ну или FPS можно понижать.
Вообще данный метод позволяет выжать на средней машине 400 FPS (640x480) суммарно легко при использовании IJL.
3asys (2011-12-11 22:58:00) [52]> DVM ©
Да, спасибо, сегодня увидел.
Я смотрю Ваши рекомендации по улучшению/доработке.
Что бы Вы порекомендовали в первую очередь для уменьшения задержек (чуть подтормаживает, даже при нахождении сервера и клиента на одной и той же машине) и снижения трафика?
3asys (2011-12-11 22:46:00) [53]код модуля uBuffer см. [86],[87],[88].
Все тестировалось на Delphi7.
DVM (2011-12-11 22:45:00) [54]
> 3asys ©
вот тут чем то похожим человек занимается
http://www.delphimaster.ru/cgi-bin/forum.pl?id=1322690080&n=7
3asys (2011-12-11 22:41:00) [55]
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 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.
3asys (2011-12-11 22:39:00) [56]
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:36:00) [57]Для интересующихся, вот полный код клиента (сервер в [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:30:00) [58]ЕСТЬ !!!
РАБОТАЕТ :)
СПАСИБО БОЛЬШОЕ !!!
DVM (2011-12-11 22:24:00) [59]
> 3asys © (11.12.11 22:21) [128]
> Что еще может быть?
VideoStream.WriteBuffer(FrameData^.FrameData ^, FrameData^.FrameDataLen);
3asys (2011-12-11 22:21:00) [60]FSendNewFrameMessage регистрируется в
constructor THTTPInputThread.Create
FSendNewFrameMessage := RegisterWindowMessage('WM_NEW_FRAME');
При выполнении программы оно = 49778 всегда.
Перед
VideoStream.WriteBuffer(FrameData^.FrameData, FrameData^.FrameDataLen);
поставил:
VideoStream.Clear;
Результат не изменился, к сожалению. Опять Access violation и error #53
Что еще может быть?
| |
