送上1000大元，还可以再加！先到先得！(200分)

你的意思是要象pcanywhere一样可以向被控机发送Ctrl+Alt+Del键?
可能要用消息吧?

对了，没错，所有所谓远程控制，如果不解决这个问题都不能算是真正的控制。
yangkee，有办法？

向被控机发送Ctrl+Alt+Del键相比之下都比较容易，关键是被控机接受Ctrl+Alt+Del后还能受控，
有难度。

不，你错了，关键是被控机能响应所发送过去的这三个组合键。
发送过去很容易，但响应就难了。
好象yangkee有办法？

以前见过张辉的remotecontrol 是delphi公开原码的

区DELPHI深度历陷，那里有几个你要的控件，还有源码。

这个看看有没有用!

用delphi实现冰河的远程屏幕操作功能





　 分为服务端和客户端两个部分，虽然不是一个完整的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.

接受答案了.