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 Client;
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)+' 连接来自于: "' + NewClient.HostName + '" on ' + NewClient.PeerIP);
RefreshListDisplay;
end;
procedure TMainFormServer.TCPServerDisconnect(AContext: TIdContext);
var
Client: PClient;
begin
Client := PClient(AContext.Data);
Protocol.Lines.Add (TimeToStr(Time)+' 断开连接: "' + Client.HostName+'"');
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.
哪位懂网络编程的能否帮忙修改一下。
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 Client;
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)+' 连接来自于: "' + NewClient.HostName + '" on ' + NewClient.PeerIP);
RefreshListDisplay;
end;
procedure TMainFormServer.TCPServerDisconnect(AContext: TIdContext);
var
Client: PClient;
begin
Client := PClient(AContext.Data);
Protocol.Lines.Add (TimeToStr(Time)+' 断开连接: "' + Client.HostName+'"');
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.
哪位懂网络编程的能否帮忙修改一下。