关于在局域网如何监视另一台计算机的屏幕。(200分)

请问各位大虾：在局域网中如何监视另一台计算机的屏幕，望各位不吝赐教。

计算机的屏幕信息好象保存在windows目录中的一个文件中
只要设法弄到这个，哈哈不就什么都解决了么！

1.获得计算机屏幕的DC
2.创建一个BITMAP
3.将图象画到BITMAP上
4.将图象传输到本地计算机上。

装上冰河。

pcanywhere

前面有帖子有原程序

請問在哪兒﹖我也想看。

copy 别人的文章
DELPHI：实现远程屏幕抓取
---- 在网络管理中，有时需要通过监视远程计算机屏幕来了解网上微机的使用情况。
虽然，市面上有很多软件可以实现该功能，有些甚至可以进行远程控制，但在使用上
缺乏灵活性，如无法指定远程计算机屏幕区域的大小和位置，进而无法在一屏上同时
监视多个屏幕。其实，可以用Delphi自行编制一个灵活的远程屏幕抓取工具，简述如下。

---- 一、软硬件要求。

---- Windows95/98对等网，用来监视的计算机（以下简称主控机）和被监视的计算机
（以下简称受控机）都必须装有TCP/IP 协议，并正确配置。如没有网络，也可以在一台计
算机上进行调试。

---- 二、实现方法。

---- 编制两个应用程序，一个为VClient.exe，装在受控机上，另一个为VServer.exe，
装在主控机上。VServer.exe指定要监视的受控机的IP地址和将要在受控机屏幕上抓取区
域的大小和位置，并发出屏幕抓取指令给VClient.exe，VClient.exe得到指令后，在受控
机屏幕上选取指定区域，生成数据流，将其发回主控机，并在主控机上显示出抓取区域
的BMP图象。由以上过程可以看出，该方法的关键有二：一是如何在受控机上进行屏幕抓
取，二是如何通过TCP/IP协议在两台计算机中传输数据。

---- UDP(User Datagram Protocol，意为用户报文协议)是Internet上广泛采用的通信
协议之一。与TCP协议不同，它是一种非连接的传输协议，没有确认机制，可靠性不如
TCP，但它的效率却比TCP高，用于远程屏幕监视还是比较适合的。同时，UDP控件不区
分服务器端和客户端，只区分发送端和接收端，编程上较为简单，故选用UDP协议，使
用Delphi 4.0提供的TNMUDP控件。

---- 三、创建演示程序。

---- 第一步，编制VClient.exe文件。新建Delphi工程，将默认窗体的Name属性设为
“Client”。加入TNMUDP控件，Name属性设为“CUDP”；LocalPort属性设为“1111”
，让控件CUDP监视受控机的1111端口，当有数据发送到该口时，触发控件CUDP的
OnDataReceived事件；RemotePort属性设为“2222”，当控件CUDP发送数据时，将数
据发到主控机的2222口。

---- 在implementation后面加入变量定义

const BufSize=2048;{ 发送每一笔数据的缓冲区大小 }
var
BmpStream:TMemoryStream;
LeftSize:Longint;{ 发送每一笔数据后剩余的字节数 }

为Client的OnCreate事件添加代码：
procedure TClient.FormCreate(Sender: TObject);
begin
BmpStream:=TMemoryStream.Create;
end;

为Client的OnDestroy事件添加代码：
procedure TClient.FormDestroy(Sender: TObject);
begin
BmpStream.Free;
end;

为控件CUDP的OnDataReceived事件添加代码：
procedure TClient.CUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var
CtrlCode:array［0..29］ of char;
Buf:array［0..BufSize-1］ of char;
TmpStr:string;
SendSize,LeftPos,TopPos,RightPos,BottomPos:integer;
begin
CUDP.ReadBuffer(CtrlCode,NumberBytes);{ 读取控制码 }
if CtrlCode［0］+CtrlCode［1］+CtrlCode［2］+CtrlCode［3］='show' then
begin { 控制码前4位为“show”表示主控机发出了抓屏指令 }
if BmpStream.Size=0 then { 没有数据可发，必须截屏生成数据 }
begin
TmpStr:=StrPas(CtrlCode);
TmpStr:=Copy(TmpStr,5,Length(TmpStr)-4);
LeftPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)
-Pos(':',TmpStr));
TopPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)-
Pos(':',TmpStr));
RightPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
BottomPos:=StrToInt(Copy(TmpStr,Pos(':',TmpStr
)+1,Length(TmpStr)-Pos(':',TmpStr)));
ScreenCap(LeftPos,TopPos,RightPos,BottomPos); {
截取屏幕 }
end;
if LeftSize>BufSize then SendSize:=BufSize
else SendSize:=LeftSize;
BmpStream.ReadBuffer(Buf,SendSize);
LeftSize:=LeftSize-SendSize;
if LeftSize=0 then BmpStream.Clear;{ 清空流 }
CUDP.RemoteHost:=FromIP; { FromIP为主控机IP地址 }
CUDP.SendBuffer(Buf,SendSize); { 将数据发到主控机的2222口 }
end;
end;

其中ScreenCap是自定义函数，截取屏幕指定区域，
代码如下：
procedure TClient.ScreenCap(LeftPos,TopPos,
RightPos,BottomPos:integer);
var
RectWidth,RectHeight:integer;
SourceDC,DestDC,Bhandle:integer;
Bitmap:TBitmap;
begin
RectWidth:=RightPos-LeftPos;
RectHeight:=BottomPos-TopPos;
SourceDC:=CreateDC('DISPLAY','','',nil);
DestDC:=CreateCompatibleDC(SourceDC);
Bhandle:=CreateCompatibleBitmap(SourceDC,
RectWidth,RectHeight);
SelectObject(DestDC,Bhandle);
BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,
LeftPos,TopPos,SRCCOPY);
Bitmap:=TBitmap.Create;
Bitmap.Handle:=BHandle;
BitMap.SaveToStream(BmpStream);
BmpStream.Position:=0;
LeftSize:=BmpStream.Size;
Bitmap.Free;
DeleteDC(DestDC);
ReleaseDC(Bhandle,SourceDC);
end;
存为“C:VClientClnUnit.pas”和“C:VClientVClient.dpr”，
并编译。

　

---- 第二步，编制VServer.exe文件。新建Delphi工程，将窗体的Name属性设为“Server”。加入TNMUDP控件，Name属性设为“SUDP”；LocalPort属性设为“2222”，让控件SUDP监视主控机的2222端口，当有数据发送到该口时，触发控件SUDP的OnDataReceived事件；RemotePort属性设为“1111”，当控件SUDP发送数据时，将数据发到受控机的1111口。加入控件Image1，Align属性设为“alClient”；加入控件Button1，Caption属性设为“截屏”；加入控件Label1，Caption属性设为“左：上：右：下”；加入控件Edit1，Text属性设为“0:0:100:100”；加入控件Label2，Caption属性设为“受控机IP地址”；加入控件Edit2，Text属性设为“127.0.0.1”；

