Próbuję pobrać zrzut ekranu i wysłać go przez Internet przy użyciu komponentów ClientSocket i ServerSocket.

Mam problemy, gdy próbuję zmienić strumień odebrany w ServerSocket na obraz ponownie. Komunikat o błędzie „Obraz bitmapowy jest nieprawidłowy!” podczas wykonywania:DesktopForm.imgScreen.Picture.Bitmap.LoadFromStream(ms);

Nie wiem, czy problem tkwi w sposobie wysyłania obrazu czy przeszkadzania.

Mój kod serwera:

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.

Jest to wątek używany do odbierania obrazu w tle.

W głównej postaci mojego serwera aplikacji jestem właścicielem komponentu TServerSocket działającego z właściwością ServerType na stThreadBlocking.

W mojej aplikacji klienckiej mam komponent TClientSocket używający właściwości ClientType jako ctNonBlocking.

Mój kod wątku:

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.

W celu uzyskania dalszych wyjaśnień, wyślę również mój główny wątek aplikacji klienta i sposób, w jaki jest wywoływany w formularzu głównym z aplikacji klienta.

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.

Zauważ, że ten wątek wywołuje TThreadDesktopClient.

W głównej postaci serwera aplikacji, gdzie TServerSocket, dostał metodę OnGetThread TServerSocket w ten sposób:

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

Gdy żądany jest obraz:

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;

Wracając do mojej aplikacji klienckiej, ten kod jest używany do łączenia się z serwerem (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;

To wszystko jest mój kod.
Gdy obraz jest odbierany, próbuję go załadować w TImage uzyskać komunikat o błędzie: „Obraz bitmapowy jest nieprawidłowy”.

Wypróbowałem kilka różnych sposobów traktowania strumienia wysyłanego przez aplikację klienta. Ale nadal się nie udaje.
Zwykle ma ten sam błąd: „Obraz bitmapowy jest nieprawidłowy”.