0

I'm trying to get a screenshot and send it over the web using ClientSocket and ServerSocket components.

I'm having problems when I try to turn the stream received at ServerSocket into a picture again. Error message "Bitmap Image is not valid!" when performing: DesktopForm.imgScreen.Picture.Bitmap.LoadFromStream(ms);

I do not know if the problem is in the way sending the image or get in the way.

My server code:

unit UntThreadDesktop;

interface

uses
  System.Classes,
  System.SysUtils,
  System.Win.ScktComp,
  WinApi.Windows,
  WinApi.ActiveX,
  Vcl.Graphics,
  Vcl.Imaging.Jpeg,
  UntDesktopForm;

type
  TThreadDesktop = class(TThread)
  private
    FSocket: TCustomWinSocket;
    FDesktopForm: TDesktopForm;
  public
    constructor Create(ASocket: TCustomWinSocket);
    destructor Destroy; override;
    procedure Execute; override;
  end;

implementation

uses
  UntLibraries;

{ TThreadDesktop }

constructor TThreadDesktop.Create(ASocket: TCustomWinSocket);
begin
  inherited Create(true);
  FreeOnTerminate := true;
  FSocket := ASocket;
end;

destructor TThreadDesktop.Destroy;
begin
  inherited;
end;

procedure TThreadDesktop.Execute;
var
  text: string;
  fileSize: integer;
  ms: TMemoryStream;
  buf: Pointer;
  nBytes: integer;
  jpg: TJPEGImage;
