serverFrm.pas
上传用户:psxgmh
上传日期:2013-04-08
资源大小:15112k
文件大小:4k
- unit serverFrm;
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- ScktComp, ExtCtrls, StdCtrls, jpeg, registry, shellapi, Buttons;
- type
- TfrmServer = class(TForm)
- ServerSocket: TServerSocket;
- Label1: TLabel;
- procedure FormCreate(Sender: TObject);
- procedure ServerSocketClientRead(Sender: TObject;
- Socket: TCustomWinSocket);
- procedure FormDestroy(Sender: TObject);
- procedure ServerSocketClientDisconnect(Sender: TObject;
- Socket: TCustomWinSocket);
- procedure ServerSocketClientError(Sender: TObject;
- Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
- var ErrorCode: Integer);
- private
- procedure sendscreen;
- procedure snapscreen;
- public
- { Public declarations }
- end;
- var
- frmServer: TfrmServer;
- implementation
- const BufSize = 2048; //每次发送的最大数据量
- var
- LeftSize: Longint; //发送jpeg文件流时,剩下的大小
- jpegStream: TMemoryStream; //存储Jpeg文件的内存流
- {$R *.DFM}
- //当窗体创建时,创建存储屏幕图象的Jpeg文件的内存流
- procedure TfrmServer.FormCreate(Sender: TObject);
- begin
- jpegStream := TmemoryStream.Create;
- end;
- //释放存储屏幕图象的Jpeg文件的内存流
- procedure TfrmServer.FormDestroy(Sender: TObject);
- begin
- jpegstream.free;
- end;
- //发送抓取的屏幕图象(Jpeg格式)
- procedure TfrmServer.sendScreen;
- var
- sendsize: longint;
- Buf: array[0..BufSize - 1] of char;
- begin
- if JpegStream.Size = 0 then
- snapscreen;
- if LeftSize > BufSize then
- SendSize := BufSize
- else
- SendSize := LeftSize;
- //将jpegStream内存流读取SendSize大小的数据到缓冲区
- jpegStream.ReadBuffer(Buf, sendSize);
- LeftSize := LeftSize - SendSize;
- //向客户端发送
- try
- serversocket.Socket.Connections[0].SendBuf(buf, sendsize);
- sleep(10);
- except
- jpegstream.Clear;
- end;
- if LeftSize = 0 then
- jpegStream.Clear;
- end;
- //抓取本机屏幕,图象转换成Jpeg格式,并存到JpegStream内存流中。
- procedure TfrmServer.snapScreen;
- var
- bmpscreen: Tbitmap;
- jpegscreen: Tjpegimage;
- FullscreenCanvas: TCanvas;
- dc: HDC;
- sourceRect, destRect: TRect;
- begin
- //得到屏幕设备
- dc := getdc(0);
- //创建画布句柄
- fullscreencanvas := Tcanvas.Create;
- fullscreencanvas.Handle := dc;
- //创建存储位图对象
- bmpscreen := Tbitmap.create;
- bmpscreen.Width := screen.Width;
- bmpscreen.Height := screen.Height;
- sourcerect := rect(0, 0, screen.Width, screen.Height);
- destrect := rect(0, 0, screen.Width, screen.Height);
- //将屏幕图象抓取到bmpScreen位图中
- bmpscreen.Canvas.CopyRect(sourcerect, fullscreenCanvas, destrect);
- //创建储存Jpeg格式的对象
- jpegscreen := Tjpegimage.Create;
- //将图象压缩成Jpeg格式,保存到JpegStream内存流中。
- jpegscreen.Assign(bmpscreen);
- jpegscreen.CompressionQuality := 40;
- jpegscreen.SaveToStream(jpegStream);
- jpegstream.Position := 0;
- LeftSize := jpegStream.Size;
- //释放创建的对象
- FullscreenCanvas.Free;
- bmpscreen.Free;
- jpegscreen.Free;
- ReleaseDC(0, DC);
- end;
- //接收客户端的发送的指令
- procedure TfrmServer.ServerSocketClientRead(Sender: TObject;
- Socket: TCustomWinSocket);
- var
- rstr: string;
- begin
- rstr := socket.ReceiveText;
- //如果收到的指令是'show',代表开始抓取,并回传客户端
- if rstr = 'show' then
- sendscreen();
- end;
- //当客户端断开连接时,清空jpegStream内存流
- procedure TfrmServer.ServerSocketClientDisconnect(Sender: TObject;
- Socket: TCustomWinSocket);
- begin
- jpegStream.Clear;
- jpegStream.Position := 0;
- end;
- //当客户端Socket发生错误时,清空jpegStream内存流
- procedure TfrmServer.ServerSocketClientError(Sender: TObject;
- Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
- var ErrorCode: Integer);
- begin
- jpegStream.Clear;
- jpegStream.Position := 0;
- end;
- end.