| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Передача видео и звука с помощью Indy [D7]

Страницы:   < 1 2 3 4 5 6 7 8 9 10 >

3asys ©   (2011-11-26 15:48:00) 

На клиенте получаю видео и звук с 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 я сообразить не могу.
Как это сделать?

---

DVM   (2011-12-01 00:05:00) [101]


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:00) [102]


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;



---

3asys   (2011-11-30 23:58:00) [103]

Спасибо :)

---

DVM   (2011-11-30 23:57:00) [104]

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

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

---

DVM   (2011-11-30 23:55:00) [105]

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


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

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

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

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

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

---

3asys   (2011-11-30 23:49:00) [106]

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

---

DVM   (2011-11-30 23:45:00) [107]

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

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

---

3asys   (2011-11-30 23:45:00) [108]

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

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

---

3asys   (2011-11-30 23:41:00) [109]

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

---

3asys   (2011-11-30 23:35:00) [110]

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

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:31:00) [111]

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

---

DVM   (2011-11-30 22:56:00) [112]

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

---

DVM   (2011-11-30 22:54:00) [113]

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


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

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

---

3asys   (2011-11-30 22:52:00) [114]

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

---

DVM   (2011-11-30 22:50:00) [115]

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

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

---

3asys   (2011-11-30 22:48:00) [116]

> DVM ©

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

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


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

---

DVM   (2011-11-30 22:41:00) [117]

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

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

---

3asys   (2011-11-30 22:39:00) [118]

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

---

3asys   (2011-11-30 22:27:00) [119]

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

---

DVM   (2011-11-30 22:18:00) [120]

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

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

---

Страницы:   < 1 2 3 4 5 6 7 8 9 10 >

Наверх