用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

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

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

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