TNetImage類<？xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />
源代碼
// uNetImge .pas 屏幕圖像相關操作
{{
作者：蛐蛐
時間：2004.5.26
}
unit uNetImage;
interface
uses
Classes, Windows, Graphics, Forms, Jpeg, SysUtils,
IdTCPServer, IdTCPClient,uNetCommand;
type
TNetImage = class (TNetCommand)
public
Compress: Integer;
ImageStream: TMemoryStream;
ImageTime: string;
JpegImage: TJpegImage;
RemoteImageStream: TMemoryStream;
RemoteJpegImage: TJpegImage;
constructor Create;
destructor Destroy; override;
function ReadData(Client: TIdTCPClient): Boolean; override;
function ReadImage(Client: TIdTCPClient): Boolean;
// : 截取屏幕到Bitmap
{{
function SnapScreen.
BmpScreen 返回值.
Returns: 調用成功為true,否則為false.
}
function SnapScreen(var BmpScreen: TBitmap): Boolean; overload;
// : 截取屏幕到JPEG
{{
function SnapScreen.
JpegScreen 返回值 , JpegCompress 圖像壓縮比.
Returns: 調用成功為true,否則為false.
}
function SnapScreen(var JpegScreen: TJpegImage; JpegCompress: integer=100):
Boolean; overload;
// : 截取屏幕到Stream
{{
function SnapScreenToStream.
Stream 返回值, JpegCompress 圖像壓縮比.
Returns: 調用成功為true,否則為false.
}
function SnapScreenToStream(var Stream: TMemoryStream; JpegCompress:
integer=100): Boolean;
function WriteData(Server: TIdTCPServerConnection): Boolean; override;
function WriteImage(Server: TIdTCPServerConnection): Boolean;
end;
const
CM_GETSCREEN=101;
implementation
{
********************************** TNetImage ***********************************
}
constructor TNetImage.Create;
begin
inherited Create;
ImageStream:=TMemoryStream.Create;
JpegImage:=TJpegImage.Create;
RemoteJpegImage:=TJpegImage.Create;
RemoteImageStream:=TMemoryStream.Create;
end;
destructor TNetImage.Destroy;
begin
ImageStream.Free;
JpegImage.Free;
RemoteJpegImage.Free;
RemoteImageStream.Free;
inherited Destroy;
end;
function TNetImage.ReadData(Client: TIdTCPClient): Boolean;
begin
result:=true;
//
Client.WriteInteger(TCP_NETIMAGE); // Client: 1. 通知主人，是我來拜訪
RemoteCommandTime:=Client.ReadLn();
Client.WriteInteger(CommandType); // Client 2. 看看老兄的屏幕
case CommandType of //
// Client: 3. 收到了，把它裝到RemoteJpegImage
CM_GETSCREEN: Result:=ReadImage(Client);
{ 預留操作項
1: ;
2: ;
3: ;
}
end; // case
end;
function TNetImage.ReadImage(Client: TIdTCPClient): Boolean;
var
Size: Integer;
begin
result:=true;
try
with Client do
begin
WriteInteger(Compress); // 2 compress
Size:=ReadInteger(); // 3 StreamSize
ReadStream(RemoteImageStream,Size);
RemoteImageStream.Position:=0;
RemoteJpegImage.LoadFromStream(RemoteImageStream);
end;
except
result:=false;
end;
end;
function TNetImage.SnapScreen(var BmpScreen: TBitmap): Boolean;
var
FullScreenCanvas: TCanvas;
dc: HDC;
SourceRect, DestRect: TRect;
begin
result := true;
try
dc := GetDC(0);
FullScreencanvas := Tcanvas.Create;
FullScreencanvas.Handle := dc;
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.Canvas.CopyRect(SourceRect, FullScreenCanvas, DestRect);
except
result := false;
end;
end;
function TNetImage.SnapScreen(var JpegScreen: TJpegImage; JpegCompress:
integer=100): Boolean;
begin
{… }
end;
function TNetImage.SnapScreenToStream(var Stream: TMemoryStream; JpegCompress:
integer=100): Boolean;
begin
{… }
end;
function TNetImage.WriteData(Server: TIdTCPServerConnection): Boolean;
begin
result:=true;
Server.WriteLn(TimeToStr(GetTime)); // Send Time
case Server.ReadInteger of // Get Commandtype
// Server: 2. 小事一樁，把屏幕傳給你，准備接受
CM_GETSCREEN: Result:=WriteImage(Server) ;
1: ;
2: ;
3: ;
end; // case
end;
function TNetImage.WriteImage(Server: TIdTCPServerConnection): Boolean;
var
Stream: TMemoryStream;
begin
Stream:= TMemorySTream.Create;
Compress:=Server.ReadInteger(); // 1 compress
if SnapScreenToStream(Stream,Compress) then
begin
with Server do
begin
WriteInteger(Stream.Size);
WriteStream(Stream);
end;
result:=true;
end
else
result:= false;
Stream.Free;
end;
end.
Server端核心程序
procedure TFrmServer.cpsServerExecute(AThread: TIdPeerThread);
var
intCommand: Integer;
netCommand: TNetCommand;
begin
With AThread.Connection do
begin
intCommand:=ReadInteger(); // Server: 1. 究竟是誰來拜訪
case intCommand of
TCP_NETIMAGE: // 1.1原來是TNetImage，
netCommand:=TNetImage.Create; // “主隨客便”干脆換上TNetImage的行頭
TCP_NETSYSTEMINFO:
netCommand:=TNetSystemInfo.Create;
TCP_NETPROCESS:
netCommand:=TNetProcess.Create;
TCP_NETFILE:
netCommand:=TNetFile.Create;
{
//if you have new class ,you can do like this
TCP_NETEXITWINDOWS:
netCommand:=TNetExitWindows.Create;
TCP_NETMOUSE:
netCommand:=TNetMouse.Create;
}
TCP_QUIT:
Disconnect;
else
exit;
end;
end;
// Server : 1.2總要招待一下客人，問問需要些什麼
netCommand.WriteData(AThread.Connection);
end;
Client端請求得到對方屏幕
procedure TFrmClient.aNetImageGetScreenExecute(Sender: TObject);
var
netImage: TNetImage;
begin
netImage:=TNetImage.Create;
netImage.CommandType:=CM_GETSCREEN; // 事件 Client: 想看看老兄的屏幕
netImage.Compress:=netImageCompress;
if not netImage.ReadData(cpcClient) then
begin
ShowMessage('截取屏幕失敗!');
end
else begin
imgScreen.Picture.Assign(netImage.RemoteJpegImage);
sbInfo.Panels[0].Text:='截取屏幕成功';
end;
netImage.Free;
end;
TNetCommand世界中的禮儀
事件 Client: 想看看老兄的屏幕
netImage.CommandType:=CM_GETSCREEN; netImage.ReadData(cpcClient)
Client:
1. 通知主人，是我來拜訪Client.WriteInteger(TCP_NETIMAGE);
Server:
1. 究竟是誰來拜訪？ intCommand:=ReadInteger();
1.1原來是TNetImage，“主隨客便”干脆換上TNetImage的行頭
netCommand:=TNetImage.Create;
1.2總要招待一下客人，問問需要些什麼
netCommand.WriteData(AThread.Connection);
1.3噓寒問暖，一筆帶過吧
Server.WriteLn(TimeToStr(GetTime));…
Client:
2. 看看老兄的屏幕
Client.WriteInteger(CommandType); // CommandType:=CM_GETSCREEN
Server:
2. 小事一樁，把屏幕傳給你，准備接受
case Server.ReadInteger of
CM_GETSCREEN: Result:=WriteImage(Server) ;
end;
Client:
3. 收到了，把它裝到RemoteJpegImage
case CommandType of
CM_GETSCREEN: Result:=ReadImage(Client);
end;
得到屏幕圖像….