在implementation后面加入变量定义
const BufSize=2048;
var
RsltStream,TmpStream:TMemoryStream;

为Server的OnCreate事件添加代码：
procedure TServer.FormCreate(Sender: TObject);
begin
RsltStream:=TMemoryStream.Create;
TmpStream:=TMemoryStream.Create;
end;

为Client的OnDestroy事件添加代码：
procedure TServer.FormDestroy(Sender: TObject);
begin
RsltStream.Free;
TmpStream.Free;
end;

为控件Button1的OnClick事件添加代码：
procedure TServer.Button1Click(Sender: TObject);
var ReqCode:array［0..29］ of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.Text;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;

为控件SUDP的OnDataReceived事件添加代码：
procedure TServer.SUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var ReqCode:array［0..29］ of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.text;
StrpCopy(ReqCode,ReqCodeStr);
SUDP.ReadStream(TmpStream);
RsltStream.CopyFrom(TmpStream,NumberBytes);
if NumberBytes< BufSize then { 数据已读完 }
begin
RsltStream.Position:=0;
Image1.Picture.Bitmap.LoadFromStream(RsltStream);
TmpStream.Clear;
RsltStream.Clear;
end
else
begin
TmpStream.Clear;
ReqCode:='show';
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;
end;

存为“C:VServerSvrUnit.pas”和
“C:VServerVServer.dpr”，并编译。
　

---- 四、测试。

---- 1、本地机测试：在本地机同时运行Vserver.exe和VClient.exe，利用程序的默
认设置，即可实现截屏。查看“控制面板”-“网络”-“TCP/IP”-“IP地址”，将
程序的“客户IP地址”设为该地址 ，同样正常运行。

---- 2、远程测试：选一台受控机，运行VClient.exe；另选一台主控机，运行
VServer.exe，将“受控机IP地址”即Edit2的内容设为受控机的IP地址，“截屏”
即可。以上简要介绍了远程屏幕抓取的实现方法，至于在主控机上一屏同时监视多
个受控机，读者可自行完善。以上程序，在Windows98对等网、Delphi 4.0下调试通过。

上文知识简单的截屏，监视关键是要当屏幕发生变化是程序能知道
并截屏发送

　 分为服务端和客户端两个部分，虽然不是一个完整的delphi工程，但是我们关心的其中有用的代码，对吧？
下面是服务端
unit serverdlg;

interface

uses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
extctrls, stdctrls, winsock, scktcomp, menus, trayicon, formsettings,
remconmessages, zlib, msgsimulator, comctrls, shellapi;

type
tserverform = class(tform)
pagecontrol1: tpagecontrol;
tabsheet1: ttabsheet;
tabsheet2: ttabsheet;
loglist: tlistbox;
serverpanel: tpanel;
label5: tlabel;
startlab: tlabel;
label9: tlabel;
conlab: tlabel;
label11: tlabel;
numreclab: tlabel;
label13: tlabel;
numsendlab: tlabel;
label3: tlabel;
lastreclab: tlabel;
label4: tlabel;
numerrlab: tlabel;
panel1: tpanel;
label1: tlabel;
namelabel: tlabel;
label2: tlabel;
portedit: tedit;
panel2: tpanel;
startbut: tbutton;
disconbut: tbutton;
minimizebut: tbutton;
clientbut: tbutton;
serversocket1: tserversocket;
trayicon1: ttrayicon;
traymenu: tpopupmenu;
remotecontrol1: tmenuitem;
n1: tmenuitem;
client1: tmenuitem;
n2: tmenuitem;
shutdown1: tmenuitem;
formsettings1: tformsettings;
msgsimulator1: tmsgsimulator;
label6: tlabel;
passedit: tedit;
procedure startbutclick(sender: tobject);
procedure disconbutclick(sender: tobject);
procedure formshow(sender: tobject);
procedure minimizebutclick(sender: tobject);
procedure remotecontrol1click(sender: tobject);
procedure shutdown1click(sender: tobject);
procedure formclose(sender: tobject; var action: tcloseaction);
procedure serversocket1listen(sender: tobject;
socket: tcustomwinsocket);
procedure serversocket1clientread(sender: tobject;
socket: tcustomwinsocket);
procedure serversocket1clientconnect(sender: tobject;
socket: tcustomwinsocket);
procedure serversocket1clientdisconnect(sender: tobject;
socket: tcustomwinsocket);
procedure serversocket1clienterror(sender: tobject;
socket: tcustomwinsocket; errorevent: terrorevent;
var errorcode: integer);
procedure formcreate(sender: tobject);
procedure formdestroy(sender: tobject);
procedure client1click(sender: tobject);
procedure formclosequery(sender: tobject; var canclose: boolean);
procedure clientbutclick(sender: tobject);
protected
numrec : double;
numsend : double;
numerror : integer;
curmsg : string;
loggedon : boolean;
curbmp : tbitmap;
cursocket : tcustomwinsocket;
curhandle : thandle;
sleeptime : integer;
viewmode : tviewmode;
compmode : tcompressionlevel;
procedure updatestats;
procedure log(const s: string);
procedure processclick(const data: string);
procedure processdrag(const data: string);
procedure send_screen_update(socket: tcustomwinsocket);
procedure sleepdone(sender: tobject);
procedure processkeys(const data: string);
procedure createsleepthread;
procedure gethostnameaddr;
procedure parsecomline;
function get_process_list: string;
procedure closewindow(const data: string);
procedure killwindow(const data: string);
function get_drive_list: string;
function getdirectory(const pathname: string): string;
function getfile(const pathname: string): string;
public
procedure enablebuts;
procedure processmessage(const msg: string; socket: tcustomwinsocket);
procedure sendmsg(msgnum: integer; const msgdata: string; socket: tcustomwinsocket);
end;

var
serverform: tserverform;

implementation

uses clientfrm;

{$r *.dfm}

procedure tserverform.startbutclick(sender: tobject);
begin
with serversocket1 do begin
port := strtoint(portedit.text);
active := true;
end;
enablebuts;
end;

procedure tserverform.disconbutclick(sender: tobject);
begin
serversocket1.active := false;
enablebuts;
end;

procedure tserverform.enablebuts;
var
b : boolean;
begin
b := serversocket1.active;

startbut.enabled := not b;
portedit.enabled := not b;
disconbut.enabled := b;
// minimizebut.enabled := b;
end;

procedure tserverform.gethostnameaddr;
var
buf : array[0..max_path] of char;
he : phostent;
buf2 : pchar;
rc : integer;
begin
rc := gethostname(buf, sizeof(buf));

if rc<>socket_error then begin
he := gethostbyname(buf);
if he = nil then begin
rc := wsagetlasterror;
namelabel.caption := format('socket error %d = %s', [rc, syserrormessage(rc)]);
end else begin
buf2 := inet_ntoa(pinaddr(he.h_addr^)^);
namelabel.caption := format('%s (%s)', [buf, buf2]);
end;
end else begin
namelabel.caption := 'unknown host';
end;
end;

