| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / 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-03 00:41:00) [81]в остальном компилируется.
Что с этими идентификаторами делать?
3asys (2011-12-03 00:39:00) [82]не декларированный идентификатор InetAddr в выражении
FAddr.sin_addr.s_addr := InetAddr(AnsiString(FHost));
в функции:
function THTTPInputThread.Init: integer;
и также недекларированный идентификатор FWindowHandle в выражении
SendMessage(FWindowHandle, WM_NEWFRAME, 0, Longint(FrameData));
в профедуре: procedure THTTPInputThread.Execute;
DVM (2011-12-03 00:21:00) [83]
> Германн © (03.12.11 00:11) [104]
> Что-то мне подсказывает, что использование ICS вместо инди
> решило бы проблему без такой кучи писанины :)
Да можно и с инди и с ICS. Да не сильно короче бы вышло.
Германн (2011-12-03 00:11:00) [84]
> DVM © (02.12.11 18:54) [98]
>
> В этот мой буфер надо принимать данные чистым сокетом без
> инди.
Что-то мне подсказывает, что использование ICS вместо инди решило бы проблему без такой кучи писанины :)
Но могу и ошибаться.
3asys (2011-12-03 00:06:00) [85]Спасибо!
DVM (2011-12-02 23:19:00) [86]
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;
разбирайся, если что непонятно спрашивай.
DVM (2011-12-02 23:16:00) [87]
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:15:00) [88]
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:14:00) [89]
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 18:54:00) [90]В этот мой буфер надо принимать данные чистым сокетом без инди.набросаю тебе вечером сегодня код приема упрощенный. Для инди надо по другому
3asys (2011-12-02 16:58:00) [91]> DVM ©
Добрый день
вопрос по клиенту: пытаюсь организовать прием трафика от сервера. Как записать в Buffer данные? - запись вида IdTCPClient1.Socket.ReadStream(...) не подходит, т.к. TBuffer = class(TObject). Как быть?
DVM (2011-12-01 14:19:00) [92]
> Anatoly Podgoretsky © (01.12.11 12:58) [95]
> Звук - WAV
это контейнер, в его случае нет файлов, значит нет и Wav.
Anatoly Podgoretsky (2011-12-01 12:58:00) [93]> 3asys (01.12.2011 12:02:32) [92]
Звук - WAV, MP3
3asys (2011-12-01 12:18:00) [94]хорошо
DVM (2011-12-01 12:13:00) [95]
> 3asys © (01.12.11 12:02) [92]
> а звук как?
Посмотрел документ от Axis ссылка на который дана выше? Это для начала.
3asys (2011-12-01 12:02:00) [96]понял.
А как должна осуществляться трансляция звука - мы транслировали в поток jpeg-и, а звук как?
DVM (2011-12-01 10:29:00) [97]
> 3asys © (01.12.11 00:36) [89]
> а на чем визуализировать изображение? на TImage?
Я бы на твоем месте, наверное объединил код приема изображения с самописным компонентом, на Canvas которого и выводил бы изображение. Так как прием данных надо делать в отдельном потоке скорее всего, то обновление изображения (которое должно происходить в основном потоке) производил по мере поступления уведомлений от оп потока, что принят новый кадр. Эти уведомления лучше всего сделать на базе сообщений. Synchronize тоже можно, но тяжеловесен он больно.
На TImage лучше не выводить, этот компонент не предназначен для рисования и динамического содержимого, лучше TPaintBox. Или на канву формы (панели какой нить) даже.
brother (2011-12-01 06:44:00) [98]на canvas формы
3asys (2011-12-01 00:36:00) [99]Спасибо, а на чем визуализировать изображение? на TImage?
DVM (2011-12-01 00:08:00) [100]
// Добавление данных в конец буфера --------------------------------------------
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 к сожалению не подойдет.
| |
