unit ClientUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Forms,
ExtCtrls, StdCtrls, ScktComp, Controls,dialogs;

type
TClientThread=class(TThread)
private
  ClientSocket: TClientSocket;
  LastUpdate:DWORD;
  Bitmap:TBitmap;
  Traffic:integer;
protected
  procedure UpdateScreen;
  procedure Execute;override;
public
  constructor Create(CreateSuspended: Boolean;const Address:string);
  destructor Destroy;override;
end;

type
TMouseEvent=(meNone,meMove,meClick,meDblClick,meDown,meUp);
TRes=packed record
  X,Y:word;
end;
TCmd=packed record
  CmdType:word;
  Res:TRes;
  Param:DWORD;
end;

TForm1 = class(TForm)
  Panel1: TPanel;
  AddressEd: TEdit;
  Button1: TButton;
  Image: TImage;
  Button2: TButton;
  procedure Button1Click(Sender: TObject);
  procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
  procedure ImageClick(Sender: TObject);
  procedure Button2Click(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
  ClientThread:TClientThread;
public
  MousePos:TPoint;
  MouseEvent:TMouseEvent;
  MouseMoved:boolean;
  Msg:string;
  MsgReady:boolean;
end;

var
Form1: TForm1;

implementation
uses math,Jpeg,JPEG_IO;
{$R *.dfm}

{ TClientThread }

constructor TClientThread.Create(CreateSuspended: Boolean;const Address:string);
var i:integer;
begin
Bitmap:=TBitmap.Create;
ClientSocket:=TClientSocket.Create(nil);
ClientSocket.ClientType:=ctBlocking;
i:=pos(':',Address);
ClientSocket.Address:=copy(Address,1,i-1);
ClientSocket.Port:=StrToInt(copy(Address,i+1,MaxInt));
ClientSocket.Active:=true;
inherited Create(CreateSuspended);
end;

destructor TClientThread.Destroy;
begin
ClientSocket.Free;
Bitmap.Free;
inherited;
end;

procedure TClientThread.Execute;
var
Socket:TClientWinSocket;
ScreenStream:TMemoryStream;
Cmd:word;
ImgSize:TPoint;
Buf:array[0..1023] of byte;
size,ToRead:integer;
begin
Socket:=ClientSocket.Socket;
try
  ScreenStream:=TMemoryStream.Create;
  try
    while Socket.Connected and not Terminated do
    begin
      ImgSize.X:=Form1.Image.Width;
      ImgSize.Y:=Form1.Image.Height;
      if Form1.MouseEvent=meMove then
      begin
        Cmd:=2;
        if Socket.SendBuf(Cmd,SizeOf(Cmd))<>SizeOf(Cmd) then exit;
        if Socket.SendBuf(ImgSize,SizeOf(ImgSize))<>SizeOf(ImgSize) then exit;
        if Socket.SendBuf(Form1.MousePos,SizeOf(Form1.MousePos))<>SizeOf(Form1.MousePos) then exit;
        Form1.MouseMoved:=false;
      end;
      if Form1.MsgReady then
      begin
        Cmd:=3;
        if Socket.SendBuf(Cmd,SizeOf(Cmd))<>SizeOf(Cmd) then exit;
        size:=Length(Form1.Msg);
        if Socket.SendBuf(size,SizeOf(size))<>SizeOf(size) then exit;
        if Socket.SendBuf(PChar(Form1.Msg)^,size)<>size then exit;

        if Socket.ReceiveBuf(size,SizeOf(size))<>SizeOf(size) then exit;
        if size>0 then
          if Socket.ReceiveBuf(PChar(Form1.Msg)^,size)<>size then exit;
            MessageBox(0, PChar(Form1.Msg),'Отвед',MB_OK);
        Form1.MsgReady:=false;
      end;

      Cmd:=1;
      if Socket.SendBuf(Cmd,SizeOf(Cmd))<>SizeOf(Cmd) then exit;
      if Socket.SendBuf(ImgSize,SizeOf(ImgSize))<>SizeOf(ImgSize) then exit;
      if Socket.ReceiveBuf(size,SizeOf(size))<>4 then exit;
      if (Size<0) or (Size>maxInt-1) then exit;
      ScreenStream.Size:=Size;
      ScreenStream.Position:=0;
      ToRead:=ScreenStream.Size-ScreenStream.Position;
      ToRead:=Min(ToRead,Length(Buf));
      while (ToRead>0) and Socket.Connected do
      begin
        Size:=Socket.ReceiveBuf(Buf,ToRead);
        if Size<0 then exit;
        ScreenStream.WriteBuffer(Buf,Size);
        ToRead:=ScreenStream.Size-ScreenStream.Position;
        ToRead:=Min(ToRead,Length(Buf));
      end;
      ScreenStream.Position:=0;
      Traffic:=ScreenStream.Size;
      LoadBmpFromJpegStream(Bitmap,ScreenStream);
      Synchronize(UpdateScreen);
    end;
  finally
    ScreenStream.Free;
  end;
finally
  Socket.Close;
end;
end;

procedure TClientThread.UpdateScreen;
var tick:DWORD;
begin
Form1.Image.Picture.Bitmap.Assign(Bitmap);
tick:=GetTickCount;
Form1.Image.Canvas.Brush.Style:=bsClear;
Form1.Image.Canvas.TextOut(1,1,Format('Разрешение: %d:%d, cкорость: %f кадр/сек, трафик %d байт/кадр',
  [Bitmap.Width,Bitmap.Height,1000/(tick-LastUpdate),Traffic]));
LastUpdate:=tick;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ClientThread:=TClientThread.Create(true,AddressEd.Text);
ClientThread.FreeOnTerminate:=true;
ClientThread.Priority:=tpLower;
ClientThread.Resume;
end;

procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
MousePos.X:=x;
MousePos.Y:=y;
MouseMoved:=true;
end;

procedure TForm1.ImageClick(Sender: TObject);
begin
MouseEvent:=meClick;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
MsgReady:=InputQuery('Input Box', 'Prompt', Msg);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClientThread:=nil;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if assigned(ClientThread) then
begin
  ClientThread.Terminate;
  ClientThread:=nil;
end;
end;

end.

program NetScreenServerCon;
{$apptype console}

uses
Windows,
SysUtils,
Classes,
ScktComp,
Graphics,
Dialogs,
JPEG_IO in 'JPEG_IO\JPEG_IO.pas',
IJL in 'JPEG_IO\ijl.pas';

type
TSCThread=class(TServerClientThread)
private
  Bitmap:TBitmap;
protected
  procedure GrabScreen(Stream:TMemoryStream;const ImgSize:TPoint);
  procedure SetMouse(const ImgSize,MousePoint:TPoint);
  procedure ClientExecute; override;
public
  constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
  destructor Destroy; override;
end;

constructor TSCThread.Create(CreateSuspended: Boolean;
ASocket: TServerClientWinSocket);
begin
Bitmap:=TBitmap.Create;
bitmap.PixelFormat:=pf24bit;
inherited;
end;

destructor TSCThread.Destroy;
begin
Bitmap.Free;
inherited;
end;

procedure TSCThread.GrabScreen(Stream:TMemoryStream;const ImgSize:TPoint);
var
Desktop:HWnd;
DesktopRect: TRect;
DesktopDC:HDc;
begin
Desktop:=GetDesktopWindow;
GetWindowRect(Desktop,DesktopRect);
Bitmap.Height:=ImgSize.Y;
Bitmap.Width:=ImgSize.X;
DesktopDC:=GetWindowDC(Desktop);
try
  Win32Check(StretchBlt(Bitmap.Canvas.Handle,0,0,Bitmap.Width,Bitmap.Height,
            DesktopDC,DesktopRect.Left,DesktopRect.Top,DesktopRect.Right,DesktopRect.Bottom,  SRCCOPY));
finally
  ReleaseDC(Desktop,DesktopDC);
end;
SaveBmpToJpegStream(Bitmap,Stream,30);
end;

procedure TSCThread.SetMouse(const ImgSize, MousePoint: TPoint);
var
Desktop:HWnd;
DesktopRect: TRect;
begin
Desktop:=GetDesktopWindow;
GetWindowRect(Desktop,DesktopRect);
SetCursorPos(round(DesktopRect.BottomRight.X/ImgSize.X*MousePoint.X),round(DesktopRect.BottomRight.Y/ImgSize.Y*MousePoint.Y));
end;

procedure TSCThread.ClientExecute;
var
ScreenStream:TMemoryStream;
Buf:array[0..1023] of byte;
Cmd:word;
ImgSize,Mouse:TPoint;
size:integer;
s:string;
begin
while (not Terminated) and ClientSocket.Connected do
try
  ScreenStream:=TMemoryStream.Create;
  try
    if ClientSocket.ReceiveBuf(Cmd,SizeOf(Cmd))<>SizeOf(Cmd) then exit;
    if Cmd=1 then
    begin
      if ClientSocket.ReceiveBuf(ImgSize,SizeOf(ImgSize))<>SizeOf(ImgSize) then exit;
      GrabScreen(ScreenStream,ImgSize);
      ScreenStream.Position:=0;
      size:=ScreenStream.Size;
      ClientSocket.SendBuf(size,SizeOf(size));
      while ScreenStream.Position<ScreenStream.Size do
      begin
        size:=ScreenStream.Read(Buf,SizeOf(Buf));
        if ClientSocket.SendBuf(Buf,size)<>size then exit;
      end;
    end;
    if Cmd=2 then
    begin
      if ClientSocket.ReceiveBuf(ImgSize,SizeOf(ImgSize))<>SizeOf(ImgSize) then exit;
      if ClientSocket.ReceiveBuf(Mouse,SizeOf(Mouse))<>SizeOf(Mouse) then exit;
      SetMouse(ImgSize,Mouse);
    end;
    if Cmd=3 then
    begin
      if ClientSocket.ReceiveBuf(size,SizeOf(size))<>SizeOf(size) then exit;
      SetLength(s,size);
      if ClientSocket.ReceiveBuf(PChar(s)^,size)<>size then exit;
      if MessageBox(0,PChar(s),'Ответить?',MB_YESNO)=ID_YES then
        InputQuery('Ответ','Ну давай',s) else s:='';
      size:=Length(s);
      if ClientSocket.SendBuf(size,SizeOf(size))<>SizeOf(size) then exit;
      if size>0 then
        if ClientSocket.SendBuf(PChar(s)^,size)<>size then exit;
    end;
  finally
    ScreenStream.Free;
  end;
except
  Terminate;
  HandleException;
end;
end;

function Proc2Method(Code,Data:pointer):TMethod;
begin
result.Code:=Code;
result.Data:=Data;
end;

procedure GetThread(self,Sender: TObject; ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
begin
SocketThread:=TSCThread.Create(true,ClientSocket);
SocketThread.Priority:=tpLower;
SocketThread.Resume;
end;

var Server:TServerSocket;

begin
Server:=TServerSocket.Create(nil);
try
  Server.ServerType:=stThreadBlocking;
  Server.OnGetThread:=TGetThreadEvent(Proc2Method(@GetThread,Server));
  Server.Port:=1234;
  Server.Active:=true;
  while Server.Active do Sleep(100);
finally
  Server.Free;
end;
end.