procedure tserverform.formshow(sender: tobject);
begin
enablebuts;
gethostnameaddr;
end;

procedure tserverform.minimizebutclick(sender: tobject);
begin
if serversocket1.active then begin
trayicon1.tooltip := application.title + ' - port: ' + portedit.text;
end else begin
trayicon1.tooltip := application.title + ' - inactive';
end;

trayicon1.active := true;
showwindow(application.handle, sw_hide);
hide;
end;

procedure tserverform.remotecontrol1click(sender: tobject);
begin
trayicon1.active := false;
showwindow(application.handle, sw_show);
application.restore;
show;
setforegroundwindow(handle);
end;

procedure tserverform.shutdown1click(sender: tobject);
begin
remotecontrol1click(nil);
close;
end;

procedure tserverform.formclose(sender: tobject; var action: tcloseaction);
begin
formsettings1.savesettings;
end;

procedure tserverform.serversocket1listen(sender: tobject;
socket: tcustomwinsocket);
begin
startlab.caption := curtime;
numrec := 0;
numsend := 0;
curmsg := '';
loggedon := false;
updatestats;
log('startup at ' + curtime);
end;

procedure tserverform.updatestats;
begin
conlab.caption := inttostr(serversocket1.socket.activeconnections);
numreclab.caption := format('%1.0n', [numrec]);
numsendlab.caption := format('%1.0n', [numsend]);
numerrlab.caption := inttostr(numerror);
end;

procedure tserverform.serversocket1clientread(sender: tobject;
socket: tcustomwinsocket);
var
s : string;
begin
log(format('%-20s %s', ['recv data', socket.remoteaddress]));

lastreclab.caption := curtime;
s := socket.receivetext;
numrec := numrec + length(s);
updatestats;

curmsg := curmsg + s;

while isvalidmessage(curmsg) do begin
s := trimfirstmsg(curmsg);
processmessage(s, socket);
end;
end;

procedure tserverform.serversocket1clientconnect(sender: tobject;
socket: tcustomwinsocket);
begin
log(format('%-20s %s', ['connect', socket.remoteaddress]));

viewmode := vmcolor4;
compmode := cldefault;
setthreadpriority(getcurrentthread, thread_priority_normal);
updatestats;
end;

procedure tserverform.serversocket1clientdisconnect(sender: tobject;
socket: tcustomwinsocket);
begin
log(format('%-20s %s', ['disconnect', socket.remoteaddress]));

updatestats;
end;

procedure tserverform.serversocket1clienterror(sender: tobject;
socket: tcustomwinsocket; errorevent: terrorevent;
var errorcode: integer);
begin
log(format('%-20s %d', ['error', errorcode]));

errorcode := 0;
inc(numerror);
updatestats;
end;

procedure tserverform.log(const s: string);
begin
loglist.itemindex := loglist.items.add(s);
end;

procedure tserverform.processmessage(const msg: string; socket: tcustomwinsocket);
var
msgnum, x: integer;
rc : integer;
data : string;
bmp : tbitmap;
tmp : string;
begin
cursocket := socket;
move(msg[1], msgnum, sizeof(integer));
data := copy(msg, 9, length(msg));

log(format('%-20s %d', ['message', msgnum]));

if msgnum = msg_logon then begin
loggedon := (ansicomparetext(data, passedit.text) = 0);
if loggedon then begin
sendmsg(msg_logon, '1', socket)
end else begin
sendmsg(msg_logon, '0', socket);
end;
exit;
end;

if not loggedon then begin
log('denied access!');
sendmsg(msg_stat_msg, 'invalid password', socket);
socket.close;
exit;
end;

if msgnum = msg_refresh then begin
log('screen capture');
sendmsg(msg_stat_msg, 'screen capture', socket);
getscreen(bmp, viewmode);
log('compressing bitmap');
sendmsg(msg_stat_msg, 'screen compression', socket);
compressbitmap(bmp, tmp);
savestring(tmp, 'temp1.txt');
sendmsg(msg_refresh, tmp, socket);
curbmp.assign(bmp);
bmp.free;
end;

if msgnum = msg_screen_update then begin
send_screen_update(socket);
end;

if msgnum = msg_click then begin
sendmsg(msg_stat_msg, 'simulating input', socket);
processclick(data);
// sleepdone will be called when it is finished
end;

if msgnum = msg_drag then begin
sendmsg(msg_stat_msg, 'simulating input', socket);
processdrag(data);
// sleepdone will be called when it is finished
end;

if msgnum = msg_keys then begin
sendmsg(msg_stat_msg, 'simulating input', socket);
processkeys(data);
// sleepdone will be called when it is finished
end;

if msgnum = msg_sever_delay then begin
move(data[1], sleeptime, sizeof(integer));
sendmsg(msg_sever_delay, '', socket);
end;

if msgnum = msg_view_mode then begin
move(data[1], x, sizeof(integer));
viewmode := tviewmode(x);
sendmsg(msg_view_mode, '', socket);
end;

if msgnum = msg_focus_server then begin
if trayicon1.active then remotecontrol1click(nil);
setfocus;
createsleepthread;
// sleepdone will be called when it is finished
end;

if msgnum = msg_comp_mode then begin
move(data[1], x, sizeof(integer));
compmode := tcompressionlevel(x);
sendmsg(msg_comp_mode, '', socket);
end;

if msgnum = msg_priority_mode then begin
move(data[1], x, sizeof(integer));
setthreadpriority(getcurrentthread, x);
sendmsg(msg_priority_mode, '', socket);
end;

if msgnum = msg_process_list then begin
sendmsg(msg_process_list, get_process_list, socket);
end;

if msgnum = msg_close_win then begin
closewindow(data);
end;

if msgnum = msg_kill_win then begin
killwindow(data);
end;

if msgnum = msg_drive_list then begin
sendmsg(msg_drive_list, get_drive_list, socket);
end;

if msgnum = msg_directory then begin
sendmsg(msg_directory, getdirectory(data), socket);
end;

if msgnum = msg_file then begin
sendmsg(msg_file, getfile(data), socket);
end;

if msgnum = msg_remote_launch then begin
sendmsg(msg_stat_msg, 'launching file: ' + data, socket);
rc := shellexecute(handle, 'open', pchar(data), nil, nil, sw_shownormal);
if rc <= 32 then begin
data := format('shellexecute error #%d launching %s', [rc, data]);
sendmsg(msg_remote_launch, data, socket);
end else begin
sendmsg(msg_remote_launch, data, socket);
end;
end;
end;

function enumwinproc(hw: thandle; lp: lparam): boolean; stdcall;
var
sl : tstringlist;
buf : array[0..max_path] of char;
s, iv : string;
begin
sl := tstringlist(lp);
getwindowtext(hw, buf, sizeof(buf));
if buf<>'' then begin
if iswindowvisible(hw) then iv := '' else iv := '(invisible)';
s := format('%8.8x - %-32s %s', [hw, buf, iv]);
sl.addobject(s, tobject(hw));
end;
result := true;
end;

function tserverform.get_process_list: string;
var
sl : tstringlist;
begin
sl := tstringlist.create;
enumwindows(@enumwinproc, integer(sl));
result := sl.text;
sl.free;
end;

function tserverform.get_drive_list: string;
var
drivebits : integer;
i : integer;
begin
result := '';
drivebits := getlogicaldrives;
for i := 0 to 25 do begin
if (drivebits and (1 shl i)) <> 0 then
result := result + chr(ord('a') + i) + ':/' + #13#10;
end;
end;

function tserverform.getdirectory(const pathname: string): string;
var
dirlist : tstringlist;
commalist : tstringlist;
sr : tsearchrec;
s : string;
dt : tdatetime;
begin
dirlist := tstringlist.create;
commalist := tstringlist.create;

if findfirst(pathname, faanyfile, sr) = 0 then repeat
commalist.clear;
s := sr.name;
if (s = '.') or (s = '..') then continue;

if (sr.attr and fadirectory) <> 0 then s := s + '/';
commalist.add(s);
s := format('%1.0n', [sr.size+0.0]);
commalist.add(s);
dt := filedatetodatetime(sr.time);
s := formatdatetime('yyyy-mm-dd hh:nn ampm', dt);
commalist.add(s);

dirlist.add(commalist.commatext);
until findnext(sr) <> 0;
findclose(sr);

result := dirlist.text;

commalist.free;
dirlist.free;
end;

function tserverform.getfile(const pathname: string): string;
var
fs : tfilestream;
begin
fs := tfilestream.create(pathname, fmopenread or fmsharedenywrite);
setlength(result, fs.size);
fs.read(result[1], fs.size);
fs.free;
end;

procedure tserverform.closewindow(const data: string);
var
sl : tstringlist;
i : integer;
hw : thandle;
begin
sl := tstringlist.create;
enumwindows(@enumwinproc, integer(sl));
i := sl.indexof(data);
if i<>-1 then begin
hw := thandle(sl.objects);

sendmessage(hw, wm_close, 0, 0);

sleep(sleeptime);
sendmsg(msg_process_list, get_process_list, cursocket);
end;
sl.free;
end;

procedure tserverform.killwindow(const data: string);
var
sl : tstringlist;
i : integer;
hw : thandle;
procid : integer;
hproc : thandle;
begin
sl := tstringlist.create;
enumwindows(@enumwinproc, integer(sl));
i := sl.indexof(data);
if i<>-1 then begin
hw := thandle(sl.objects);

getwindowthreadprocessid(hw, @procid);
hproc := openprocess(process_all_access, false, procid);
terminateprocess(hproc, dword(-1));
closehandle(hproc);

sleep(sleeptime);
sendmsg(msg_process_list, get_process_list, cursocket);
end;
sl.free;
end;

procedure tserverform.sleepdone(sender: tobject);
begin
send_screen_update(cursocket);
end;

procedure tserverform.send_screen_update(socket: tcustomwinsocket);
var
bmp, dif : tbitmap;
r : trect;
tmp : string;
begin
log('screen capture');
sendmsg(msg_stat_msg, 'screen capture', socket);
getscreen(bmp, viewmode);
log('creating diff image');
dif := tbitmap.create;
dif.assign(bmp);
r := rect(0, 0, dif.width, dif.height);
sendmsg(msg_stat_msg, 'screen difference', socket);
dif.canvas.copymode := cmsrcinvert;
dif.canvas.copyrect(r, curbmp.canvas, r);

log('compressing bitmap');
sendmsg(msg_stat_msg, 'screen compression', socket);
compressbitmap(dif, tmp);

sendmsg(msg_screen_update, tmp, socket);
curbmp.assign(bmp);

dif.free;
bmp.free;
end;

function getmb(but: integer): tmousebutton;
begin
case but of
1 : result := mbleft;
2 : result := mbright;
else result := mbleft;
end;
end;

procedure tserverform.processclick(const data: string);
var
x, y, i : integer;
num, but : integer;
p : tpoint;
begin
move(data[1], x, sizeof(integer));
move(data[1+4], y, sizeof(integer));
move(data[1+8], num, sizeof(integer));
move(data[1+12], but, sizeof(integer));

// find the window handle
p := point(x, y);
curhandle := windowfrompoint(p);
assert(curhandle<>0);

setcursorpos(x, y);

// create the messages to send in the hook procedure
with msgsimulator1 do begin
messages.clear;
for i := 1 to num do
add_clickex(0, getmb(but), [], x, y, 1);
play;
end;

createsleepthread;
end;

procedure tserverform.processdrag(const data: string);
var
x, y : integer;
time : integer;
num, but : integer;
p : tpoint;
startpt : tpoint;
stoppt : tpoint;
begin
move(data[1], but, sizeof(integer));
move(data[1+4], num, sizeof(integer));
assert(num > 2);

// create the messages to send in the hook procedure
// mouse down
move(data[(1-1)*12 + 9], x, sizeof(integer));
move(data[(1-1)*12 + 13], y, sizeof(integer));
move(data[(1-1)*12 + 17], time, sizeof(integer));
setcursorpos(x, y);
// find the window handle
p := point(x, y);
curhandle := windowfrompoint(p);
assert(curhandle<>0);

with msgsimulator1 do begin
messages.clear;

startpt.x := x;
startpt.y := y;
windows.screentoclient(curhandle, startpt);

move(data[(num-1)*12 + 9], x, sizeof(integer));
move(data[(num-1)*12 + 13], y, sizeof(integer));
stoppt.x := x;
stoppt.y := y;
windows.screentoclient(curhandle, stoppt);

add_window_drag(curhandle, startpt.x, startpt.y, stoppt.x, stoppt.y);

play;
end;

createsleepthread;
end;

procedure tserverform.processkeys(const data: string);
begin
with msgsimulator1 do begin
messages.clear;
add_ascii_keys(data);
play;
end;

createsleepthread;
end;

procedure tserverform.sendmsg(msgnum: integer; const msgdata: string; socket: tcustomwinsocket);
var
s : string;
begin
s := inttobytestr(msgnum) + inttobytestr(length(msgdata)) + msgdata;

log(format('%-20s %-4d %1.0n', ['send', msgnum, length(s)+0.0]));

socket.sendtext(s);
numsend := numsend + length(s);
updatestats;
end;


procedure tserverform.formcreate(sender: tobject);
begin
curbmp := tbitmap.create;
sleeptime := 50;
parsecomline;
end;

procedure tserverform.formdestroy(sender: tobject);
begin
curbmp.free;
end;


type
tsleepthread = class(tthread)
public
sleeptime : integer;
procedure execute; override;
end;

