displayremotescreenunit.pas

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

unit DisplayRemoteScreenUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Winsock, Winsock2, DrawDibUnit, PublicFunctionUnit, IocpHerder;
  
const 
  WM_DealDataMsg = WM_USER + 107;
  //display remote screen窗口使用的
  IDM_Orignal = 4001;
  IDM_Stretch = 4002;
  Use24BitColor = 4003;
  Use16BitColor = 4004;
  Use8BitColor = 4005;
  Use4BitColor = 4006;
  Use1BitColor = 4007;
  IDM_ShowCousor = 4008;
  IDM_AllowRemoteCtronl = 4009;
  IDM_SendCtrlAltDel = 4010;
  IDM_Restore = 4011;
  IDM_ExitServer = 4012;
  IDM_SaveSiglePic = 4013;
const
  BlockLength : byte = 32;
  //每个如下帧数，重绘全屏
  FreameCountRepaint = 20; 
type
  //屏幕图像描述头
  RawDataHeader = packed record
    CursorPosX, CursorPosY : Word;
    CursorType : Byte;
    PerBlockDataSize : Word; //每个分块图象的大小
    ImageHeaderSize : Word; //图象头大小－－包含了调色板
    BlockChangeRecordTabelByteSize : Word; //描述块变化情况的bit表，每bit代表一个块
    ImageDataSize : DWord;//图象数据大小，是按照先行后纵的方式一此一块的排列的
    ImageHeaderOffset : Word;//图像头的偏移量
    BlockChangeRecordTabelOffset : Word; //描述表的偏移量
    ImageDataOffset : Word;//图象数据偏移量
  end;
  pRawDataHeader = ^RawDataHeader;

type
  TDisplayRemoteScreen = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    //接收到的数据指针--不需要申请内存
    ReceivedData : Pointer;
    //数据文件描述头
    ReceivedDataHeader : RawDataHeader;
    //图象头信息--需要申请内存
    ImageInforHeaderData : PBitmapInfo;
    //绘制小块的图像头
    ImageInforPerBlockHeaderData : PBitmapInfo;
    //重整后的图象数据--系统自动分配的
    ImageBitsData : Pointer;
    //每行的图象数据的大小
    ByteWidthSize : Word;
    //每小块的每行的数据大小
    ByteWidthSizePerBlock : Word;
    //宽度分块数、高度分块数和总的分块数
    WidthBlockCount, HeightBlockCount, TotalBlockCount : Word;
    //屏幕的宽度和高度
    RemoteScreenWidth : word;
    RemoteScreenHeight : word;
    //鼠标和键盘消息的数据
    myTKeyAndCursorData : TKeyAndCursorData;
    //非stretch下，显示图象时的原点，可能都是负值
    xPaintBeg, yPaintBeg : integer;
    //DRAWDIB绘图使用
    hWndDc : HDC;
    hBitmap : Thandle;
    //bitblt绘图使用的
    hMemDC : HDC;
    hMemBitmap : Thandle;  
    //DrawDib使用的句柄
    EntireDrawDibHandle : HDRAWDIB;
    PerBlockDrawDibHandle : HDRAWDIB; 
    //需要在创建的时候，初始化的
    ClientWidth: Integer;
    ClientHeight: Integer;
    //计数器
    RemoteScreenCountIndex : Word;
    StretchRemoteScreenCountIndex : Word;
    //色深切换用
    wColorDepth : integer;
    ShowImageStyle : WORD;
    Bool_ShowCousor : Boolean;
    Bool_AllowRemoteCtronl : Boolean; 
    //用来发送鼠标键盘控制的单io数据
    CtrlPerHandleData : PPerHandleData;
    //原窗口处理函数指针
    prevWndProc : DWORD;
    //函数实例化指针
    FEnumProcInst: Pointer; 
    //capture mouse
    procedure DrawCursor(hMemDC : HDC; const MouseX, MouseY : Word; const CousorType : Byte);
    procedure DrawClientDC(hWndDc : HDC; const nXOriginSrc, nYOriginSrc : integer);
    procedure DrawMemDC;
    //响应系统扩展菜单命令
    procedure SysMenu(var msg : TWMmenuselect); message WM_SYSCOMMAND;
    function DealWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
    function WndProcScrollPaintMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
    procedure FreeDisplayScreen; 
  public
    //对应的socket
    ClientSocket : TSocket;
    //对应的主socket的单io数据指针
    MainClientSocketIP_IO : PPerHandleData;
    //屏传的单IO数据
    SubClientSocketIP_IO : PPerHandleData;
    RemoteCmpedFrameArray : array[0..1048576 - 1] of Char; //存放屏传压缩数据的内存池
    RemoteUnCmpedFrameArray : array[0..1048576 * 2 - 1] of Char; //存放屏传解压缩数据的内存池
    RemoteCmpedFrameData : Pointer;
    RemoteUnCmpedFrameData : Pointer;
    tmpDataBuffer : TtmpBuf;//粘包处理用
    //标题栏的数据
    CaptionStr : string; 
    //事件，用来等待数据处理完成的通知
    MsgDealDataOkNotifyEvent : THandle;
    //标志是否正在关闭
    IsClosing : Boolean; 
  end;
 

