远程抓屏(含代码)如何在退出时关闭客户端的连接?(100分)

  • 主题发起人 主题发起人 ww990
  • 开始时间 开始时间
W

ww990

Unregistered / Unconfirmed
GUEST, unregistred user!
远程抓屏的原代码如下:
unit MainUnitServer;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, IdTCPServer, IdSocketHandle, IdBaseComponent,IdContext,
IdComponent, Buttons, ExtCtrls, Jpeg, ImgList, ComCtrls, ToolWin,
IdAntiFreezeBase, IdAntiFreeze, IdStack, SyncObjs, IdCustomTCPServer;
//IdThreadMgr, IdThreadMgrDefault,
type
PClient = ^TClient;
TClient = record
PeerIP : string[15]; { Cleint IP address }
HostName : String[40]; { Hostname }
TakeShot : boolean;
Connected, { Time of connect }
LastAction : TDateTime; { Time of last transaction }
Thread : Pointer; { Pointer to thread }
end;

TMainFormServer = class(TForm)
TCPServer: TIdTCPServer;
pnlMain: TPanel;
ImageScrollBox: TScrollBox;
Image: TImage;
InfoLabel: TStaticText;
pnlLeft: TPanel;
ClientsBox: TGroupBox;
ClientsListBox: TListBox;
DetailsBox: TGroupBox;
DetailsMemo: TMemo;
ActionPanel: TPanel;
AutoCaptureCheckBox: TCheckBox;
SecondsCombo: TComboBox;
GetImageNowButton: TBitBtn;
Protocol: TMemo;
Timer: TTimer;
IdAntiFreeze: TIdAntiFreeze;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ClientsListBoxClick(Sender: TObject);
procedure AutoCaptureCheckBoxClick(Sender: TObject);
procedure GetImageNowButtonClick(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure TCPServerConnect(AContext: TIdContext);
procedure TCPServerExecute(AContext: TIdContext);
procedure TCPServerDisconnect(AContext: TIdContext);
procedure FormDeactivate(Sender: TObject);
private
procedure RefreshListDisplay;
procedure RefreshImage(const ClientDNS, ImageName : string);
public
end;

const
// DefaultServerIP = '192.168.0.1';
DefaultServerIP = '127.0.0.1';
DefaultServerPort = 7676;

var
MainFormServer : TMainFormServer;
Clients : TThreadList; // Holds the data of all clients

implementation
{$R *.DFM}

procedure TMainFormServer.FormCreate(Sender: TObject);
var
Bindings: TIdSocketHandles;
begin
//设置并启动TCPServer
Bindings := TIdSocketHandles.Create(TCPServer);
try
with Bindings.Add do
begin
IP := DefaultServerIP;
Port := DefaultServerPort;
end;

try
TCPServer.Bindings:=Bindings;
TCPServer.Active:=True;
except on E:Exception do
ShowMessage(E.Message);
end;
finally
Bindings.Free;
end;
//setup TCPServer

//other startup settings
Clients := TThreadList.Create;
Clients.Duplicates := dupAccept;

SecondsCombo.ItemIndex := 0;
Timer.Enabled := False;
DetailsMemo.Clear;
InfoLabel.Caption := '等待中...';

RefreshListDisplay;

if TCPServer.Active then
begin
Protocol.Lines.Add('远程抓屏服务器运行在' + TCPServer.Bindings[0].IP + ':' + IntToStr(TCPServer.Bindings[0].Port));
end;
end; procedure TMainFormServer.FormDeactivate(Sender: TObject);
begin

end;

(* Form Create *)

procedure TMainFormServer.FormClose(Sender: TObject; var Action: TCloseAction);
var
ClientsCount : integer;
begin
try
ClientsCount := Clients.LockList.Count;
finally
Clients.UnlockList;
end;

if (ClientsCount > 0) then //and (TCPServer.Active) then
begin
Action := caNone;
ShowMessage('有连接的客户端时不能关闭远程抓屏服务器!');
end
else
begin
TCPServer.Active := False;
Clients.Free;
end;
end; (* Form Close *)

procedure TMainFormServer.RefreshListDisplay;
var
AClient :PClient;
i:integer;
begin
GetImageNowButton.Enabled := False;

ClientsListBox.Clear;
DetailsMemo.Clear;

with Clients.LockList do
try
for i := 0 to Count-1 do
begin
AClient := Items;
ClientsListBox.AddItem(AClient.HostName,TObject(AClient));
end;
finally
Clients.UnlockList;
end;

GetImageNowButton.Enabled := ClientsListBox.Items.Count > 0;
AutoCaptureCheckBox.Enabled := GetImageNowButton.Enabled;
end; (* RefreshListDisplay *)


procedure TMainFormServer.ClientsListBoxClick(Sender: TObject);
var
SelClient: PClient;
begin
DetailsMemo.Clear;

if ClientsListBox.ItemIndex <> -1 then
begin
try
SelClient := PClient(Clients.LockList.Items[ClientsListBox.ItemIndex]);
with DetailsMemo do
begin
Lines.Add('IP 地 址: ' + SelClient.PeerIP);
Lines.Add('主 机 名: ' + SelClient.HostName);
Lines.Add('连 接: ' + DateTimeToStr(SelClient.Connected));
Lines.Add('最后取屏: ' + DateTimeToStr(SelClient.LastAction));
Lines.Add('等 待 中: ' + BoolToStr(SelClient.TakeShot, True));
end;
finally
Clients.UnlockList;
end;
end;
end; (* ClientsListBox Click *)

procedure TMainFormServer.AutoCaptureCheckBoxClick(Sender: TObject);
begin
GetImageNowButton.Enabled := NOT AutoCaptureCheckBox.Checked;

Timer.Interval := 1000 * StrToInt(SecondsCombo.Items[SecondsCombo.ItemIndex]);
Timer.Enabled := AutoCaptureCheckBox.Checked;
end; (* AutoCaptureCheckBoxClick *)

procedure TMainFormServer.GetImageNowButtonClick(Sender: TObject);
var
SelClient : PClient;
begin
if ClientsListBox.ItemIndex = -1 then
begin
if Sender is TBitBtn then ShowMessage('请从列表中选择一个客户端!');
Exit;
end;

try
SelClient := PClient(Clients.LockList.Items[ClientsListBox.ItemIndex]);
SelClient.TakeShot := True;
finally
Clients.UnLockList
end;

//refresh DetailsMemo
ClientsListBoxClick(Sender);
end; (* GetImageNowButton Click *)

procedure TMainFormServer.RefreshImage(const ClientDNS, ImageName : string);
begin
Image.Picture.LoadFromFile(ImageName);
InfoLabel.Caption := '取屏来自于: ' + ClientDNS;
end; (* RefreshImage *)

procedure TMainFormServer.TCPServerConnect(AContext: TIdContext); //uses IdContext
var
NewClient: PClient;
begin
GetMem(NewClient, SizeOf(TClient));

NewClient.PeerIP :=AContext.Binding.PeerIP;
NewClient.HostName := GStack.HostByAddress(NewClient.PeerIP);
NewClient.TakeShot := False;
NewClient.Connected := Now;
NewClient.LastAction := NewClient.Connected;
NewClient.Thread := AContext;

AContext.Data := TObject(NewClient);

try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;

Protocol.Lines.Add(TimeToStr(Time)+' 连接来自于: &quot;' + NewClient.HostName + '&quot; on ' + NewClient.PeerIP);
RefreshListDisplay;
end;

procedure TMainFormServer.TCPServerDisconnect(AContext: TIdContext);
var
Client: PClient;
begin
Client := PClient(AContext.Data);
Protocol.Lines.Add (TimeToStr(Time)+' 断开连接: &quot;' + Client.HostName+'&quot;');
try
Clients.LockList.Remove(Client);
finally
Clients.UnlockList;
end;
FreeMem(Client);
AContext.Data := nil;

RefreshListDisplay;
end; (* TCPServer Disconnect *)


procedure TMainFormServer.TCPServerExecute(AContext: TIdContext);
var
Client : PClient;
Command : string;
Size : integer;
PicturePathName : string;
ftmpStream : TFileStream;
begin
//if not AThread.Terminated and AThread.Connection.Connected then

if AContext.Connection.Connected then
begin
Client := PClient(AContext.Data);
Client.LastAction := Now;

Command := AContext.Connection.IOHandler.ReadLn;
if Command = 'CheckMe' then
begin
if Client.TakeShot = True then
begin
Client.TakeShot := False;

AContext.Connection.IOHandler.WriteLn('TakeShot');

PicturePathName := ExtractFileDir(ParamStr(0)) + '/' + Client.HostName + '_Screen.JPG';

if FileExists (PicturePathName) then
DeleteFile(PicturePathName);
ftmpStream := TFileStream.Create(PicturePathName,fmCreate);
Size := AContext.Connection.IOHandler.ReadInteger;
AContext.Connection.IOHandler.ReadStream(fTmpStream,Size,False);
FreeAndNil(fTmpStream);

AContext.Connection.IOHandler.WriteLn('DONE');

RefreshImage(Client.HostName, PicturePathName);
ClientsListBoxClick(nil);
end
else
AContext.Connection.IOHandler.WriteLn('DONE');
end;
end;
end;

(* TCPServer Connect *)


procedure TMainFormServer.TimerTimer(Sender: TObject);
begin
Timer.Enabled := False;
GetImageNowButtonClick(Sender);
Timer.Enabled := True;
end; (* TimerTimer *)

end.


哪位懂网络编程的能否帮忙修改一下。
 
传 2ccc.com 我到给你看看.
 
到这里可以下载:http://www.tomore.com/1/41892.html
 
indyTCP 客户端断开时服务器没有事件触发吗?
 
是 Delphi2005 的程序吧!怎么编译通不过,找不到 IdCustomTCPServer.dcu !
 
贴这么多代码等于没贴。。。
断开应该触发一个
OnDisconnect实践
 
to iamy
没看明白我的问题!
 
问题已解决。
 
你那个编译通不过的问题,怎么解决?
 
应该是由实践自动判断的,不需要服务端作处理。
 
楼主怎么解决的?
 
直接关闭就可以了TCPServer.Active := False;
 
接受答案了.
 
后退
顶部