procedure tsleepthread.execute;
begin
sleep(sleeptime);
end;

procedure tserverform.createsleepthread;
var
st : tsleepthread;
begin
st := tsleepthread.create(true);
st.sleeptime := sleeptime;
st.onterminate := sleepdone;
st.resume;
end;

procedure tserverform.client1click(sender: tobject);
begin
clientform.show;
end;

procedure tserverform.formclosequery(sender: tobject;
var canclose: boolean);
var
rc : integer;
begin
if serversocket1.socket.activeconnections > 0 then begin
rc := messagedlg('clients are still connected, do you want to close?',
mtwarning, mbyesnocancel, 0);
canclose := (rc = mryes);
end;
end;

procedure tserverform.parsecomline;
var
i : integer;
s : string;
autostart : boolean;
begin
autostart := false;

for i := 1 to paramcount do begin
s := uppercase(paramstr(i));

if copy(s, 1, 6) = '/port:' then begin
portedit.text := copy(s, 7, length(s));
autostart := true;
startbutclick(nil);
minimizebutclick(nil);
end;

if s = '/client' then begin
minimizebutclick(nil);
autostart := true;
end;
end;

if not autostart then
visible := true;
end;


procedure tserverform.clientbutclick(sender: tobject);
begin
clientform.show;
end;

end.
下面是客户端
unit clientfrm;

interface

uses
windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
scktcomp, extctrls, comctrls, formsettings, menus, stdctrls, buttons,
remconmessages, zlib;

const
default_server_delay = 500;
default_view_mode = vmcolor4;
default_comp_mode = cldefault;
default_svr_priority = thread_priority_highest;

type
tmoveobj = class
x, y : integer;
time : integer;
end;

tclientform = class(tform)
statpanel: tpanel;
statusbar1: tstatusbar;
scrollbox1: tscrollbox;
image1: timage;
clientsocket1: tclientsocket;
timer1: ttimer;
mainmenu1: tmainmenu;
file1: tmenuitem;
connect1: tmenuitem;
n1: tmenuitem;
exit1: tmenuitem;
disconnect1: tmenuitem;
view1: tmenuitem;
refreshcomplete1: tmenuitem;
updatechanges1: tmenuitem;
responsetimer: ttimer;
clicktimer: ttimer;
options1: tmenuitem;
serverpause1: tmenuitem;
n005sec1: tmenuitem;
n010sec1: tmenuitem;
n050sec1: tmenuitem;
n100sec1: tmenuitem;
n200sec1: tmenuitem;
n500sec1: tmenuitem;
loglist: tlistbox;
splitter1: tsplitter;
n2: tmenuitem;
log1: tmenuitem;
commstat1: tmenuitem;
n3: tmenuitem;
shutdown1: tmenuitem;
special1: tmenuitem;
focusserverwindow1: tmenuitem;
bitmapformat1: tmenuitem;
color4: tmenuitem;
gray4: tmenuitem;
gray8: tmenuitem;
color24: tmenuitem;
default1: tmenuitem;
waitimage: timage;
compressionlevel1: tmenuitem;
highslow1: tmenuitem;
medium1: tmenuitem;
lowfast1: tmenuitem;
serverpriority1: tmenuitem;
critical1: tmenuitem;
highest1: tmenuitem;
abovenormal1: tmenuitem;
normal1: tmenuitem;
belownormal1: tmenuitem;
lowest1: tmenuitem;
idle1: tmenuitem;
n4: tmenuitem;
scaleimage1: tmenuitem;
processlist1: tmenuitem;
n5: tmenuitem;
filelist1: tmenuitem;
panel1: tpanel;
sendcrbut: tspeedbutton;
sendbut: tspeedbutton;
sendpanel: tpanel;
sendedit: tedit;
help1: tmenuitem;
about1: tmenuitem;
statbarmenu: tmenuitem;
fullscreen1: tmenuitem;
procedure formshow(sender: tobject);
procedure timer1timer(sender: tobject);
procedure formclose(sender: tobject; var action: tcloseaction);
procedure clientsocket1lookup(sender: tobject;
socket: tcustomwinsocket);
procedure clientsocket1connecting(sender: tobject;
socket: tcustomwinsocket);
procedure clientsocket1connect(sender: tobject;
socket: tcustomwinsocket);
procedure clientsocket1error(sender: tobject; socket: tcustomwinsocket;
errorevent: terrorevent; var errorcode: integer);
procedure exit1click(sender: tobject);
procedure connect1click(sender: tobject);
procedure clientsocket1read(sender: tobject; socket: tcustomwinsocket);
procedure clientsocket1disconnect(sender: tobject;
socket: tcustomwinsocket);
procedure disconnect1click(sender: tobject);
procedure refreshcomplete1click(sender: tobject);
procedure updatechanges1click(sender: tobject);
procedure image1mousemove(sender: tobject; shift: tshiftstate; x,
y: integer);
procedure responsetimertimer(sender: tobject);
procedure image1mousedown(sender: tobject; button: tmousebutton;
shift: tshiftstate; x, y: integer);
procedure image1click(sender: tobject);
procedure image1mouseup(sender: tobject; button: tmousebutton;
shift: tshiftstate; x, y: integer);
procedure image1dblclick(sender: tobject);
procedure clicktimertimer(sender: tobject);
procedure pausechange(sender: tobject);
procedure sendbutclick(sender: tobject);
procedure sendcrbutclick(sender: tobject);
procedure log1click(sender: tobject);
procedure commstat1click(sender: tobject);
procedure formcreate(sender: tobject);
procedure shutdown1click(sender: tobject);
procedure formdestroy(sender: tobject);
procedure focusserverwindow1click(sender: tobject);
procedure colorclick(sender: tobject);
procedure compclick(sender: tobject);
procedure priorityclick(sender: tobject);
procedure scaleimage1click(sender: tobject);
procedure processlist1click(sender: tobject);
procedure filelist1click(sender: tobject);
procedure sendpanelresize(sender: tobject);
procedure about1click(sender: tobject);
procedure statbarmenuclick(sender: tobject);
procedure fullscreen1click(sender: tobject);
procedure formkeydown(sender: tobject; var key: word;
shift: tshiftstate);
protected
numrec : double;
numsend : double;
curmsg : string;
needreply : integer;
lastx : integer;
lasty : integer;
t1 : dword;
but : integer;
numclick : integer;
movelist : tlist;
anim : integer;
lastrec : dword;
serverdelay: integer;
viewmode : tviewmode;
compmode : tcompressionlevel;
svrpriority: integer;
procform : tform;
fileform : tform;
lastcps : string;
beforefull : trect;
procedure setstat(i: integer; s: string);
procedure updatestats;
procedure sendtext(const text: string);
procedure log(const s: string);
procedure enablebuts;
procedure clearmovelist;
procedure addmove(x, y: integer);
procedure parsecomline;
procedure stopanim;
procedure startanim;
procedure enableinput;
procedure wmsyscommand(var message: twmsyscommand); message wm_syscommand;
function cansendmenumsg: boolean;
procedure send_current_settings;
procedure scalexy(var x, y: integer);
procedure updatelogvis;
public
procedure sendmsg(msgnum: integer; const msgdata: string; socket: tcustomwinsocket);
procedure processmessage(const msg: string; socket: tcustomwinsocket);
property stat[i: integer]: string write setstat;
end;

