Estoy intentando obtener una captura de pantalla y enviarla a través de la web utilizando los componentes ClientSocket y ServerSocket.

Estoy teniendo problemas cuando intento convertir de nuevo la imagen recibida en ServerSocket en una imagen. Mensaje de error "Imagen de mapa de bits no es válida!" cuando actua:DesktopForm.imgScreen.Picture.Bitmap.LoadFromStream(ms);

No sé si el problema está en el envío de la imagen o en el camino.

Mi código de servidor:

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.

Es un hilo utilizado para recibir la imagen en segundo plano.

En la forma principal de mi servidor de aplicaciones, tengo un componente TServerSocket que trabaja con la propiedad ServerType para stThreadBlocking.

En mi aplicación cliente tengo el componente TClientSocket que usa la propiedad ClientType como ctNonBlocking.

Mi código de hilo:

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.

Para mayor aclaración, también publicaré mi hilo principal de la aplicación cliente y cómo se llama en el formulario principal desde mi aplicación cliente.

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.

Tenga en cuenta que este hilo llama al TThreadDesktopClient.

En la forma principal del servidor de aplicaciones, donde TServerSocket, obtuvo OnGetThread TServerSocket del método de esta manera:

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

Cuando se solicita una imagen:

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;

Al regresar a mi aplicación cliente, este código se usa para conectarse en el servidor (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;

Entonces, este es todo mi código.
Cuando se recibe una imagen, intento cargarla en TImage y aparece el mensaje de error: "La imagen de mapa de bits no es válida".

He intentado algunas formas diferentes de tratar la transmisión enviada por la aplicación cliente. Pero sigue fallando.
Por lo general, tiene el mismo error: "La imagen de mapa de bits no es válida".