implementation 

{$R *.dfm}

//free掉资源和类
procedure TDisplayRemoteScreen.FreeDisplayScreen;
begin
  try
    DrawDibEnd(EntireDrawDibHandle);
    DrawDibEnd(PerBlockDrawDibHandle);
    //关闭dib
    DrawDibClose(EntireDrawDibHandle);
    DrawDibClose(PerBlockDrawDibHandle);
    //释放窗口dc
    if hWndDc <> 0 then
      ReleaseDC(self.Handle, hWndDc);
    if hBitmap <> 0 then
      DeleteObject(hBitmap);
    //释放内存dc
    if hMemDC <> 0 then
      DeleteDC(hMemDC);
    if hMemBitmap <> 0 then
      DeleteObject(hMemBitmap);
    //释放资源
    if ImageInforHeaderData <> nil then
      FreeMem(ImageInforHeaderData);
    if ImageInforPerBlockHeaderData <> nil then
      FreeMem(ImageInforPerBlockHeaderData); 
    //释放资源
    FreeMyMem(RemoteCmpedFrameData, RemoteCmpedFrameArray);
    FreeMyMem(RemoteUnCmpedFrameData, RemoteUnCmpedFrameArray);
  except

  end;
end;

//初始化变量
procedure TDisplayRemoteScreen.FormCreate(Sender: TObject);
var
  hMenu: LongWord; 
  dwStyle : DWORD; 
  Method: TMethod;
begin
  //修改此单字符串窗口组件性质
  dwStyle := GetWindowLong(Self.Handle, GWL_STYLE);
  SetWindowLong(Self.Handle, GWL_STYLE, dwStyle or WS_VSCROLL or WS_HSCROLL or CS_HREDRAW or CS_VREDRAW);
  //类内函数实例化
  Method.Code := @TDisplayRemoteScreen.DealWndProc;
  Method.Data := Self;
  FEnumProcInst := MakeProcInstance(Method);
  prevWndProc := GetWindowLong(Self.Handle, GWL_WNDPROC);
  SetWindowLong(Self.Handle, GWL_WNDPROC, integer(FEnumProcInst));
  //初始化变量
  Self.AutoScroll := True;
  Self.Caption := '远程屏幕监视窗口';
  Self.Position := poDefault;
  Self.Visible := True; 
  //其他参数
  ClientWidth := Self.Width;
  ClientHeight := Self.Height;
  wColorDepth := Use4BitColor;
  ShowImageStyle := IDM_Orignal;
  Bool_ShowCousor := True;
  Bool_AllowRemoteCtronl := False;
  //创建一个用于鼠标和键盘控制的结构体
  MakeOverlappedPlus(CtrlPerHandleData, IO_WRITE);
  //添加系统菜单
  hMenu := GetSystemMenu(Self.Handle, FALSE);
  AppendMenu(hMenu, MF_SEPARATOR, 0, nil);
  AppendMenu(hMenu, MF_STRING, IDM_Orignal, '显示原始大小的图像');
  CheckMenuItem(hMenu, IDM_Orignal, MF_CHECKED);
  AppendMenu(hMenu, MF_STRING, IDM_Stretch, '显示拉伸模式的图像');
  AppendMenu(hMenu, MF_SEPARATOR, 0, nil);
  AppendMenu(hMenu, MF_STRING, Use24BitColor, '24bits颜色图像');
  AppendMenu(hMenu, MF_STRING, Use16BitColor, '16bits颜色图像');
  AppendMenu(hMenu, MF_STRING, Use8BitColor, '8bits颜色图像');
  AppendMenu(hMenu, MF_STRING, Use4BitColor, '4bits颜色图像');
  CheckMenuItem(hMenu, Use4BitColor, MF_CHECKED);
  AppendMenu(hMenu, MF_STRING, Use1BitColor, '1bits颜色图像'); 
  AppendMenu(hMenu, MF_SEPARATOR, 0, nil);
  AppendMenu(hMenu, MF_STRING, IDM_ShowCousor, '显示远程鼠标');
  CheckMenuItem(hMenu, IDM_ShowCousor, MF_CHECKED);
  AppendMenu(hMenu, MF_STRING, IDM_AllowRemoteCtronl, '控制远程主机');
  AppendMenu(hMenu, MF_STRING, IDM_SendCtrlAltDel, '发CTRL+ALT+DEL组合键');
  AppendMenu(hMenu, MF_SEPARATOR, 0, nil);
  AppendMenu(hMenu, MF_STRING, IDM_SaveSiglePic, '保存当前图片');
  //初始化dib，并加载相关dll
  EntireDrawDibHandle := DrawDibOpen;
  PerBlockDrawDibHandle := DrawDibOpen;
  //创建一个事件
  MsgDealDataOkNotifyEvent := CreateEvent(nil, False, False, 'MsgDealDataOkNotifyEvent');
  IsClosing := False; 