var
clientform: tclientform;

implementation

uses connectdlg, proclistdlg, filesdlg, about, fstopdlg;

{$r *.dfm}

procedure tclientform.formshow(sender: tobject);
begin
updatelogvis;
if not clientsocket1.active then
timer1.enabled := true;
end;

function isdotaddress(const s: string): boolean;
var
i : integer;
begin
result := true;
for i := 1 to length(s) do
if not (s in ['0'..'9', '.']) then result := false;
end;

procedure tclientform.timer1timer(sender: tobject);
var
f : tform;
begin
timer1.enabled := false;

f := self;
with clientconnectform do begin
left := (f.left + f.width div 2) - width div 2;
top := (f.top + f.height div 2) - height div 2;

if showmodal = mrok then with clientsocket1 do begin
if isdotaddress(servercombo.text) then begin
host := '';
address := servercombo.text;
end else begin
address := '';
host := servercombo.text;
end;
port := strtoint(portedit.text);

startanim;
active := true;
end;
end;
end;

procedure tclientform.formclose(sender: tobject; var action: tcloseaction);
begin
if borderstyle<>bsnone then formsettings1.savesettings;
disconnect1click(nil);
end;

procedure tclientform.clientsocket1lookup(sender: tobject;
socket: tcustomwinsocket);
begin
stat[0] := ('looking up: ' + clientsocket1.host);
end;

procedure tclientform.setstat(i: integer; s: string);
begin
fstopform.statlabel.caption := s;
statusbar1.panels.text := s;
update;
end;

procedure tclientform.clientsocket1connecting(sender: tobject;
socket: tcustomwinsocket);
begin
stat[0] := ('connecting: ' + clientsocket1.host);
end;

procedure tclientform.clientsocket1connect(sender: tobject;
socket: tcustomwinsocket);
begin
log(format('%-7s %s', ['logon', datetimetostr(now)]));

enablebuts;
stat[0] := ('connected: ' + socket.remotehost);
caption := 'remote control client - ' + socket.remotehost;

numsend := 0;
numrec := 0;
needreply := 0;
stopanim;
enableinput;

sendmsg(msg_logon, clientconnectform.passedit.text, clientsocket1.socket);
send_current_settings;
end;

procedure tclientform.clientsocket1error(sender: tobject;
socket: tcustomwinsocket; errorevent: terrorevent;
var errorcode: integer);
begin
stat[0] := ('error: ' + inttostr(errorcode));
errorcode := 0;

if not socket.connected then stopanim;
end;

procedure tclientform.exit1click(sender: tobject);
begin
close;
end;

procedure tclientform.connect1click(sender: tobject);
begin
image1.picture.bitmap := nil;
timer1timer(nil);
end;

procedure tclientform.sendmsg(msgnum: integer; const msgdata: string; socket: tcustomwinsocket);
var
s : string;
begin
log(format('%-7s #%2.2d', ['send', msgnum]));

stat[0] := format('sending message (len = %1.0n)', [length(msgdata)+0.0]);

s := inttobytestr(msgnum) + inttobytestr(length(msgdata)) + msgdata;
socket.sendtext(s);
numsend := numsend + length(s);
updatestats;

inc(needreply);
startanim;
end;

procedure tclientform.updatestats;
begin
// stat[0] := format('sent: %1.0n', [numsend]);
// stat[1] := format('recv: %1.0n', [numrec]);
end;


procedure tclientform.clientsocket1read(sender: tobject;
socket: tcustomwinsocket);
var
s : string;
msg : integer;
len : integer;
perstr : string;
tdif : double;
cps : string;
begin
// waitimage.hint := 'data last received:' + #13#10 + curtime;
s := socket.receivetext;
numrec := numrec + length(s);
updatestats;

if curmsg = '' then lastrec := gettickcount;
curmsg := curmsg + s;

if length(curmsg) >= 8 then begin
move(curmsg[1], msg, sizeof(integer));
move(curmsg[5], len, sizeof(integer));
perstr := format('(%1.0n%%)', [length(curmsg) / (len + 8.0) * 100.0]);
tdif := (gettickcount - lastrec) / 1000.0;
if tdif > 0.5 then cps := format('%1.0n cps', [length(curmsg) / tdif])
else cps := '';
stat[0] := format('received: %1.0n of %1.0n %s %s',
[length(curmsg) + 0.0, len + 8.0, perstr, cps]);
lastcps := cps;
end else begin
if length(s) > 0 then
stat[0] := 'received: ' + inttostr(length(curmsg));
end;

while isvalidmessage(curmsg) do begin
s := trimfirstmsg(curmsg);
processmessage(s, socket);
end;
end;

procedure tclientform.processmessage(const msg: string; socket: tcustomwinsocket);
var
msgnum : integer;
data : string;
bmp : tbitmap;
r : trect;
begin
move(msg[1], msgnum, sizeof(integer));
if msgnum <> msg_stat_msg then
log(format('%-7s #%0.2d %6.0n bytes %s', ['recv', msgnum, length(msg)+0.0, lastcps]));

data := copy(msg, 9, length(msg));

if msgnum = msg_stat_msg then begin
stat[0] := data;
exit;
end;

dec(needreply);
if needreply = 0 then begin
stopanim;
end;

if msgnum = msg_logon then begin
if data <> '0' then begin
stat[0] := 'log on successful';
if clientconnectform.startscreenbox.checked then
sendmsg(msg_refresh, '', clientsocket1.socket);
end else begin
stat[0] := 'invalid password!';
messagedlg('invalid password!', mtwarning, [mbok], 0);
end;
end;

if msgnum = msg_refresh then begin
stat[0] := 'decompressing';
savestring(data, 'temp2.txt');
uncompressbitmap(data, image1.picture.bitmap);
stat[0] := 'ready';
end;

if msgnum = msg_screen_update then begin
bmp := tbitmap.create;
stat[0] := 'decompressing';
uncompressbitmap(data, bmp);
r := rect(0, 0, bmp.width, bmp.height);
with image1.picture.bitmap.canvas do begin
copymode := cmsrcinvert;
copyrect(r, bmp.canvas, r);
end;
stat[0] := 'ready';
bmp.free;
end;

if msgnum = msg_sever_delay then begin
stat[0] := 'server delay set';
end;

if msgnum = msg_view_mode then begin
stat[0] := 'view mode set';
end;

if msgnum = msg_comp_mode then begin
stat[0] := 'compression mode set';
end;

if msgnum = msg_priority_mode then begin
stat[0] := 'priority mode set';
end;

