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.

unit JPEG_IO;

interface
{$WARN SYMBOL_PLATFORM OFF}
{$WARNINGS OFF}

uses Windows, SysUtils, Classes, Graphics, IJL;

type
 EIJLException = class(Exception);

type
 TIJLScale=(ijlFull, ijlHalf, ijlQuarter, ijlEighth);

procedure SaveBmpToJpegFile  (Bitmap:TBitmap;const FileName:string; const Quality: integer);
procedure SaveBmpToJpegStream(Bitmap:TBitmap;Stream: TMemoryStream; const Quality: integer);

procedure LoadBmpFromJpegFile(Bitmap:TBitmap;const FileName:string;
 const SetPixelFormat:boolean=true; const Scale:TIJLScale=ijlFull);
procedure LoadBmpFromJpegStream(bitmap: TBitmap;  Stream:TMemoryStream;
 const SetPixelFormat:boolean=true; const Scale:TIJLScale=ijlFull);

implementation

procedure IJLCheck(Code:Integer);
begin
 if Code<>IJL_OK then
   raise EIJLException.Create(ijlErrorStr(Code));
end;

procedure SaveBmpToJpegFile(Bitmap:TBitmap;const FileName:string; const Quality: integer);
var
 jcprops:TJPEG_CORE_PROPERTIES;
 DIB: TDIBSection;
begin
 FillChar(jcprops, SizeOf (jcprops), 0);
 IJLCheck(ijlInit(@jcprops));
 try
   with jcprops do
   begin
     case bitmap.PixelFormat of
       pf8bit:
       begin
         DIBChannels:=1;
         DIBColor:=IJL_G;
       end;
       pf24bit:
       begin
         DIBChannels:=3;
         DIBColor:=IJL_BGR;
       end;
       else raise EIJLException.Create('Cannot save bitmap as JPEG with specified PixelFormat');
     end;
     FillChar(DIB, SizeOf(DIB), 0);
     Win32Check(GetObject(Bitmap.Handle, SizeOf(DIB),@DIB)<>0);
     DIBBytes:= PByte(DIB.dsBm.bmBits);
     DIBWidth  := DIB.dsBm.bmWidth;
     DIBHeight :=-DIB.dsBm.bmHeight;
     DIBPadBytes:=((DIBWidth*DIBChannels+3) and -$04)-(DIBWidth*DIBChannels);

     JPGFile := PChar(FileName);

     JPGWidth := DIBWidth;
     JPGHeight:= -DIBHeight;
     JPGChannels:=3;
     JPGColor := IJL_YCBCR;
     jquality := quality;
   end;
   IJLCheck(ijlWrite(@jcprops, IJL_JFILE_WRITEWHOLEIMAGE));
 finally
   IJLCheck(ijlFree(@jcprops));
 end;
end;

procedure SaveBmpToJpegStream(Bitmap:TBitmap;Stream: TMemoryStream; const Quality:integer);
var
 jcprops:TJPEG_CORE_PROPERTIES;
 DIB: TDIBSection;
begin
 FillChar(jcprops, SizeOf (jcprops), 0);
 IJLCheck(ijlInit(@jcprops));
 try
   with jcprops do
   begin
     case bitmap.PixelFormat of
       pf8bit:
       begin
         DIBChannels:=1;
         DIBColor:=IJL_G;
       end;
       pf24bit:
       begin
         DIBChannels:=3;
         DIBColor:=IJL_BGR;
       end;
       else raise EIJLException.Create('Cannot save bitmap as JPEG with specified PixelFormat');
     end;
     FillChar(DIB, SizeOf(DIB), 0);
     Win32Check(GetObject(Bitmap.Handle, SizeOf(DIB),@DIB)<>0);
     DIBBytes:= PByte(DIB.dsBm.bmBits);
     DIBWidth  := DIB.dsBm.bmWidth;
     DIBHeight :=-DIB.dsBm.bmHeight;
     DIBPadBytes:=((DIBWidth*DIBChannels+3) and -$04)-(DIBWidth*DIBChannels);
     
     Stream.Size:= Abs(DIBHeight*DIBWidth*DIBChannels);
     JPGBytes := Stream.Memory;
     JPGSizeBytes := Stream.Size;

     JPGWidth := DIBWidth;
     JPGHeight:= -DIBHeight;
     JPGChannels:=3;
     JPGColor := IJL_YCBCR;
     jquality := quality;
   end;
   IJLCheck(ijlWrite(@jcprops, IJL_JBUFF_WRITEWHOLEIMAGE));
   Stream.Size:=jcprops.JPGSizeBytes;
 finally
   IJLCheck(ijlFree(@jcprops));
 end;
end;

const
 ScaleMul:array[TIJLScale] of DWORD=(1,2,4,8);

procedure LoadBmpFromJpegFile(Bitmap:TBitmap;const FileName:string;
 const SetPixelFormat:boolean=true; const Scale:TIJLScale=ijlFull);
const
 ScaleFileIOType:array[TIJLScale] of TIJLIOTYPE=(IJL_JFILE_READWHOLEIMAGE,IJL_JFILE_READONEHALF,IJL_JFILE_READONEQUAR TER,IJL_JFILE_READONEEIGHTH);
var
 jcprops: TJPEG_CORE_PROPERTIES;
 DIB: TDIBSection;
