I'm testing how get periodical screenshots of my Android smartphone and already that this server is receiving a big flux of screenshots form my device, happens that these images not appear in TImage
, i think that is because TServerSocket
(part where receives images) not is in a thread. And yes, i'm sending these screenshots correctly:
Java (Android):
bitmap = Bitmap.createBitmap(mWidth + rowPadding / pixelStride, mHeight, Bitmap.Config.ARGB_8888);
bitmap.copyPixelsFromBuffer(buffer);
ByteArrayOutputStream bos = new ByteArrayOutputStream();
bitmap.compress(Bitmap.CompressFormat.PNG, 100, bos);
byte[] array = bos.toByteArray();
DataOutputStream dos = new DataOutputStream(clientSocket.getOutputStream());
dos.writeInt(array.length);
dos.write(array, 0, array.length);
dos.flush();
And here is my Delphi code where must receive the periodical screenshots:
var
Form1: TForm1;
stSize: integer;
Stream: TMemoryStream;
Receiving: boolean;
png: TPngImage;
FSize: Integer;
writing: Boolean;
implementation
{$R *.dfm}
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
var
Item: TListItem;
begin
Item := ListView1.Items.Add;
Item.Caption := IntTostr(socket.Handle);
Item.SubItems.Add(Socket.RemoteAddress);
Item.SubItems.Add(socket.RemoteHost);
Item.Data := Socket.Data;
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
var
Item: TListItem;
begin
Item:= ListView1.FindCaption(0, inttostr(socket.Handle), false, true, false);
if item <> nil then
Item.Delete;
end;
procedure TForm1.ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
showmessage('socket erro');
ErrorCode := 0;
end;
procedure TForm1.Activate1Click(Sender: TObject);
begin
ServerSocket1.Active := true;
end;
procedure TForm1.Deactive1Click(Sender: TObject);
begin
ServerSocket1.Active := false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Stream:= TMemoryStream.Create;
writing:= False;
end;
procedure TForm1.SendMyReqst1Click(Sender: TObject);
begin
if ListView1.Selected = nil then exit;
ServerSocket1.Socket.Connections[ListView1.ItemIndex].SendText('screencapture' + #13#10);
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
BytesReceived: Longint;
CopyBuffer: Pointer;
ChunkSize: Integer;
TempSize: Integer;
const
MaxChunkSize: Longint = 8192;
begin
If FSize=0 then
begin
begin
Socket.ReceiveBuf(TempSize,SizeOf(TempSize));
TempSize := ntohl(TempSize);
Stream.SetSize(TempSize);
FSize:= TempSize
End;
End;
If (FSize>0) and not(writing) then
begin
GetMem(CopyBuffer, MaxChunkSize);
writing:= True;
While Socket.ReceiveLength>0 do
Begin
ChunkSize:= Socket.ReceiveLength;
If ChunkSize > MaxChunkSize then ChunkSize:= MaxChunkSize;
BytesReceived:= Socket.ReceiveBuf(CopyBuffer^,ChunkSize);
Stream.Write(CopyBuffer^, BytesReceived);
Dec(FSize,BytesReceived);
End;
end;
If FSize=0 then begin
Stream.Position := 0;
png:=TPngImage.Create;
png.LoadFromStream(Stream);
img1.Picture.Assign(png);
img1.Refresh;
Stream.SetSize(0);
png.Free;
FSize:= 0;
end;
FreeMem(CopyBuffer, MaxChunkSize);
Writing:= False;
end;
end.
This Delphi code above works fine, but to receive only 1 screenshot, not a big flux.
UPDATE:
this is my code base for obtain periodical screenshots on Android.
PS : See that he use a infinite loop.
The Delphi code you have shown DOES NOT correctly account for the streaming nature of TCP, or for multiple clients:
it is NOT reading FSize
correctly. More than 1 read may be needed to get all 4 bytes.
it DOES NOT use FSize
to limit the number of bytes read for the PNG stream. You need to read exactly how many bytes FSize
specifies, no more, no less. It is reading as long as the client is still sending bytes, even if they belong to subsequent messages. It needs to stop reading when it reaches the end of the stream, and then reset for the next message.
it DOES NOT handle the possibility of multiple clients sending screenshots at the same time. It is sharing variables with multiple clients, thus allowing them to corrupt each other's messages.
In short, the code is COMPLETELY broken, regardless of multi-threading. Which, BTW, is not a factor if you use the server in non-blocking mode (which the code likely is, as that is the server's default mode, and the code is not using any of the server's thread-related events).
The code does not need to be multi-threaded to work correctly. It needs to be rewritten to operate correctly.
Try something more like this:
type
TInt32Bytes = record
case Integer of
0: (Bytes: array[0..SizeOf(Int32)-1] of Byte);
1: (Value: Int32);
end;
TSocketState = (ReadingSize, ReadingStream);
TSocketData = class
public
Stream: TMemoryStream;
Png: TPngImage;
State: TSocketState;
Size: TInt32Bytes;
Offset: Integer;
constructor Create;
destructor Destroy; override;
end;
constructor TSocketData.Create;
begin
Stream := TMemoryStream.Create;
Png := TPngImage.Create;
end;
destructor TSocketData.Destroy;
begin
Stream.Free;
Png.Free;
end;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
var
Item: TListItem;
begin
Socket.Data := TSocketData.Create;
Item := ListView1.Items.Add;
Item.Data := Socket;
Item.Caption := IntToStr(Socket.Handle);
Item.SubItems.Add(Socket.RemoteAddress);
Item.SubItems.Add(Socket.RemoteHost);
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
var
Item: TListItem;
begin
Item := ListView1.FindData(0, Socket, true, false);
if Item <> nil then Item.Delete;
TSocketData(Socket.Data).Free;
end;
procedure TForm1.ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
ErrorCode := 0;
Socket.Close;
end;
procedure TForm1.Activate1Click(Sender: TObject);
begin
ServerSocket1.Active := true;
end;
procedure TForm1.Deactive1Click(Sender: TObject);
begin
ServerSocket1.Active := false;
end;
procedure TForm1.SendMyReqst1Click(Sender: TObject);
var
Index: Integer;
begin
Index := ListView1.ItemIndex;
if Index = -1 then Exit;
ServerSocket1.Socket.Connections[Index].SendText('screencapture' + #13#10);
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
BytesReceived: Integer;
BufferPtr: PByte;
SD: TSocketData;
Item: TListItem;
begin
SD := TSocketData(Socket.Data);
if SD.State = ReadingSize then
begin
while SD.Offset < SizeOf(Int32) do
begin
BytesReceived := Socket.ReceiveBuf(SD.Size.Bytes[SD.Offset], SizeOf(Int32) - SD.Offset);
if BytesReceived <= 0 then Exit;
Inc(SD.Offset, BytesReceived);
end;
SD.Size.Value := ntohl(SD.Size.Value);
SD.State := ReadingStream;
SD.Offset := 0;
SD.Stream.Size := SD.Size.Value;
end;
if SD.State = ReadingStream then
begin
if SD.Offset < SD.Size.Value then
begin
BufferPtr := PByte(SD.Stream.Memory);
Inc(BufferPtr, SD.Offset);
repeat
BytesReceive := Socket.ReceiveBuf(BufferPtr^, SD.Size.Value - SD.Offset);
if BytesReceived <= 0 then Exit;
Inc(BufferPtr, BytesReceived);
Inc(SD.Offset, BytesReceived);
until SD.Offset = SD.Size.Value;
end;
try
SD.Stream.Position := 0;
SD.Png.LoadFromStream(SD.Stream);
except
SD.Png.Assign(nil);
end;
Item := ListView1.Selected;
if (Item <> nil) and (Item.Data = Socket) then
img1.Picture.Assign(SD.Png);
SD.State := ReadingSize;
SD.Offset := 0;
end;
end;
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
if (Item <> nil) and Selected then
img1.Picture.Assign(TSocketData(TCustomWinSocket(Item.Data).Data).Png);
end;
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.