Error message: "Bitmap Image is not valid" on received from Socket - delphi

Question

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."

Answer 1

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;