?? rdclientmain.pas.~14~
字號:
unit rdClientMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, StdCtrls, ExtCtrls,jpeg, ComCtrls, ToolWin;
type
TForm1 = class(TForm)
IdTCPClient1: TIdTCPClient;
IdTCPServer1: TIdTCPServer;
Memo1: TMemo;
ScrollBox1: TScrollBox;
Image1: TImage;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
procedure ToolButton1Click(Sender: TObject);
procedure IdTCPClient1Disconnected(Sender: TObject);
procedure IdTCPClient1Connected(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure Memo1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
private
{ Private declarations }
bmpScreen: TBitmap;
jpg: TJPEGImage;
public
{ Public declarations }
function GetScreenBmp:Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
with AThread.Connection.Socket.Binding do
begin
Memo1.Lines.Add(Format('%s: %d 已經登陸!',[PeerIP,PeerPort]))
end;
end;
procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin
with AThread.Connection.Socket.Binding do
begin
Memo1.Lines.Add(Format('%s: %d 退出!',[PeerIP,PeerPort]))
end;
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
ms: TMemoryStream;
buf: array[0..1023] of Char;
begin
ms := TMemoryStream.Create;
AThread.Connection.ReadStream(ms,-1,true);
ms.Position := 0;
ms.ReadBuffer(buf,ms.Size);
Memo1.Lines.Add(buf);
ms.Free;
end;
function TForm1.GetScreenBmp: Boolean;
var
dc: HDC;
begin
Result := True;
try
dc := GetDC(0);
BitBlt( bmpScreen.Canvas.Handle, 0, 0, Screen.Width,screen.Height, dc,
0, 0, SRCCOPY );
OutputDebugString(PChar(FormatDateTime('yyyy-mm-dd hh:mm:ss zzz',now)));
jpg.Assign(bmpScreen);
OutputDebugString(PChar(FormatDateTime('yyyy-mm-dd hh:mm:ss zzz',now)));
ReleaseDC(0,dc);
Image1.Picture.Assign(jpg);
except
Result := False;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
bmpScreen := TBitmap.Create;
bmpScreen.Width := Screen.Width;
bmpScreen.Height:= Screen.Height;
Image1.Width := Screen.Width;
Image1.Height := Screen.Height;
jpg := TJPEGImage.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
bmpScreen.Free;
jpg.Free;
end;
procedure TForm1.Memo1Change(Sender: TObject);
begin
// GetScreenBmp;
end;
procedure TForm1.ToolButton3Click(Sender: TObject);
var
msJpg: TMemoryStream;
begin
try
if IdTCPClient1.Connected then
begin
Memo1.Lines.Add('發送請求命令: Request_Send');
IdTCPClient1.SendCmd('Request_Send');
msjpg := TMemoryStream.Create;
if GetScreenBmp then
begin
jpg.SaveToStream(msJpg);
IdTCPClient1.WriteStream(msJpg);
IdTCPClient1.Disconnect;
end;
end;
except
end;
end;
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
Memo1.Lines.Add('連接...')
end;
procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
Memo1.Lines.Add('斷開連接...')
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
try
IdTCPClient1.Connect;
except
on e: Exception do
memo1.Lines.Add(e.Message);
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -