serverfrm.pas

《Delphi 7经典问题解析》源代码 第一到七章 基础篇源程序 应用篇源程序

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.