1. 技术文章
  2. How send/receive frames of a live webcam? [ SOLVED ]

How send/receive frames of a live webcam? [ SOLVED ]

由 只愿长相守 提交于 2019-12-08 11:36:55

问题


I'm trying implement a example of Client > Server where the Client must be able to send frames of a live webcam. In my tests the Client is sending fine, but on Server side i'm not receiving any frame, only the total of bytes sent and the lines after of:

if Stream.Size = stSize then

never are executed.

Someone know why this is happening? probably because is a big flux of data being received?

This is my code:

Server:

unit Server;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.ExtCtrls, Vcl.StdCtrls, System.Win.ScktComp, Vcl.Imaging.jpeg;

type
  TCam_Thread = class(TThread)
  private
    Socket: TCustomWinSocket;
  protected
    procedure Execute; override;
  public
    constructor Create(aSocket: TCustomWinSocket);
  end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    ServerSocket1: TServerSocket;
    procedure ServerSocket1Accept(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TCam_Thread.Create(aSocket: TCustomWinSocket);
begin
  inherited Create(true);
  Socket := aSocket;
  FreeOnTerminate := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ServerSocket1.Port := 1234;
  ServerSocket1.Active := true;
end;

procedure TForm1.ServerSocket1Accept(Sender: TObject; Socket: TCustomWinSocket);
var
  WC: TCam_Thread;
begin
  WC := TCam_Thread.Create(Socket);
  WC.Resume;
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  //ShowMessage('Client connected!');
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  //ShowMessage('Client disconnected!');
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ErrorCode := 0;
  Exit;
end;

procedure TForm1.ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
begin
  ShowMessage('Server listen on port: ' + IntToStr(Socket.LocalPort));
end;

procedure TCam_Thread.Execute;
var
  s: string;
  Stream: TMemoryStream;
  Receiving: Boolean;
  stSize: Integer;
  jpg: TJpegImage;
begin
  while not Terminated and Socket.Connected do
  begin
    if Socket.ReceiveLength > 0 then
    begin
      s := Socket.ReceiveText;

      if not Receiving then
      begin
        if Pos(#0, s) > 0 then
        begin
          stSize := strToInt(Copy(s, 1, Pos(#0, s) - 1));
          Synchronize(nil,
            procedure
            begin
              Form1.Caption := 'Size of data received: ' + intToStr(stSize div 1024) + ' KBs';
            end);
        end;

        Stream := TMemoryStream.Create;
        Receiving := true;
        Delete(s, 1, Pos(#0, s));
      end;
      try
        Stream.Write(AnsiString(s)[1], length(s));

        if Stream.Size = stSize then
        begin
          Stream.Position := 0;
          Receiving := false;
          jpg := TJpegImage.Create;
          jpg.LoadFromStream(Stream);
          Synchronize(nil,
            procedure
            begin
              Form1.Image1.Picture.Assign(jpg);
            end);
          Stream.Free;
          jpg.Free;
        end;
      except
        Stream.Free;
        jpg.Free;
      end;
    end;
  end;
end;

end.

Client:

unit Client;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.ExtCtrls, System.Win.ScktComp;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ClientSocket1: TClientSocket;
    procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  uWebCam;

{$R *.dfm}

procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Camera := TCamera.Create(Panel1, Socket);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ClientSocket1.Host := '192.168.0.10';
  ClientSocket1.Port := 1234;
  ClientSocket1.Active := True;
end;

end.

uWebCam.pas

unit uWebCam;

interface

uses
  Windows, Messages, Classes, SysUtils, Graphics, Controls, ExtCtrls, Jpeg,
  ScktComp;

type
  PVIDEOHDR = ^TVIDEOHDR;

  TVIDEOHDR = packed record
    lpData: PBYTE;
    dwBufferLength: DWORD;
    dwBytesUsed: DWORD;
    dwTimeCaptured: DWORD;
    dwUser: DWORD;
    dwFlags: DWORD;
    dwReserved: array[0..3] of DWORD;
  end;

type
  TCamera = class(TObject)
  private
    Parent: TPanel;
    VideoHwnd: HWND;
    Sock: TCustomWinSocket;
    procedure Resize(Sender: TObject);
  public
    constructor Create(Owner: TPanel; Socket: TCustomWinSocket);
    destructor Destroy; override;
    procedure SetSize;
    procedure SetSource;
  end;

var
  Camera: TCamera;

implementation

uses
 uDrawDib;

const
  WM_CAP_START = WM_USER;
  WM_CAP_STOP = WM_CAP_START + 68;
  WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
  WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
  WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41;
  WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42;
  WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
  WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
  WM_CAP_SET_SCALE = WM_CAP_START + 53;
  WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
  WM_CAP_SEQUENCE = WM_CAP_START + 62;
  WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;
  WM_CAP_GET_VIDEOFORMAT = (WM_CAP_START + 44);

function capCreateCaptureWindowA(lpszWindowName: PChar; dwStyle: LongInt; x: Integer; y: Integer; nWidth: Integer; nHeight: Integer; ParentWin: HWND; nId: Integer): HWND; stdcall; external 'AVICAP32.DLL';

function capFrameCallback(hCapWnd: HWND; lpVHDR: PVIDEOHDR): DWORD; stdcall;
var
  ABmp: TBitmap;
  Jpg: TJPEGImage;
  MS: TMemoryStream;
  BmpInfo: TBitmapInfo;
  Hdb: Thandle;
begin
  Result := 0;

  ZeroMemory(@BmpInfo, SizeOf(BmpInfo));

  ABmp := TBitmap.Create;
  ABmp.Pixelformat := pf32bit;

  SendMessage(hCapWnd, WM_CAP_GET_VIDEOFORMAT, wParam(SizeOf(BmpInfo)), LPARAM(@BmpInfo));

  with ABmp do
  begin
    Width := BmpInfo.bmiHeader.biWidth;
    Height := BmpInfo.bmiHeader.biHeight;
    Hdb := DrawDibOpen;
    DrawDibDraw(Hdb, Canvas.Handle, 0, 0, BmpInfo.BmiHeader.biWidth, BmpInfo.bmiHeader.biHeight, BmpInfo.bmiHeader, lpVHDR^.lpData, 0, 0, BmpInfo.bmiHeader.biWidth, BmpInfo.bmiHeader.biHeight, 0);
    DrawDibClose(Hdb);
  end;

  try
    MS := TMemoryStream.Create;
    Jpg := TJPEGImage.Create;
    Jpg.Assign(ABmp);
    Jpg.CompressionQuality := 100;
    Jpg.SaveToStream(MS);
    MS.Position := 0;
    Camera.Sock.SendText(IntToStr(MS.Size) + #0);
    Camera.Sock.SendStream(MS);
  finally
  // Invalid Pointer Operation Exception :(
    {MS.Free;
    Jpg.Free;
    ABmp.free;}
  end;
end;

constructor TCamera.Create(Owner: TPanel; Socket: TCustomWinSocket);
begin
  Sock := Socket;
  try
    VideoHwnd := capCreateCaptureWindowA('MyCamera', WS_CHILD or WS_VISIBLE, 0, 0, Owner.Width, Owner.Height, Owner.Handle, 0);
    if (SendMessage(VideoHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0) then
    begin
      SendMessage(VideoHwnd, WM_CAP_SET_CALLBACK_FRAME, 0, Integer(@capFrameCallback));
      SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);
      SendMessage(VideoHwnd, WM_CAP_SET_PREVIEWRATE, 100, 0);
      SendMessage(VideoHwnd, WM_CAP_SET_SCALE, -1, 0);
      Parent := Owner;
      Owner.OnResize := Resize;
    end;
  except
    exit;
  end;
end;

destructor TCamera.Destroy;
begin
  if (VideoHwnd <> 0) then
  begin
    SendMessage(VideoHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    SetParent(VideoHwnd, 0);
    SendMessage(VideoHwnd, WM_CLOSE, 0, 0);
  end;
  inherited;
end;

procedure TCamera.Resize(Sender: TObject);
begin
  inherited;
  if (VideoHwnd <> 0) then
  begin
    SetWindowPos(VideoHwnd, HWND_BOTTOM, 0, 0, Parent.Width, Parent.Height, SWP_NOMOVE or SWP_NOACTIVATE);
  end;
end;

procedure TCamera.SetSize;
begin
  SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
end;

procedure TCamera.SetSource;
begin
  SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0);
end;

end.

uDrawDib.pas

unit uDrawDib;

interface

uses
  Windows;

// DrawDib flags

const
  DDF_UPDATE =        $0002;           // re-draw the last DIB
  DDF_SAME_HDC =      $0004;           // HDC same as last call (all setup)
  DDF_SAME_DRAW =     $0008;           // draw params are the same
  DDF_DONTDRAW =      $0010;           // dont draw frame, just decompress
  DDF_ANIMATE =       $0020;           // allow palette animation
  DDF_BUFFER =        $0040;           // always buffer image
  DDF_JUSTDRAWIT =    $0080;           // just draw it with GDI
  DDF_FULLSCREEN =    $0100;           // use DisplayDib
  DDF_BACKGROUNDPAL = $0200;           // Realize palette in background
  DDF_NOTKEYFRAME =   $0400;           // this is a partial frame update, hint
  DDF_HURRYUP =       $0800;           // hurry up please!
  DDF_HALFTONE =      $1000;           // always halftone

  DDF_PREROLL =       DDF_DONTDRAW;    // Builing up a non-keyframe
  DDF_SAME_DIB =      DDF_SAME_DRAW;
  DDF_SAME_SIZE =     DDF_SAME_DRAW;

  // display profiling
  PD_CAN_DRAW_DIB      = $0001;      // if you can draw at all
  PD_CAN_STRETCHDIB    = $0002;      // basicly RC_STRETCHDIB
  PD_STRETCHDIB_1_1_OK = $0004;      // is it fast?
  PD_STRETCHDIB_1_2_OK = $0008;
  PD_STRETCHDIB_1_N_OK = $0010;

  //
  WM_PALETTECHANGED = $311;
  WM_QUERYNEWPALETTE = $30F;

type
  hDrawDib = THandle;

  TDrawDibTime = record
    timeCount: LongInt;       // see below
    timeDraw: LongInt;        // time to draw bitmaps
    timeDecompress: LongInt;  // time to decompress bitmaps
    timeDither: LongInt;      // time to dither bitmaps
    timeStretch: LongInt;     // time to stretch bitmaps
    timeBlt: LongInt;         // time to transfer bitmaps (BitBlt)
    timeSetDIBits: LongInt;   // time to transfer bitmaps (SetDIBits)
  end;

function DrawDibBegin(hdd: hDrawDib; hDC: THandle; dxDest, dyDest: Integer;
  var lpbi: TBitmapInfoHeader; dxSrc, dySrc: Integer; wFlags: UInt): Boolean; stdcall;

function DrawDibChangePalette(hdd: hDrawDib; iStart, iLen: Integer;
  var lppe: TPaletteEntry): Boolean; stdcall;

function DrawDibClose(hdd: hDrawDib): Boolean; stdcall;

function DrawDibDraw(hdd: hDrawDib; hDC: THandle; xDst, yDst, dxDst, dyDst: Integer;
  var lpbi: TBitmapInfoHeader; Bits: Pointer; xSrc, ySrc, dxSrc, dySrc: Integer;
  wFlags: UInt): Boolean; stdcall;

function DrawDibEnd(hdd: hDrawDib): Boolean; stdcall;

function DrawDibGetBuffer(hdd: hDrawDib; var lpbi: TBitmapInfoHeader;
  dwSize, dwFlags: DWord): Pointer; stdcall;

function DrawDibGetPalette(hdd: hDrawDib): THandle; stdcall;

function DrawDibOpen: hDrawDib; stdcall;

function DrawDibProfileDisplay(var lpbi: TBitmapInfoHeader): Boolean; stdcall;

function DrawDibRealize(hdd: hDrawDib; hDC: THandle; fBackground: Bool): UInt; stdcall;

function DrawDibSetPalette(hdd: hDrawDib; hpal: Pointer): Boolean; stdcall;

function DrawDibStart(hdd: hDrawDib; rate: LongInt): Boolean; stdcall;

function DrawDibStop(hdd: hDrawDib): Boolean; stdcall;

function DrawDibTime(hdd: hDrawDib; var lpddtime: TDrawDibTime): Boolean; stdcall;

implementation

const
  DLL = 'MsVfW32.dll';

function DrawDibBegin; external DLL name 'DrawDibBegin';
function DrawDibChangePalette; external DLL name 'DrawDibChangePalette';
function DrawDibClose; external DLL name 'DrawDibClose';
function DrawDibDraw; external DLL name 'DrawDibDraw';
function DrawDibEnd; external DLL name 'DrawDibEnd';
function DrawDibGetBuffer; external DLL name 'DrawDibGetBuffer';
function DrawDibGetPalette; external DLL name 'DrawDibGetPalette';
function DrawDibOpen; external DLL name 'DrawDibOpen';
function DrawDibProfileDisplay; external DLL name 'DrawDibProfileDisplay';
function DrawDibRealize; external DLL name 'DrawDibRealize';
function DrawDibSetPalette; external DLL name 'DrawDibSetPalette';
function DrawDibStart; external DLL name 'DrawDibStart';
function DrawDibStop; external DLL name 'DrawDibStop';
function DrawDibTime; external DLL name 'DrawDibTime';

end.

来源：https://stackoverflow.com/questions/57533637/how-send-receive-frames-of-a-live-webcam-solved

标签
sockets
Delphi
client-server
delphi-10.3-rio
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!