分為服務端和客戶端兩個部分，雖然不是一個完整的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, MsgNu