if msgnum = msg_process_list then begin
if procform = nil then
procform := tproclistform.create(self);
(procform as tproclistform).setlist(data);
procform.show;
stat[0] := 'received process list';
end;

if msgnum = msg_drive_list then begin
if fileform = nil then
fileform := tfilesform.create(self);
(fileform as tfilesform).setdrivelist(data);
fileform.show;

stat[0] := 'received drive list';
end;

if msgnum = msg_directory then begin
assert(fileform <> nil);
(fileform as tfilesform).setdirdata(data);
fileform.show;

stat[0] := 'received directory';
end;

if msgnum = msg_file then begin
assert(fileform <> nil);
stat[0] := 'received file';
(fileform as tfilesform).setfiledata(data);
end;

if msgnum = msg_remote_launch then begin
stat[0] := 'launched file: ' + data;
end;
end;

procedure tclientform.clientsocket1disconnect(sender: tobject;
socket: tcustomwinsocket);
begin
log(format('%-7s %s', ['logoff', datetimetostr(now)]));
clientsocket1.active := false;
enablebuts;
stat[0] := ('disconnected: ' + socket.remotehost);
caption := 'remote control client';
stopanim;
end;

procedure tclientform.disconnect1click(sender: tobject);
begin
stat[0] := 'disconnecting...';
clientsocket1.active := false;
enablebuts;
stopanim;
end;

procedure tclientform.refreshcomplete1click(sender: tobject);
begin
sendmsg(msg_refresh, '', clientsocket1.socket);
end;

procedure tclientform.updatechanges1click(sender: tobject);
begin
sendmsg(msg_screen_update, '', clientsocket1.socket);
end;

procedure tclientform.image1mousemove(sender: tobject; shift: tshiftstate;
x, y: integer);
begin
scalexy(x, y);
lastx := x;
lasty := y;

addmove(x, y);
end;

procedure tclientform.addmove(x, y: integer);
var
moveobj : tmoveobj;
begin
moveobj := tmoveobj.create;
moveobj.x := x;
moveobj.y := y;
moveobj.time := gettickcount;
movelist.add(moveobj);
end;

procedure tclientform.responsetimertimer(sender: tobject);
var
bm : tbitmap;
x, y : integer;
begin
waitimage.hint := format('wait: %3.1n seconds', [(gettickcount-t1)/1000.0]);

bm := tbitmap.create;
bm.width := waitimage.width;
bm.height := waitimage.height;

anim := anim + 1;
anim := anim and 31;
for x := -1 to 1 do
for y := -1 to 1 do
bm.canvas.draw(anim + x*32, anim + y*32, application.icon);

waitimage.picture.assign(bm);
bm.free;
end;

procedure tclientform.image1mousedown(sender: tobject;
button: tmousebutton; shift: tshiftstate; x, y: integer);
begin
scalexy(x, y);
but := 1;
if button = mbright then but := 2;
clearmovelist;
addmove(x, y);
end;

procedure tclientform.image1click(sender: tobject);
begin
numclick := 1;
clicktimer.enabled := true;
end;

procedure tclientform.image1mouseup(sender: tobject; button: tmousebutton;
shift: tshiftstate; x, y: integer);
begin
scalexy(x, y);
if but = 2 then begin
// only do this for right clicks
sendmsg(msg_click, inttobytestr(lastx) + inttobytestr(lasty) +
inttobytestr(1 {single}) + inttobytestr(but), clientsocket1.socket);
end;
addmove(x, y);
end;

procedure tclientform.image1dblclick(sender: tobject);
begin
numclick := 2;
clicktimer.enabled := true;
end;

procedure tclientform.clicktimertimer(sender: tobject);
var
s : string;
moveobj : tmoveobj;
i : integer;
begin
clicktimer.enabled := false;

if (movelist.count < 5) or (numclick = 2) then begin
// this is a click or double-click
sendmsg(msg_click, inttobytestr(lastx) + inttobytestr(lasty) +
inttobytestr(numclick) + inttobytestr(but), clientsocket1.socket);
end else begin
// this is a "drag" operation
s := inttobytestr(but) + inttobytestr(movelist.count);
for i := 0 to movelist.count-1 do begin
moveobj := movelist;
s := s + inttobytestr(moveobj.x) + inttobytestr(moveobj.y)
+ inttobytestr(moveobj.time);
end;
sendmsg(msg_drag, s, clientsocket1.socket);
end;
end;

procedure tclientform.sendbutclick(sender: tobject);
begin
sendtext(sendedit.text);
end;

