serverFrm.pas
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:4k
源码类别:

Delphi/CppBuilder

开发平台:

Delphi

  1. unit serverFrm;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   ScktComp, ExtCtrls, StdCtrls, jpeg, registry, shellapi, Buttons;
  6. type
  7.   TfrmServer = class(TForm)
  8.     ServerSocket: TServerSocket;
  9.     Label1: TLabel;
  10.     procedure FormCreate(Sender: TObject);
  11.     procedure ServerSocketClientRead(Sender: TObject;
  12.       Socket: TCustomWinSocket);
  13.     procedure FormDestroy(Sender: TObject);
  14.     procedure ServerSocketClientDisconnect(Sender: TObject;
  15.       Socket: TCustomWinSocket);
  16.     procedure ServerSocketClientError(Sender: TObject;
  17.       Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  18.       var ErrorCode: Integer);
  19.   private
  20.     procedure sendscreen;
  21.     procedure snapscreen;
  22.   public
  23.     { Public declarations }
  24.   end;
  25. var
  26.   frmServer: TfrmServer;
  27. implementation
  28. const BufSize = 2048; //每次发送的最大数据量
  29. var
  30.   LeftSize: Longint; //发送jpeg文件流时,剩下的大小
  31.   jpegStream: TMemoryStream; //存储Jpeg文件的内存流
  32. {$R *.DFM}
  33. //当窗体创建时,创建存储屏幕图象的Jpeg文件的内存流
  34. procedure TfrmServer.FormCreate(Sender: TObject);
  35. begin
  36.   jpegStream := TmemoryStream.Create;
  37. end;
  38. //释放存储屏幕图象的Jpeg文件的内存流
  39. procedure TfrmServer.FormDestroy(Sender: TObject);
  40. begin
  41.   jpegstream.free;
  42. end;
  43. //发送抓取的屏幕图象(Jpeg格式)
  44. procedure TfrmServer.sendScreen;
  45. var
  46.   sendsize: longint;
  47.   Buf: array[0..BufSize - 1] of char;
  48. begin
  49.   if JpegStream.Size = 0 then
  50.     snapscreen;
  51.   if LeftSize > BufSize then
  52.     SendSize := BufSize
  53.   else
  54.     SendSize := LeftSize;
  55.   //将jpegStream内存流读取SendSize大小的数据到缓冲区
  56.   jpegStream.ReadBuffer(Buf, sendSize);
  57.   LeftSize := LeftSize - SendSize;
  58.   //向客户端发送
  59.   try
  60.     serversocket.Socket.Connections[0].SendBuf(buf, sendsize);
  61.     sleep(10);
  62.   except
  63.     jpegstream.Clear;
  64.   end;
  65.   if LeftSize = 0 then
  66.     jpegStream.Clear;
  67. end;
  68. //抓取本机屏幕,图象转换成Jpeg格式,并存到JpegStream内存流中。
  69. procedure TfrmServer.snapScreen;
  70. var
  71.   bmpscreen: Tbitmap;
  72.   jpegscreen: Tjpegimage;
  73.   FullscreenCanvas: TCanvas;
  74.   dc: HDC;
  75.   sourceRect, destRect: TRect;
  76. begin
  77.   //得到屏幕设备
  78.   dc := getdc(0);
  79.   //创建画布句柄
  80.   fullscreencanvas := Tcanvas.Create;
  81.   fullscreencanvas.Handle := dc;
  82.   //创建存储位图对象
  83.   bmpscreen := Tbitmap.create;
  84.   bmpscreen.Width := screen.Width;
  85.   bmpscreen.Height := screen.Height;
  86.   sourcerect := rect(0, 0, screen.Width, screen.Height);
  87.   destrect := rect(0, 0, screen.Width, screen.Height);
  88.   //将屏幕图象抓取到bmpScreen位图中
  89.   bmpscreen.Canvas.CopyRect(sourcerect, fullscreenCanvas, destrect);
  90.   //创建储存Jpeg格式的对象
  91.   jpegscreen := Tjpegimage.Create;
  92.   //将图象压缩成Jpeg格式,保存到JpegStream内存流中。
  93.   jpegscreen.Assign(bmpscreen);
  94.   jpegscreen.CompressionQuality := 40;
  95.   jpegscreen.SaveToStream(jpegStream);
  96.   jpegstream.Position := 0;
  97.   LeftSize := jpegStream.Size;
  98.   //释放创建的对象
  99.   FullscreenCanvas.Free;
  100.   bmpscreen.Free;
  101.   jpegscreen.Free;
  102.   ReleaseDC(0, DC);
  103. end;
  104. //接收客户端的发送的指令
  105. procedure TfrmServer.ServerSocketClientRead(Sender: TObject;
  106.   Socket: TCustomWinSocket);
  107. var
  108.   rstr: string;
  109. begin
  110.   rstr := socket.ReceiveText;
  111.   //如果收到的指令是'show',代表开始抓取,并回传客户端
  112.   if rstr = 'show' then
  113.     sendscreen();
  114. end;
  115. //当客户端断开连接时,清空jpegStream内存流
  116. procedure TfrmServer.ServerSocketClientDisconnect(Sender: TObject;
  117.   Socket: TCustomWinSocket);
  118. begin
  119.   jpegStream.Clear;
  120.   jpegStream.Position := 0;
  121. end;
  122. //当客户端Socket发生错误时,清空jpegStream内存流
  123. procedure TfrmServer.ServerSocketClientError(Sender: TObject;
  124.   Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  125.   var ErrorCode: Integer);
  126. begin
  127.   jpegStream.Clear;
  128.   jpegStream.Position := 0;
  129. end;
  130. end.