Delphi视频流Http Server

Question

Delphi视频流Http Server

如何使用Indy HTTP Server实现以下功能.客户端访问http:// server_name:port,服务器返回视频流,该视频流存储在http:// server_name_video:port/video1.mpg

Answer 1

TIdHTTPServer本身不支持流媒体.你必须手动实现它.在您的OnCommandGet事件处理程序中,AResponseInfo根据需要将所需的值分配给参数,例如ContentType和TransferEncoding,并保持ContentText和ContentStream属性未分配,然后调用AResponseInfo.WriteHeader()仅将响应标头发送到客户端,然后输入循环以块的形式写入视频媒体数据(根据RFC 2616第3.6.1节"分块传输编码"中描述的格式,直到客户端断开连接或到达媒体结束.例如:

procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  FS: TFileStream;
  Buf: TIdBytes;
  BufLen: Integer;
begin
  if ARequestInfo.Document <> '/' then
  begin
    AResponseInfo.ResponseNo := 404;
    Exit;
  end;
  FS := TFileStream.Create('video1.mpg', fmOpenRead or fmShareDenyWrite);
  try
    AResponseInfo.ResponseNo := 200;
    AResponseInfo.ContentType := 'video/mpeg';
    AResponseInfo.TransferEncoding := 'chunked';
    AResponseInfo.WriteHeader;

    SetLength(Buf, 1024);
    repeat
      BufLen := FS.Read(Buf[0], 1024);
      if BufLen < 1 then Break;
      AContext.Connection.IOHandler.WriteLn(IntToHex(BufLen, 1));
      AContext.Connection.IOHandler.Write(Buf, BufLen);
      AContext.Connection.IOHandler.WriteLn;
    until False;

    AContext.Connection.IOHandler.WriteLn('0');
    AContext.Connection.IOHandler.WriteLn;
  finally
    FS.Free;
  end;
end;

Run Code Online (Sandbox Code Playgroud)

另一方面,如果您尝试从其他服务器流式传输媒体,则会更复杂一些.您必须向其他服务器发送请求,接收响应,然后将数据转发给您的客户端.但是,TIdHTTP不支持流媒体,因此很难将其用于此目的.您可能最终必须TIdTCPClient直接使用并自己实现HTTP协议的必要部分,例如:

procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  Client: TIdTCPClient;
  Headers: TIdHeaderList;
  S, ResponseCode, ResponseText: string;
  Size: Int64;
  Strm: TIdTCPStream;    
begin
  if ARequestInfo.Document <> '/' then
  begin
    AResponseInfo.ResponseNo := 404;
    Exit;
  end;
  Client := TIdTCPClient.Create;
  try
    Client.Host := 'server_name_video';
    Client.Port := port;
    Client.Connect;
    try
      Client.IOHandler.WriteLn('GET /video1.mpg HTTP/1.0');
      Client.IOHandler.WriteLn('Host: server_name_video');
      Client.IOHandler.WriteLn;

      ResponseText := Client.IOHandler.ReadLn;
      Fetch(ResponseText);
      ResponseText := TrimLeft(ResponseText);
      ResponseCode := Fetch(ResponseText, ' ', False);
      ResponseCode := Fetch(ResponseCode, '.', False);

      if ResponseCode <> '200' then
      begin
        AResponseInfo.ResponseNo := StrToInt(ResponseCode);
        AResponseInfo.ResponseText := ResponseText;
        Exit;
      end;

      Headers := TIdHeaderList.Create(QuoteHTTP);
      try
        Headers.FoldLength := MaxInt;

        repeat
          s := Client.IOHandler.ReadLn;
          if s = '' then Break;
          Headers.Add(s);
        until False;

        Strm := TIdTCPStream.Create(AContext.Connection);
        try
          AResponseInfo.ResponseNo := 200;
          AResponseInfo.ContentType := Headers.Values['Content-Type'];

          if Pos('chunked', Headers.Values['Transfer-Encoding']) <> 0 then
          begin
            AResponse.TransferEncoding := 'chunked';
            AResponseInfo.WriteHeader;

            repeat
              s := Client.IOHandler.ReadLn;
              AContext.Connection.IOHandler.WriteLn(s);
              Size := StrToInt64('$'+Fetch(s, ';'));
              if Size = 0 then Break;
              Client.IOHandler.ReadStream(Strm, Size, False);
              s := Client.IOHandler.ReadLn;
              AContext.Connection.IOHandler.WriteLn(s);
            until false;

            repeat
              s := Client.IOHandler.ReadLn;
              AContext.Connection.IOHandler.WriteLn(s);
            until s = '';
          end
          else if Headers.IndexOfName('Content-Length') <> -1 then
          begin
            Size := StrToInt64(Headers.Values['Content-Length']);
            AResponseInfo.ContentLength := Size;
            AResponseInfo.WriteHeader;
            if Size > 0 then
              Client.IOHandler.ReadStream(Strm, Size, False);
          end else
          begin
            AResponseInfo.CloseConnection := true;
            AResponseInfo.WriteHeader;
            try
              Client.IOHandler.ReadStream(Strm, -1, True);
            except
              on E: EIdSocketError do begin
                if not (E.LastError in [10053, 10054, 10058]) then
                  raise;
              end;
            end;
          end;
        finally
          Strm.Free;
        end;
      finally
        Headers.Free;
      end;
    finally
      Client.Disconnect;
    end;
  finally
    Client.Free;
  end;
end;

Run Code Online (Sandbox Code Playgroud)

当然,如果需要,您还必须实现HTTP身份验证,字节范围请求等.

更新:或者,不是TIdTCPClient直接使用,而是可以使用TIdHTTP它,只需给它一个输出TStream,在写入时写回原始客户端.您可以TIdEventStream为此目的使用,或编写自己的TStream类,例如:

type
  TMyStream = class(TIdBaseStream)
  protected
    FHTTP: TIdHTTP;
    FClient: TIdIOHandler;
    FResponse: TIdHTTPResponseInfo;
    function IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
    function IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint; override;
    function IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
    procedure IdSetSize(ASize: Int64); override;
  public
    constructor Create(AHTTP: TIdHTTP; AClient: TIdIOHandler; AResponse: TIdHTTPResponseInfo);
    destructor Destroy; override;
  end;

constructor TMyStream.Create(AHTTP: TIdHTTP; AClient: TIdIOHandler; AResponse: TIdHTTPResponseInfo);
begin
  inherited Create;
  FHTTP := AHTTP;
  FClient := AClient;
  FResponse := AResponse;
end;

destructor TMyStream.Destroy;
begin
  if FResponse.HeaderHasBeenWritten then
  begin
    FClient.WriteLn('0');
    FClient.WriteLn('');
  end;
end;

function TMyStream.IdRead(var VBuffer: TIdBytes; AOffset, ACount: Longint): Longint;
begin
  Result := 0;
end;

function TMyStream.IdWrite(const ABuffer: TIdBytes; AOffset, ACount: Longint): Longint;
begin
  if not FResponse.HeaderHasBeenWritten then
  begin
    FResponse.ResponseNo := 200;
    FResponseInfo.ContentType := FHTTP.Response.ContentType;
    FResponse.TransferEncoding := 'chunked';
    FResponse.WriteHeader;
  end;
  FClient.WriteLn(IntToHex(IndyLength(ABuffer, ACount, AOffset)));
  FClient.Write(ABuffer, ACount, AOffset);
  FClient.WriteLn;
end;

function TMyStream.IdSeek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
begin
  Result := 0;
end;

procedure TMyStream.IdSetSize(ASize: Int64);
begin
end;

procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  HTTP: TIdHTTP;
  Strm: TMyStream;
begin
  if ARequestInfo.Document <> '/' then
  begin
    AResponseInfo.ResponseNo := 404;
    Exit;
  end;
  HTTP := TIdHTTP.Create;
  try
    HTTP.HTTPOptions := HTTP.HTTPOptions + [hoNoProtocolErrorException];
    Strm := TMyStream.Create(HTTP, AContext.Connection.IOHandler, AResponseInfo);
    try
      HTTP.Get('http://server_name_video:'+IntToStr(port)+'/video1.mpg', Strm);
    finally
      Strm.Free;
    end;
    if not AResponseInfo.HeaderHasBeenWritten then
    begin
      AResponseInfo.ResponseNo := HTTP.ResponseCode;
      AResponseInfo.ResponseText := HTTP.ResponseText;
    end;
  finally
    HTTP.Free;
  end;
end;

Run Code Online (Sandbox Code Playgroud)

或者,如果其他服务器支持chunked响应,您可以:

使用新TIdHTTP.OnChunkReceived事件将每个收到的块写入客户端,类似于上面没有使用自定义TStream(你仍然必须提供一个TStreamto TIdHTTP.Get().你可以使用TIdEventStream它,而不是为它分配任何事件处理程序,因此数据被丢弃.这可能会在未来发生变化).
启用TIdHTTP新hoNoReadChunked标志,然后将原始数据从TIdHTTP.IOHandler直接隧道传送到客户端,例如使用TIdTCPStreamwith AContext.Connection.IOHandler.WriteStream().

新的TIdHTTP标志和OnChunkReceived事件

归档时间：	10 年，11 月前
查看次数：	5088 次
最近记录：	8 年，10 月前