转至繁体中文版　　　  | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告：     敏韬网|教学资源学习资料永久免费分享站！  [mintao  2008年9月2日]        
您现在的位置： 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
用delphi实现冰河的远程屏幕操作功能    热     ★★★★

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

作者：闵涛 文章来源：闵涛的学习笔记 点击数：2845 更新时间：2009/4/23 18:26:07
d: '''' + 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[i];
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[i]).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 = N050se

上一页  [1] [2] [3] [4] [5]  下一页


没有相关教程
教程录入：mintao    责任编辑：mintao 
  • 上一篇教程：

  • 下一篇教程：
    • 【字体：小 大】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】
    　 注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网]
    　　网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！）
    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
    		•
    赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题，因而无法显示。
    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长：MinTao ICP备案号：鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网。A打造B、C、D……
    		咸宁网络警察报警平台