begin
  inherited;
  CoInitialize(nil);
  try

    // Init DesktopForm
    Synchronize(procedure  begin
      FDesktopForm := TDesktopForm.Create;
      FDesktopForm.Show;
    end);

    ms := TMemoryStream.Create;

    try

      FSocket.SendText('<|GetScreen|>');
      while FSocket.Connected and (not Self.Terminated) and (FDesktopForm <> nil) do
      begin

        if FSocket.ReceiveLength > 0 then
        begin

          ms.Clear;

          text := string(FSocket.ReceiveText);
          text := Copy(text,1, Pos(#0,text)-1);
          fileSize := StrToInt(text);

          // Receiving file
          while FSocket.Connected and (not Self.Terminated) and (FDesktopForm <> nil) do
          begin
            Synchronize(procedure begin
              if FDesktopForm <> nil then
                FDesktopForm.panInfo.Caption := 'Total: ' + IntToStr(ms.Size) +
                ' de ' + IntToStr(fileSize);
            end);

            try
              text := '';
              GetMem(buf, FSocket.ReceiveLength);
              try
                nBytes := FSocket.ReceiveBuf(buf^, FSocket.ReceiveLength);
                if nBytes > 0 then
                  ms.Write(buf^, nBytes);
                if (ms.Size = fileSize) or (nBytes <= 0) then
                begin
                  ms.Position := 0;
                  ms.SaveToFile('C:\Temp\Screen.bmp');
                  ms.Position := 0;
                  //jpg := TJPEGImage.Create;
                  //jpg.LoadFromStream(ms);
                  // Carrega a imagem
                  Synchronize(procedure begin
                    if FDesktopForm <> nil then
                      //FDesktopForm.imgScreen.Picture.Assign(jpg);
                      FDesktopForm.imgScreen.Picture.Graphic.LoadFromStream(ms);
                  end);
                end;
              finally
                FreeMem(buf);
              end;
            except
            end;
          end;

        end;

        TThread.Sleep(10);
      end;

    finally
      ms.Free;

      // Close DesktopForm
      Synchronize(procedure begin
        if FDesktopForm <> nil then
          FDesktopForm.Close;
      end);
    end;

  finally
    CoUninitialize;
  end;
end;

end.

It´s a thread used to receive the image in background.

In the main form of my application server I own a TServerSocket component working with the ServerType property to stThreadBlocking.

In my client application I have TClientSocket component using the property ClientType as ctNonBlocking.

My thread code:

unit UntThreadDesktopClient;

interface

uses
  System.Classes,
  System.SysUtils,
  System.Win.ScktComp,
  WinApi.Windows,
  WinApi.ActiveX,
  Vcl.Imaging.Jpeg,
  Vcl.Graphics,
  Vcl.Forms;

type
  TThreadDesktopClient = class(TThread)
  private
    FSocket: TClientSocket;
    FStream: TMemoryStream;
  public
    constructor Create(AHostname: string; APort: integer); reintroduce;
    destructor Destroy; override;
    procedure Execute; override;
  private
    procedure OnConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure GetScreen(stream: TMemoryStream);
  end;

implementation

{ TThreadDesktopClient }

constructor TThreadDesktopClient.Create(AHostname: string; APort: integer);
begin
  inherited Create(true);
  FreeOnTerminate := true;

  FStream := TMemoryStream.Create;

  FSocket := TClientSocket.Create(nil);
  FSocket.ClientType := ctNonBlocking;
  FSocket.Host := AHostname;
  FSocket.Port := APort;
  FSocket.OnConnect := OnConnect;
  FSocket.Open;
end;

destructor TThreadDesktopClient.Destroy;
begin
  FStream.Free;
  if FSocket.Active then
    FSocket.Close;
  FSocket.Free;
  inherited;
end;

procedure TThreadDesktopClient.Execute;
var
  cmd: AnsiString;
begin
  inherited;
  CoInitialize(nil);
  try
    while FSocket.Active and not Self.Terminated do
    begin
      if FSocket.Socket.ReceiveLength > 0 then
      begin
        cmd := FSocket.Socket.ReceiveText;
        if cmd = '<|GetScreen|>' then
        begin
          FStream.Clear;
          GetScreen(FStream);
          FStream.Position := 0;
          FSocket.Socket.SendText(AnsiString(IntToStr(FStream.Size)) + #0);
          FSocket.Socket.SendStream(FStream);
        end
        else
        if cmd = '<|TYPE|>' then
        begin
          FSocket.Socket.SendText('<|TYPE-DESKTOP|>');
        end;
      end;
    end;
  finally
    CoUninitialize;
  end;
end;

procedure TThreadDesktopClient.OnConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Start;
end;

procedure TThreadDesktopClient.GetScreen(stream: TMemoryStream);
var
  DC: HDC;
  bmp: TBitmap;
  jpg: TJPEGImage;
begin
  DC := GetDC(GetDesktopWindow);
  try
    bmp := TBitmap.Create;
    jpg := TJPEGImage.Create;
    try
      //bmp.PixelFormat := pf8bit;
      bmp.Width := GetDeviceCaps(DC, HORZRES);
      bmp.Height := GetDeviceCaps(DC, VERTRES);
      //bmp.Width := Screen.Width;
      //bmp.Height := Screen.Height;
      BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, DC, 0, 0, SRCCOPY);
      bmp.Modified := True;
      //jpg.Assign(bmp);
      //jpg.Compress;
      stream.Clear;
      //jpg.SaveToStream(stream);
      bmp.SaveToStream(stream);
    finally
      bmp.Free;
      jpg.Free;
    end;
  finally
    ReleaseDC(GetDesktopWindow, DC);
  end;
end;

end.

For further clarification, I will also post my main thread of the client application and how it is called in the main form from my client application.

unit UntThreadMain;

interface

uses
  System.Classes,
  System.Win.ScktComp,
  WinApi.ActiveX;

type
  TThreadMain = class(TThread)
  private
    FClientSocket: TClientSocket;
  public
    constructor Create(AHostname: string; APort: integer); reintroduce;
    destructor Destroy; override;
    procedure Execute; override;
  public
    procedure OnConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  private
    procedure SendInfo;
    procedure OpenDesktopChannel;
  end;

implementation

uses
  UntClientMainForm,
  UntThreadDesktopClient;

{ TThreadMain }

constructor TThreadMain.Create(AHostname: string; APort: integer);
begin
  inherited Create(true);
  FreeOnTerminate := false;
  FClientSocket := TClientSocket.Create(nil);
  FClientSocket.ClientType := ctNonBlocking;
  FClientSocket.Host := AHostname;
  FClientSocket.Port := APort;
  FClientSocket.OnConnect := OnConnect;
  FClientSocket.OnDisconnect := OnDisconnect;
  FClientSocket.Open;
end;

destructor TThreadMain.Destroy;
begin
  if FClientSocket.Active then
    FClientSocket.Close;
  FClientSocket.Free;
  inherited;
end;

procedure TThreadMain.Execute;
var
  cmd: AnsiString;
begin
  inherited;
  CoInitialize(nil);
  try
    while FClientSocket.Socket.Connected and not Self.Terminated do
    begin
      if FClientSocket.Socket.ReceiveLength > 0 then
      begin
        cmd := FClientSocket.Socket.ReceiveText;
        if cmd = '<|TYPE|>' then
          FClientSocket.Socket.SendText('<|TYPE-COMMAND|>')
        else
        if cmd = '<|INFO|>' then
          SendInfo
        else
        if cmd = '<|REQUEST-DESKTOP|>' then
          TThreadDesktopClient.Create(FClientSocket.Host, FClientSocket.Port);
      end;
    end;
  finally
    CoUninitialize;
  end;
end;

procedure TThreadMain.OnConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Start;
  Synchronize(procedure
  begin
    ClientMainForm.stBar.Panels[1].Text := 'Conectado';
    ClientMainForm.btnConectar.Caption := 'Desconectar';
  end);
end;

procedure TThreadMain.OnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Synchronize(procedure
  begin
    ClientMainForm.stBar.Panels[1].Text := 'Desconectado';
    ClientMainForm.btnConectar.Caption := 'Conectar';
  end);
end;

procedure TThreadMain.OnError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ErrorCode := 0;
end;

procedure TThreadMain.SendInfo;
var
  cmd: AnsiString;
begin
  cmd := '<|INFO|>;NomePC=Tiago-PC;SO=Windows Seven Professiona 64-bit;' +
    'CPU=Intel Core i7 3ª Geração';
  FClientSocket.Socket.SendText(cmd);
end;

end.

Note that this thread calls the TThreadDesktopClient.

In the main form of the application server, where the TServerSocket, got OnGetThread TServerSocket the method this way:

procedure TMainForm.ServerSocketGetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
  SocketThread := TThreadController.Create(false, ClientSocket);
end;

When an image is requested:

procedure TMainForm.pmiAcessarClick(Sender: TObject);
var
  nI: integer;
begin
  for nI := 0 to Pred(ServerSocket.Socket.ActiveConnections) do
  begin
    if ServerSocket.Socket.Connections[nI].SocketHandle = cdsClientesId.AsInteger then
      ServerSocket.Socket.Connections[nI].SendText('<|REQUEST-DESKTOP|>');
  end;
end;

Returning to my client application, this code is used to connect in server (TServerSocket).

procedure TClientMainForm.btnConectarClick(Sender: TObject);
begin
  if FThreadMain = nil then
  begin
    FThreadMain := TThreadMain.Create('localhost', 6550);
  end
  else
  begin
    FThreadMain.Terminate;
    FThreadMain.Free;
    FThreadMain := nil;
  end;
end;

So, this is all my code.
When an image is received, I try to load it on TImage get the error message: "Bitmap Image is not valid."

I've tried a few different ways to treat the stream sent by the client application. But it still fails.
Usually got the same error: "Bitmap Image is not valid."

Jan Doggen
  • 8,799
  • 13
  • 70
  • 144
  • 1
    Have you tried saving the server side stream to a disk file instead, and checking the file header to see if it's a valid bitmap? – Ken White Nov 29 '13 at 21:17
  • Yes, I tested this, and the image is corrupted. And, I see that the size of the stream that i sended is 5184054, but i received only 5175870. You know why this happen ?! –  Nov 29 '13 at 21:56
  • Why have you threaded off the client and then set the socket to non-blocking? – Martin James Nov 30 '13 at 08:00
  • Is `imgScreen` the right component for the type of image your are trying to open? If `imgScreen` is a `TImage`, then it can only load bitmap images (e.g., no JPGs, no PNGs, etc), at least not from a stream. Opening from a file is more dynamic. Once you verify the image data is transferring correctly, you should look at these posts to see how to open various image types from a stream: http://stackoverflow.com/questions/17208785/tbitmap32-loadfromstream-auto-recognize-image-format/20084737 and http://stackoverflow.com/questions/959160/load-jpg-gif-bitmap-and-convert-to-bitmap/20084460 – James L. Nov 30 '13 at 08:18
  • Hello James! imgScreen is a TImage yes, and I sending a bitmap. But now I'm checking if I am transferring the data correctly, and I've had some success trying other forms of receipt. I tried an adaptation using the example of receiving this post: http://edn.embarcadero.com/article/26693 I'm still running tests. –  Nov 30 '13 at 16:31
  • Hello Martin James! I was really trying to get the maximum facilities with TClientSocket. For example: get feedback on the server side and the client side when either disconnects. –  Nov 30 '13 at 16:32
  • The interesting thing is that now the TClientSocket is not accepting connect with SocketType as ctNonBlocking, only in ctBlocking. Is like a box of surprises. So, o adaptation of example in this link edn.embarcadero.com/article/26693 I'm having a transfer very slow. Thanks –  Nov 30 '13 at 16:40
  • Fixing: What is slow is the rendering of the image by imgScreen (TImage). –  Nov 30 '13 at 16:55
  • 1
    There are a LOT of problems with this code, ranging from a fundamental lack of understanding of how TClientSocket and TServerSocket actually work in general, to improper send/receive/parsing of commands over TCP/IP, to missing synchronization between worker threads and the main thread when accessing UI components. I see very few things in this code that are correct. – Remy Lebeau Dec 01 '13 at 00:27
  • Yes, really, I do not understand the functioning of TServerSocket and TClientSocket components. I tried to follow examples found on the web. I tried to work with ctNonBlocking only by trial, I can modify this, and I can remove methos OnConnect and OnDisconnect. But, my problem is in the transfer and receipt the image. Do you have a working example? In order thread would be better, thank you all! –  Dec 01 '13 at 00:59
  • Sounds like the OP is using UDP not TCP to send the data and stuff is arriving out of order/not arriving at all. – Andy_D Dec 02 '13 at 10:59

1 Answers1

3

There are a LOT of problems with the code you showed - ranging from a fundamental lack of understanding of how TClientSocket and TServerSocket actually work in general, to a lack of understanding of how to send/receive/parse over TCP/IP. I see very few things in your code that are correct.

You are creating multiple connections on the client side, making each one identify its type (command vs desktop), but your server code is not querying that type or even caring what the type is. It assumes every client is a desktop client and asks for its screen. So you can simplify your code on both sides by simply eliminating that second connection. It is not really needed anyway. You would keep your connections to a minimum to reduce overhead.

I would strongly suggest a re-write of your code.

Try something more like this instead:

Common:

unit UntSocketCommon;

uses
  System.Classes,
  System.Win.ScktComp;

interface

procedure ReadRawFromSocket(Socket: TWinSocketStream; Buf: Pointer; BufLen: Integer);
function ReadLineFromSocket(Socket: TWinSocketStream): String;
function ReadIntegerFromSocket(Socket: TWinSocketStream): Integer;
procedure ReadStreamFromSocket(Socket: TWinSocketStream; Stream: TStream);

procedure WriteRawFromSocket(Socket: TWinSocketStream; Buf: Pointer; BufLen: Integer);
procedure WriteLineToSocket(Socket: TWinSocketStream; const Value: String);
procedure WriteIntegerToSocket(Socket: TWinSocketStream; Value: Integer);
procedure WriteStreamToSocket(Socket: TWinSocketStream; Stream: TStream);

implementation

procedure ReadRawFromSocket(Socket: TWinSocketStream; Buf: Pointer; BufLen: Integer);
var
  PBuf: PByte;
  nBytesRead: Integer;
begin
  PBuf := PByte(Buf);
  while BufLen > 0 do
  begin
    nBytesRead := Socket.Read(PBuf^, BufLen);
    if nBytesRead < 1 then raise Exception.Create('Unable to read from socket');
    Inc(PBuf, nBytesRead);
    Dec(BufLen, nBytesRead);
  end;
end;

function ReadLineFromSocket(Socket: TWinSocketStream): String;
var
  Ch: AnsiChar;
  Buf: array[0..255] of AnsiChar;
  BufLen: Integer;
  S: UTF8String;

  procedure AppendBuf;
  var
    OldLen: Integer;
  begin
    OldLen := Length(S);
    SetLength(S, OldLen + BufLen);
    Move(Buf[0], S[OldLen], BufLen);
  end;

begin
  Result := '';
  BufLen := 0;
  repeat
    ReadRawFromSocket(Socket, @Ch, SizeOf(Ch));
    if Ch = #10 then Break;
    if BufLen = Length(Buf) then
    begin
      AppendBuf;
      BufLen := 0;
    end;
    Buf[BufLen] := Ch;
    Inc(BufLen);
  until False;
  if BufLen > 0 then AppendBuf;
  BufLen := Length(S);
  if BufLen > 0 then
  begin
    if S[BufLen] = #13 then
      SetLength(S, BufLen-1);
  end;
  Result := String(S);
end;

function ReadIntegerFromSocket(Socket: TWinSocketStream): Integer;
begin
  ReadRawFromSocket(Socket, @Result, SizeOf(Result));
  Result := ntohl(Result);
end;

procedure ReadStreamFromSocket(Socket: TWinSocketStream; Stream: TStream);
var
  Size: Integer;
  Buf: array[0..1023] of Byte;
  nBytes: Integer;
begin
  Size := ReadIntegerFromSocket(Socket);
  while Size > 0 do
  begin
    nBytes := Size;
    if nBytes > Length(Buf) then nBytes := Length(Buf);
    ReadRawFromSocket(Socket, Buf[0], nBytes);
    Stream.WriteBuffer(Buf[0], nBytes);
    Dec(Size, nBytes);
  end;
end;

procedure WriteRawToSocket(Socket: TWinSocketStream; Buf: Pointer; BufLen: Integer);
var
  PBuf: PByte;
  nBytesWritten: Integer;
begin
  PBuf := PByte(Buf);
  while BufLen > 0 do
  begin
    nBytesWritten := Socket.Write(PBuf^, BufLen);
    if nBytesWritten < 1 then raise Exception.Create('Unable to write to socket');
    Inc(PBuf, nBytesWritten);
    Dec(BufLen, nBytesWritten);
  end;
end;

procedure WriteLineToSocket(Socket: TWinSocketStream; const Value: String);
var
  S: UTF8String;
begin
  S := UTF8String(Value + #13#10);
  WriteRawToSocket(Socket, PAnsiChar(S), Length(S));
end;

procedure WriteIntegerToSocket(Socket: TWinSocketStream; Value: Integer);
begin
  Value := htonl(Value);
  WriteRawToSocket(Socket, @Value, SizeOf(Value));
end;

procedure WriteStreamToSocket(Socket: TWinSocketStream; Stream: TStream);
var
  Size: Integer;
  Buf: array[0..1023] of Byte;
  nBytes: Integer;
begin
  Size := Stream.Size - Stream.Position;
  WriteIntegerToSocket(Socket, Size);
  while Size > 0 do
  begin
    nBytes := Size;
    if nBytes > Length(Buf) then nBytes := Length(Buf);
    Stream.ReadBuffer(Buf[0], nBytes);
    WriteRawToSocket(Socket, Buf[0], nBytes);
    Dec(Size, nBytes);
  end;
end;

end.

Server:

unit UntThreadDesktop;

interface

uses
  System.Classes,
  System.Win.ScktComp,
  UntDesktopForm;

type
  TThreadController = class(TServerClientThread)
  private
    FDesktopForm: TDesktopForm;
  protected
    procedure ClientExecute; override;
  end;

implementation

uses
  System.SysUtils,
  WinApi.Windows,
  Vcl.Graphics,
  UntLibraries,
  UntSocketCommon;

{ TThreadDesktop }

procedure TThreadController.ClientExecute;
var
  fileSize: Integer;
  ms: TMemoryStream;
  buf: array[0..1023] of Byte;
  nBytes: Integer;
  SocketStrm: TWinSocketStream;
begin
  SocketStrm := TWinSocketStream.Create(ClientSocket, 5000);
  try
    // Init DesktopForm
    Synchronize(
      procedure
      begin
        FDesktopForm := TDesktopForm.Create;
        FDesktopForm.Show;
      end
    );

    try
      ms := TMemoryStream.Create;
      try
        while ClientSocket.Connected and (not Terminated) and (FDesktopForm <> nil) do
        begin
          ms.Clear;

          WriteLineToSocket(SocketStrm, '<|GetScreen|>');

          {
          ReadStreamFromSocket(SocketStrm, ms);
          ms.Position := 0;
          ms.SaveToFile('C:\Temp\Screen.bmp');
          ms.Position := 0;
          Synchronize(
            procedure
            begin
              if FDesktopForm <> nil then
                FDesktopForm.imgScreen.Picture.Bitmap.LoadFromStream(ms);
            end
          );
          }

          fileSize := ReadIntegerFromSocket(SocketStrm);

          while (ms.Size < fileSize) and ClientSocket.Connected and (not Terminated) and (FDesktopForm <> nil) do
          begin
            Synchronize(
            procedure
              begin
                if FDesktopForm <> nil then
                  FDesktopForm.panInfo.Caption := 'Total: ' + IntToStr(ms.Size) + ' de ' + IntToStr(fileSize);
              end
            );

            nBytes := fileSize - ms.Size;
            if nBytes > Length(Buf) then nBytes := Length(Buf);

            ReadRawFromSocket(SocketStrm, buf[0], nBytes);
            ms.WriteBuffer(buf[0], nBytes);

            if ms.Size = fileSize then
            begin
              ms.Position := 0;
              ms.SaveToFile('C:\Temp\Screen.bmp');
              ms.Position := 0;
              Synchronize(
                procedure
                begin
                  if FDesktopForm <> nil then
                    FDesktopForm.imgScreen.Picture.Bitmap.LoadFromStream(ms);
                end
              );
            end;
          end;
        end;
      finally
        ms.Free;
      end;
    finally
      Synchronize(
        procedure
        begin
          if FDesktopForm <> nil then
            FDesktopForm.Close;
        end
      );
    end;
  finally
    SocketStrm.Free;
  end;
end;

end.

procedure TMainForm.ServerSocketGetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
  SocketThread := TThreadController.Create(false, ClientSocket);
end;

Client:

unit UntThreadMain;

interface

uses
  System.Classes,
  System.Win.ScktComp;

type
  TThreadMain = class(TThread)
  private
    FClientSocket: TClientSocket;
    FSocketStrm: TWinSocketStream;
    procedure SendInfo;
    procedure SendScreen;
    procedure OnConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  protected
    procedure Execute; override;
  public
    constructor Create(AHostname: string; APort: integer); reintroduce;
    destructor Destroy; override;
  end;

implementation

uses
  System.SysUtils,
  WinApi.Windows,
  Vcl.Graphics,
  UntClientMainForm,
  UntSocketCommon;

{ TThreadMain }

constructor TThreadMain.Create(AHostname: string; APort: integer);
begin
  inherited Create(false);
  FreeOnTerminate := false;

  FClientSocket := TClientSocket.Create(nil);
  FClientSocket.ClientType := ctBlocking;
  FClientSocket.Host := AHostname;
  FClientSocket.Port := APort;
  FClientSocket.OnConnect := OnConnect;
  FClientSocket.OnDisconnect := OnDisconnect;
  FClientSocket.OnError := OnError;
end;

destructor TThreadMain.Destroy;
begin
  FClientSocket.Free;
  inherited;
end;

procedure TThreadMain.Execute;
var
  SocketStrm: TWinSocketStream;
  cmd: String;
begin
  FClientSocket.Open;
  try 
    FSocketStrm := TWinSocketStream.Create(FClientSocket.Socket, 5000);
    try
      while FClientSocket.Socket.Connected and (not Terminated) do
      begin
        if SocketStrm.WaitForData(1000) then
        begin
          cmd := ReadLineFromSocket(SocketStrm);
          if cmd = '<|INFO|>' then
          begin
            SendInfo
          end
          else if cmd = '<|GetScreen|>' then
          begin
            SendScreen;
          end
        end;
      end;
    finally
      FSocketStrm.Free;
    end;
  finally
    FClientSocket.Close;
  end;
end;

procedure TThreadMain.OnConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Synchronize(
    procedure
    begin
      ClientMainForm.stBar.Panels[1].Text := 'Conectado';
      ClientMainForm.btnConectar.Caption := 'Desconectar';
    end
  );
end;

procedure TThreadMain.OnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Synchronize(
    procedure
    begin
      ClientMainForm.stBar.Panels[1].Text := 'Desconectado';
      ClientMainForm.btnConectar.Caption := 'Conectar';
    end
  );
end;

procedure TThreadMain.OnError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ErrorCode := 0;
  Socket.Close;
end;

procedure TThreadMain.SendInfo;
var
  cmd: string;
begin
  cmd := '<|INFO|>;NomePC=Tiago-PC;SO=Windows Seven Professiona 64-bit;CPU=Intel Core i7 3ª Geração';
  WriteLineToSocket(FSocketStrm, cmd);
end;

procedure TThreadMain.SendScreen;
var
  DC: HDC;
  bmp: TBitmap;
  ms: TMemoryStream;
begin
  ms := TMemoryStream.Create;
  try
    bmp := TBitmap.Create;
    try
      DC := GetDC(0);
      try
        //bmp.PixelFormat := pf8bit;
        bmp.Width := GetDeviceCaps(DC, HORZRES);
        bmp.Height := GetDeviceCaps(DC, VERTRES);
        //bmp.Width := Screen.Width;
        //bmp.Height := Screen.Height;
        BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, DC, 0, 0, SRCCOPY);
      finally
        ReleaseDC(0, DC);
      end;
      bmp.SaveToStream(ms);
    finally
      bmp.Free;
    end;
    ms.Position := 0;
    WriteStreamToSocket(FSocketStrm, ms);
  finally
    ms.Free;
  end;
end;

end.

procedure TClientMainForm.btnConectarClick(Sender: TObject);
begin
  if FThreadMain = nil then
  begin
    FThreadMain := TThreadMain.Create('localhost', 6550);
  end else
  begin
    FThreadMain.Terminate;
    FThreadMain.WaitFor;
    FThreadMain.Free;
    FThreadMain := nil;
  end;
end;
Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770