procedure tclientform.sendcrbutclick(sender: tobject);
begin
sendtext(sendedit.text + #13);
end;

procedure tclientform.sendtext(const text: string);
begin
sendmsg(msg_keys, text, clientsocket1.socket);
end;


procedure tclientform.log1click(sender: tobject);
begin
log1.checked := not log1.checked;

updatelogvis;
end;

procedure tclientform.updatelogvis;
begin
loglist.visible := log1.checked;
splitter1.visible := log1.checked;

if log1.checked then
loglist.left := splitter1.left - 1;
end;

procedure tclientform.log(const s: string);
begin
loglist.itemindex := loglist.items.add(s);
end;

procedure tclientform.commstat1click(sender: tobject);
begin
commstat1.checked := not commstat1.checked;
statpanel.visible := commstat1.checked;
end;

procedure tclientform.enablebuts;
var
b : boolean;
begin
b := clientsocket1.active;
connect1.enabled := not b;
disconnect1.enabled := b;
end;

procedure tclientform.formcreate(sender: tobject);
begin
enablebuts;
movelist := tlist.create;
parsecomline;
stopanim;
enableinput;

serverdelay := default_server_delay;
viewmode := default_view_mode;
compmode := default_comp_mode;
svrpriority := default_svr_priority;
end;

procedure tclientform.shutdown1click(sender: tobject);
begin
close;
application.mainform.close;
end;

procedure tclientform.formdestroy(sender: tobject);
begin
clearmovelist;
movelist.free;
end;

procedure tclientform.clearmovelist;
var
i : integer;
begin
for i := 0 to movelist.count-1 do
tobject(movelist).free;
movelist.clear;
end;

procedure tclientform.focusserverwindow1click(sender: tobject);
begin
sendmsg(msg_focus_server, '', clientsocket1.socket);
end;

procedure tclientform.parsecomline;
var
i : integer;
s : string;
begin
for i := 1 to paramcount do begin
s := uppercase(paramstr(i));

if s = '/client' then begin
visible := true;
end;
end;
end;

procedure tclientform.enableinput;
var
b : boolean;
begin
b := (needreply = 0) and clientsocket1.active;

sendbut.enabled := b;
sendcrbut.enabled := b;
image1.enabled := b;
special1.enabled := b;
// options1.enabled := b;
end;

procedure tclientform.stopanim;
var
bmp : tbitmap;
begin
screen.cursor := crdefault;
responsetimer.enabled := false;
// stat[2] := 'not waiting';

bmp := tbitmap.create;
bmp.width := waitimage.width;
bmp.height := waitimage.height;
bmp.canvas.draw(2, 2, application.icon);
waitimage.picture.assign(bmp);
bmp.free;

enableinput;
end;

procedure tclientform.startanim;
begin
anim := 2;
responsetimer.enabled := true;
// stat[2] := 'waiting';
t1 := gettickcount;
screen.cursor := crappstart;
enableinput;
end;

procedure tclientform.wmsyscommand(var message: twmsyscommand);
begin
if (message.cmdtype and $fff0 = sc_minimize) then
application.minimize
else
inherited;
end;

function tclientform.cansendmenumsg: boolean;
begin
result := clientsocket1.active;
end;

procedure tclientform.pausechange(sender: tobject);
var
d : integer;
begin
d := 0;
(sender as tmenuitem).checked := true;

if sender = n005sec1 then d := 50;
if sender = n010sec1 then d := 100;
if sender = n050sec1 then d := 500;
if sender = n100sec1 then d := 1000;
if sender = n200sec1 then d := 2000;
if sender = n500sec1 then d := 5000;
serverdelay := d;

if cansendmenumsg then
sendmsg(msg_sever_delay, inttobytestr(d), clientsocket1.socket);
end;

procedure tclientform.colorclick(sender: tobject);
var
vm : tviewmode;
x : integer;
begin
(sender as tmenuitem).checked := true;

vm := vmdefault;
if sender = color4 then vm := vmcolor4;
if sender = gray4 then vm := vmgray4;
if sender = gray8 then vm := vmgray8;
if sender = color24 then vm := vmcolor24;
if sender = default1 then vm := vmdefault;
viewmode := vm;

if cansendmenumsg then begin
x := integer(vm);
sendmsg(msg_view_mode, inttobytestr(x), clientsocket1.socket);
sendmsg(msg_refresh, '', clientsocket1.socket);
end;
end;

procedure tclientform.compclick(sender: tobject);
var
cm : tcompressionlevel;
begin
(sender as tmenuitem).checked := true;

cm := cldefault;

if sender = highslow1 then cm := clmax;
if sender = medium1 then cm := cldefault;
if sender = lowfast1 then cm := clfastest;
compmode := cm;

if cansendmenumsg then
sendmsg(msg_comp_mode, inttobytestr(integer(cm)), clientsocket1.socket);
end;

procedure tclientform.priorityclick(sender: tobject);
var
x : integer;
begin
(sender as tmenuitem).checked := true;

x := thread_priority_normal;

if sender = critical1 then x := thread_priority_time_critical;
if sender = highest1 then x := thread_priority_highest;
if sender = abovenormal1 then x := thread_priority_above_normal;
if sender = normal1 then x := thread_priority_normal;
if sender = belownormal1 then x := thread_priority_below_normal;
if sender = lowest1 then x := thread_priority_lowest;
if sender = idle1 then x := thread_priority_idle;
svrpriority := x;

if cansendmenumsg then
sendmsg(msg_priority_mode, inttobytestr(x), clientsocket1.socket);
end;

procedure tclientform.send_current_settings;
begin
sendmsg(msg_sever_delay, inttobytestr(serverdelay), clientsocket1.socket);
sendmsg(msg_view_mode, inttobytestr(integer(viewmode)), clientsocket1.socket);
sendmsg(msg_comp_mode, inttobytestr(integer(compmode)), clientsocket1.socket);
sendmsg(msg_priority_mode, inttobytestr(svrpriority), clientsocket1.socket);
end;

procedure tclientform.scaleimage1click(sender: tobject);
begin
scaleimage1.checked := not scaleimage1.checked;

if scaleimage1.checked then begin
image1.autosize := false;
image1.stretch := true;
image1.align := alclient;
end else begin
image1.autosize := true;
image1.stretch := false;
image1.align := alnone;
image1.picture.assign(image1.picture.graphic); // to trigger the autosize property
end;
end;

procedure tclientform.scalexy(var x, y: integer);
begin
if not scaleimage1.checked then exit;

with image1 do begin
x := x * picture.width div width;
y := y * picture.height div height;
end;
end;

procedure tclientform.processlist1click(sender: tobject);
begin
sendmsg(msg_process_list, '', clientsocket1.socket);
end;

procedure tclientform.filelist1click(sender: tobject);
begin
sendmsg(msg_drive_list, '', clientsocket1.socket);
end;

procedure tclientform.sendpanelresize(sender: tobject);
begin
sendedit.width := sendpanel.clientwidth - 8;
end;

procedure tclientform.about1click(sender: tobject);
begin
aboutbox.showmodal;
end;

procedure tclientform.statbarmenuclick(sender: tobject);
begin
statbarmenu.checked := not statbarmenu.checked;

statusbar1.visible := statbarmenu.checked;
end;

procedure tclientform.fullscreen1click(sender: tobject);
begin
if borderstyle = bssizeable then begin
beforefull := boundsrect;
menu := nil;
left := 0;
top := 0;
width := screen.width;
height := screen.height;
borderstyle := bsnone;
statpanel.visible := false;
statusbar1.visible := false;
scrollbox1.borderstyle := bsnone;
fstopform.show;
end else begin
boundsrect := beforefull;
menu := mainmenu1;
borderstyle := bssizeable;
statpanel.visible := true;
statusbar1.visible := true;
scrollbox1.borderstyle := bssingle;
fstopform.hide;
end;
end;

procedure tclientform.formkeydown(sender: tobject; var key: word;
shift: tshiftstate);
begin
// if in full-screen mode, do an extra check for hot-keys on the popup menu
if borderstyle = bsnone then begin
fstopform.checkshortcut(key, shift);
end;
end;

end.

我可没心思贴这么长的源码
oracle的VNC甚至支持异种操作系统的监控如unix/windows/linux/vms等，
有源码的，自己找来读好了

listen

wrench：
你好，你粘的代码俺试了，出现了很多编译错误；俺很菜，能否烦你把整个工程
给俺MAIL过来，俺愿意再奉上200分！
俺的Email: hqlsta@163.net hqlsta@263.net

记得国外有种设备 可以在一个较小的距离内 不通过任何有线连接 而是直接对
视频信号线泄露的信号进行放大和重建 然后就可以和您共享屏幕上的内容了。
----------------这个谁要能自己实现，并给出设计，我出20000分。

TO wrench：

也给我发一封好吗？
Email:yawei@pub6.fz.fj.cn

建议不要用UDP协议在INTENET上掉失太厉害，根本无法接收

朕说：朕也想要一份怎样？？？

to jingtao:
你好啊！
你的“黑洞”不是更合适...

OopsWare>>我直接用SOCKET，在INTENET上用的很好。很久没有见你了呢：）

通过把SCREEN 的HANDLE 赋给TIMAGE，HANDEL 获得SCREEN，然后使用UDP协议发送给指定的
COMPUTER，即可。