用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[i]);

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[i]);

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

• ·在使用微软提供的安全模版（安全策略）时需要注意
• ·文件共享有多安全？
• ·windows NT事件日志说明
• ·用pascal写的最简单的winsock程序
• ·有关IIS HACK的一些方法整理
• ·部分未公开的Windows 2000核心功能调
• ·怎样用delphi制作一个IPhunter(独
• ·Linux 内核解读入门
• ·病毒的编制关键技术（2）
• ·病毒的编制关键技术（1）