用delphi实现冰河的远程屏幕操作功能_Delphi程序_学习笔记★闵涛★计算机学习电脑编程软硬件技巧


	转至繁体中文版	\| 网站首页 \| 图文教程 \| 资源下载 \| 站长博客 \| 图片素材 \| 武汉seo \| 武汉网站优化 \|

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

作者：闵涛文章来源：闵涛的学习笔记点击数：2842 更新时间：2009/4/23 18:26:07

ib;

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[i] 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[i].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] := ''''Receive

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

没有相关教程

教程录入：mintao 责任编辑：mintao

上一篇教程：在Internet传播声音

下一篇教程：用pascal写的最简单的winsock程序

【字体：小大】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】

注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网]

　网友评论：（只显示最新10条。评论内容只代表网友观点，与本站立场无关！）

同类栏目

· C语言系列 · VB.NET程序
· JAVA开发 · Delphi程序
· 脚本语言

热门推荐

没有教程

赞助链接

闵涛博文

500 - 内部服务器错误。

您查找的资源存在问题，因而无法显示。

鄂公网安备 42011102001154号

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

闵涛站盟:医药大全-武穴网。A打造B、C、D……