begin
 if not Assigned (Bitmap) then Exit;

 FillChar(jcprops,SizeOf(jcprops),0);
 IJLCheck(ijlInit(@jcprops));
 try
   jcprops.JPGFile:=PChar(FileName);
   IJLCheck(ijlRead(@jcprops, IJL_JFILE_READPARAMS));

   if (jcprops.JPGChannels<>1) and (jcprops.JPGChannels<>3) then
     raise EIJLException.CreateFmt('Cannot load JPEG with %d Channels',[jcprops.JPGChannels]);

   Bitmap.Width:=0;
   Bitmap.Height:=0;

   if SetPixelFormat then
   begin
     jcprops.DIBChannels:=jcprops.JPGChannels;
     if jcprops.DIBChannels=1 then
       Bitmap.PixelFormat:= pf8Bit
     else
       Bitmap.PixelFormat:= pf24Bit;
   end else
   begin
     case Bitmap.PixelFormat of
       pf8Bit:  jcprops.DIBChannels:= 1;
       pf24Bit: jcprops.DIBChannels:= 3;
       else raise EIJLException.Create('Cannot load in bitmap with specified PixelFormat');
     end;
   end;
   if jcprops.DIBChannels=1 then
     jcprops.DIBColor:= IJL_G
   else
     jcprops.DIBColor:= IJL_BGR;

   Bitmap.Width :=(jcprops.JPGWidth + ScaleMul[Scale]-1) div ScaleMul[Scale];
   Bitmap.Height:=(jcprops.JPGHeight+ ScaleMul[Scale]-1) div ScaleMul[Scale];

   FillChar(DIB, SizeOf (DIB), 0);
   Win32Check(GetObject(Bitmap.Handle, SizeOf(DIB),@DIB)<>0);
   jcprops.DIBBytes := PByte(DIB.dsBm.bmBits);
   jcprops.DIBWidth := DIB.dsBm.bmWidth;
   jcprops.DIBHeight:= -DIB.dsBm.bmHeight;
   jcprops.DIBPadBytes:=((jcprops.DIBWidth*jcprops.DIBChannels+3) and -$04)-(jcprops.DIBWidth*jcprops.DIBChannels);

   IJLCheck(ijlRead(@jcprops, ScaleFileIOType[Scale]));
 finally
   IJLCheck(ijlFree(@jcprops));
 end;
 Bitmap.Modified:=True;
end;

procedure LoadBmpFromJpegStream(bitmap: TBitmap;  Stream:TMemoryStream;
 const SetPixelFormat:boolean=true; const Scale:TIJLScale=ijlFull);
const
 ScaleBuffIOType:array[TIJLScale] of TIJLIOTYPE=(IJL_JBUFF_READWHOLEIMAGE,IJL_JBUFF_READONEHALF,IJL_JBUFF_READONEQUAR TER,IJL_JBUFF_READONEEIGHTH);
var
 jcprops: TJPEG_CORE_PROPERTIES;
 DIB: TDIBSection;
begin
 if not Assigned (Bitmap) then Exit;

 FillChar(jcprops,SizeOf(jcprops),0);
 IJLCheck(ijlInit(@jcprops));
 try
   jcprops.JPGBytes := PByte(Stream.Memory);

   jcprops.JPGSizeBytes:= Stream.Size;
   IJLCheck(ijlRead(@jcprops, IJL_JBUFF_READPARAMS));

   if (jcprops.JPGChannels<>1) and (jcprops.JPGChannels<>3) then
     raise EIJLException.CreateFmt('Cannot load JPEG with %d Channels',[jcprops.JPGChannels]);

   Bitmap.Width:=0;
   Bitmap.Height:=0;

   if SetPixelFormat then
   begin
     jcprops.DIBChannels:=jcprops.JPGChannels;
     if jcprops.DIBChannels=1 then
       Bitmap.PixelFormat:= pf8Bit
     else
       Bitmap.PixelFormat:= pf24Bit;
   end else
   begin
     case Bitmap.PixelFormat of
       pf8Bit:  jcprops.DIBChannels:= 1;
       pf24Bit: jcprops.DIBChannels:= 3;
       else raise EIJLException.Create('Cannot load in bitmap with specified PixelFormat');
     end;
   end;
   if jcprops.DIBChannels=1 then
     jcprops.DIBColor:= IJL_G
   else
     jcprops.DIBColor:= IJL_BGR;

   Bitmap.Width :=(jcprops.JPGWidth + ScaleMul[Scale]-1) div ScaleMul[Scale];
   Bitmap.Height:=(jcprops.JPGHeight+ ScaleMul[Scale]-1) div ScaleMul[Scale];

   FillChar(DIB, SizeOf (DIB), 0);
   Win32Check(GetObject(Bitmap.Handle, SizeOf(DIB),@DIB)<>0);
   jcprops.DIBBytes := PByte(DIB.dsBm.bmBits);
   jcprops.DIBWidth := DIB.dsBm.bmWidth;
   jcprops.DIBHeight:= -DIB.dsBm.bmHeight;
   jcprops.DIBPadBytes:=((jcprops.DIBWidth*jcprops.DIBChannels+3) and -$04)-(jcprops.DIBWidth*jcprops.DIBChannels);

   IJLCheck(ijlRead(@jcprops, ScaleBuffIOType[Scale]));
 finally
   IJLCheck(ijlFree(@jcprops));
 end;
 Bitmap.Modified:=True;
end;

end.