program NetScreenServerCon;
{$apptype console}

uses
Windows,SysUtils,Classes,ScktComp,Graphics,Jpeg;

type
TSCThread=class(TServerClientThread)
private
  Bitmap:TBitmap;
  Jpeg:TJpegImage;
protected
  procedure GrabScreen(Stream:TStream;const ImgSize: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;
Jpeg:=TJpegImage.Create;
inherited;
end;

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

procedure TSCThread.GrabScreen(Stream:TStream;const ImgSize:TPoint);
var
Desktop:HWnd;
DesktopRect: TRect;
DesktopDC:HDc;
begin
Stream.Size:=0;
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;
Jpeg.Assign(Bitmap);
Jpeg.SaveToStream(Stream);
end;

procedure TSCThread.ClientExecute;
var
ScreenStream:TMemoryStream;
Buf:array[0..1023] of byte;
ImgSize:TPoint;
size:integer;
begin
while (not Terminated) and ClientSocket.Connected do
try
  ScreenStream:=TMemoryStream.Create;
  try
    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;
  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.

unit ClientUnit;

interface

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

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

TForm1 = class(TForm)
  Panel1: TPanel;
  AddressEd: TEdit;
  Button1: TButton;
  Image: TImage;
  procedure Button1Click(Sender: TObject);
private
  ClientThread:TClientThread;
public
end;

var
Form1: TForm1;

implementation
uses math,Jpeg;
{$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;
ImgSize:TPoint;
Buf:array[0..1023] of byte;
size,ToRead:integer;
Jpeg:TJpegImage;
begin
Socket:=ClientSocket.Socket;
try
  ScreenStream:=TMemoryStream.Create;
  try
    while Socket.Connected do
    begin
      ImgSize.X:=Form1.Image.Width;
      ImgSize.Y:=Form1.Image.Height;
      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;
      Jpeg:=TJpegImage.Create;
      try
        Jpeg.LoadFromStream(ScreenStream);
        Bitmap.Assign(Jpeg);
      finally
        Jpeg.Free;
      end;
      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 кадр/сек',[Bitmap.Width,Bitmap.Height,1000/(tick-LastUpdate)]));
LastUpdate:=tick;
end;

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

end.

procedure Server2ClientRead(Sender: TObject; Socket: TCustomWinSocket);

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.

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.