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