end;

//释放资源
procedure TDisplayRemoteScreen.FormClose(Sender: TObject;
  var Action: TCloseAction);
var 
  CMDHeader : TInterChangeHeader; 
begin
  IsClosing := True;
  if MainClientSocketIP_IO <> nil then
    Caption := CaptionStr + '，等待窗体数据关闭，请稍等'; 
  try
    //恢复窗口处理程序
    SetWindowLong(Self.Handle, GWL_WNDPROC, integer(prevWndProc));
    if MainClientSocketIP_IO <> nil then
    begin
      //将主socket内的记录清零
      MainClientSocketIP_IO^.AllCtrlInstance.CapScreenInstance := 0;
      ZeroMemory(@CMDHeader, sizeof(CMDHeader));
      //关闭远类实例＝ 1
      CMDHeader.Order := 1;
      CMDHeader.OrderObject := CapScreen;
      SetCmdSignByte(MainClientSocketIP_IO^.Socket, CMDHeader, False);
      //等待数据处理线程退出
      Sleep(600); 
    end;
    FreeProcInstance(FEnumProcInst);
    //释放相关资源
    FreeDisplayScreen;
  except

  end;
  //释放事件
  CloseHandle(MsgDealDataOkNotifyEvent);
  Action := caFree;
end;

//响应菜单命令
procedure TDisplayRemoteScreen.SysMenu(var msg: TWMmenuselect);
var
  hMenu : DWORD;
  SinglePic : TBitmap;
  FileName : string;
  myInterChangeHeader : TInterChangeHeader;
begin
  hMenu := GetSystemMenu(Self.Handle, FALSE);
  case msg.IDItem of
    Use24BitColor,
    Use16BitColor,
    Use8BitColor,
    Use4BitColor,
    Use1BitColor:
    begin
      CheckMenuItem(hMenu, wColorDepth, MF_UNCHECKED);
      wColorDepth := msg.IDItem;
      CheckMenuItem(hMenu, wColorDepth, MF_CHECKED);
      if ClientSocket <> 0 then
      begin
        ZeroMemory(@myInterChangeHeader, sizeof(myInterChangeHeader));
        case msg.IDItem of
          Use24BitColor:
            myInterChangeHeader.Order := SetPixel24;
          Use16BitColor:
            myInterChangeHeader.Order := SetPixel16;
          Use8BitColor:
            myInterChangeHeader.Order := SetPixel8;
          Use4BitColor:
            myInterChangeHeader.Order := SetPixel4;
          Use1BitColor:
            myInterChangeHeader.Order := SetPixel1;
        end;
        SetCmdSignByte(ClientSocket, myInterChangeHeader);
      end;
    end;
    IDM_Orignal,
    IDM_Stretch:
    begin
      CheckMenuItem(hMenu, ShowImageStyle, MF_UNCHECKED);