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.