Delphi

Question

我正在尝试从客户端获取实时屏幕截图。

服务器端的 TImage imgScreen 引发此错误。

EJPEG with message 'JPEG error #53'

我有 google 它并发现此错误是由于内存不足 - 图像已损坏。

如何在 save/display 之前验证流？

使服务器接收损坏的流的原因是什么？

是在JpegStream.Size和IOHandler.ReadInt64方法中。

这是代码。

客户端

 if List[0] = 'RecordScreen' then
  begin
    pic := TBitmap.Create;
    JpegStream := TMemoryStream.Create;
    ScreenShot(0,0,pic);

    BMPtoJPGStream(pic, JpegStream);
    pic.FreeImage;
    FreeAndNil(pic);

    AConn.Client.IOHandler.Write(JpegStream.Size);
    AConn.Client.IOHandler.Write(JpegStream);
    FreeAndNil(JpegStream);
  end;

服务器端

procedure ScreenRecord(const Item: TListItem);
var
  Ctx: TIdContext;
  List: TIdContextList;
  Dir,PicName:string;
  PicStream : TFileStream;
  Size : Int64;
begin
  if (Item = nil) then Exit;
  Ctx := TIdContext(Item.Data);
  if (Ctx = nil) then Exit;
  Dir := IncludeTrailingBackslash(TMyContext(Ctx).ClinetDir+ScreenshotsDir);
  if not DirectoryExists(Dir) then
  CreateDir(Dir);

  PicName := Dir+'Screen-'+DateTimeToFilename+'.JPG';

  PicStream := TFileStream.Create(PicName,fmCreate);
  try
    List := MainForm.idtcpsrvrMain.Contexts.LockList;
    try
      if List.IndexOf(Ctx) <> -1 then
      Begin
        TMyContext(Ctx).Queue.Add('RecordScreen');
        Size := TMyContext(Ctx).Connection.IOHandler.ReadInt64();
        TMyContext(Ctx).Connection.IOHandler.ReadStream(PicStream,Size,False);
        FreeAndNil(PicStream);
        TMyContext(Ctx).Connection.IOHandler.WriteLn('RecordScreenDone');
        fScreenRecord.imgScreen.Picture.LoadFromFile(PicName);
        end;
    finally
      MainForm.idtcpsrvrMain.Contexts.UnlockList;
    end;
  except
  end;
end;

procedure TScreenRecord.Execute;
begin
  FreeOnTerminate := True;
  IsThreadWorking := True;
  while NOT Terminated do
  Begin
    ScreenRecord(MainForm.lvMain.Selected);
    Sleep(50);
    if KillThread then
    Terminate;
  End;
end;

Answer 1

我真的不能确定为什么你会收到 JPG 错误。但是您显示的代码中存在一些逻辑问题。

虽然不是真正的问题，但也没有必要分别调用TIdIOHandler.Write(Int64)和TIdIOHandler.Write(TStream)。后者可以为您发送流大小。只需将其 AWriteByteCount 参数设置为 True，并确保将 TIdIOHandler.LargeStream 属性设置为 True，这样它将以 Int64:

形式发送字节数

AConn.Client.IOHandler.LargeStream := True;
AConn.Client.IOHandler.Write(JpegStream, 0, True);

同样，您也不需要分别调用 TIdIOHandler.ReadInt64() 和 TIdIOHandler.ReadStream()。后者可以为您读取流大小。只需将其 AByteCount 参数设置为 -1 并将其 AReadUntilDisconnect 参数设置为 False（无论如何这些都是默认值），然后将 TIdIOHandler.LargeStream 设置为 True 以便它读取流大小作为 Int64:

TMyContext(Ctx).Connection.IOHandler.LargeStream := True;
TMyContext(Ctx).Connection.IOHandler.ReadStream(PicStream, -1, False);

这会给 Indy 带来持续发送和接收流的负担，而不是您尝试手动完成。

现在，话虽如此，您的代码更重要的问题是您的 ScreenRecord() 函数显然运行在工作线程中，但它实际上不是线程安全的。具体来说，在访问 lvMain.Selected 或调用 Picture.LoadFromFile() 时，您没有与主 UI 线程同步。这本身就可能导致 JPG 错误。 VCL/FMX UI 无法在主 UI 线程之外安全地访问控件，您必须同步对它们的访问。

实际上，您的流读取逻辑确实属于 TIdTCPServer.OnExecute 事件。在这种情况下，您可以完全消除 TScreenRecord 线程（因为 TIdTCPServer 已经是多线程的）。当用户选择一个新的列表项时，在相应的 TMyContext 中设置一个标志（并清除先前选择的项目中的标志，如果有的话）。每当在给定连接上设置该标志时，让 OnExecute 事件处理程序 request/receive 成为一个流。

试试像这样的东西：

客户端

if List[0] = 'RecordScreen' then
begin
  JpegStream := TMemoryStream.Create;
  try
    pic := TBitmap.Create;
    try
      ScreenShot(0,0,pic);
      BMPtoJPGStream(pic, JpegStream);
    finally
      pic.Free;
    end;
    AConn.Client.IOHandler.LargeStream := True;
    AConn.Client.IOHandler.Write(JpegStream, 0, True);
  finally
    JpegStream.Free;
  end;
end;

服务器端

type
  TMyContext = class(TIdServerContext)
  public
    //...
    RecordScreen: Boolean;
  end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  idtcpsrvrMain.ContextClass := TMyContext;
  //...
end;

var
  SelectedItem: TListItem = nil;

procedure TMainForm.lvMainChange(Sender: TObject; Item: TListItem; Change: TItemChange);
var
  List: TList;
  Ctx: TMyContext;
begin
  if Change <> ctState then
    Exit;

  List := idtcpsrvrMain.Contexts.LockList;
  try
    if (SelectedItem <> nil) and (not SelectedItem.Selected) then
    begin
      Ctx := TMyContext(SelectedItem.Data);
      if List.IndexOf(Ctx) <> -1 then
        Ctx.RecordScreen := False;
      SelectedItem := nil;
    end;
    if Item.Selected then
    begin
      SelectedItem := Item;
      Ctx := TMyContext(SelectedItem.Data);
      if List.IndexOf(Ctx) <> -1 then
        Ctx.RecordScreen := True;
    end;
  finally
    idtcpsrvrMain.Contexts.UnlockList;
  end;
end;

procedure TMainForm.idtcpsrvrMainConnect(AContext: TIdContext);
begin
  //...
  TThread.Queue(nil,
    procedure
    var
      Item: TListItem;
    begin
      Item := lvMain.Items.Add;
      Item.Data := AContext;
      //...
    end
  );
end;

procedure TMainForm.idtcpsrvrMainDisconnect(AContext: TIdContext);
begin
  TThread.Queue(nil,
    procedure
    var
      Item: TListItem;
    begin
      Item := lvMain.FindData(0, AContext, True, False);
      if Item <> nil then Item.Delete;
    end
  );
end;

procedure TMainForm.idtcpsrvrMainExecute(AContext: TIdContext);
var
  Dir, PicName: string;
  PicStream: TMemoryStream;
  Ctx: TMyContext;
begin
  Ctx := TMyContext(AContext);
  Sleep(50);

  if not Ctx.RecordScreen then
    Exit;

  PicStream := TMemoryStream.Create;
  try
    AContext.Connection.IOHandler.WriteLn('RecordScreen');
    AContext.Connection.IOHandler.LargeStream := True;
    AContext.Connection.IOHandler.ReadStream(PicStream, -1, False);
    AContext.Connection.IOHandler.WriteLn('RecordScreenDone');

    if not Ctx.RecordScreen then
      Exit;

    try
      Dir := IncludeTrailingBackslash(Ctx.ClinetDir + ScreenshotsDir);
      ForceDirectories(Dir);
      PicName := Dir + 'Screen-' + DateTimeToFilename + '.JPG';
      PicStream.SaveToFile(PicName);
      TThread.Queue(nil,
        procedure
        begin
          fScreenRecord.imgScreen.Picture.LoadFromFile(PicName);
        end;
      );
    except
    end;
  finally
    PicStream.Free;
  end;
end;

现在，话虽如此，为了更好地优化您的协议，我建议您只在准备好开始接收图像时（在 ListView 中选择客户端时）发送一次 RecordScreen 命令并发送RecordScreenDone 命令仅在您准备好停止接收图像时执行一次（当客户端在 ListView 中未被选中时）。让客户端在收到 ReccordScreen 时发送连续的图像流，直到收到 RecordScreenDone 或客户端断开连接。

像这样：

客户端

if List[0] = 'RecordScreen' then
begin
  // Start a short timer...
end
else if List[0] = 'RecordScreenDone' then
begin
  // stop the timer...
end;

...

procedure TimerElapsed;
var
  JpegStream: TMemoryStream;
  pic: TBitmap;
begin
  JpegStream := TMemoryStream.Create;
  try
    pic := TBitmap.Create;
    try
      ScreenShot(0,0,pic);
      BMPtoJPGStream(pic, JpegStream);
    finally
      pic.Free;
    end;
    try
      AConn.Client.IOHandler.LargeStream := True;
      AConn.Client.IOHandler.Write(JpegStream, 0, True);
    except
      // stop the timer...
    end;
  finally
    JpegStream.Free;
  end;

服务器端

type
  TMyContext = class(TIdServerContext)
  public
    //...
    RecordScreen: Boolean;
    IsRecording: Boolean;
  end;

procedure TMainForm.idtcpsrvrMainExecute(AContext: TIdContext);
var
  Dir, PicName: string;
  PicStream: TMemoryStream;
  Ctx: TMyContext;
begin
  Ctx := TMyContext(AContext);
  Sleep(50);

  if not Ctx.RecordScreen then
  begin
    if Ctx.IsRecording then
    begin
      AContext.Connection.IOHandler.WriteLn('RecordScreenDone');
      Ctx.IsRecording := False;
    end;
    Exit;
  end;

  if not Ctx.IsRecording then
  begin
    AContext.Connection.IOHandler.WriteLn('RecordScreen');
    Ctx.IsRecording := True;
  end;

  PicStream := TMemoryStream.Create;
  try
    AContext.Connection.IOHandler.LargeStream := True;
    AContext.Connection.IOHandler.ReadStream(PicStream, -1, False);

    if not Ctx.RecordScreen then
    begin
      AContext.Connection.IOHandler.WriteLn('RecordScreenDone');
      Ctx.IsRecording := False;
      Exit;
    end;

    try
      Dir := IncludeTrailingBackslash(Ctx.ClinetDir + ScreenshotsDir);
      ForceDirectories(Dir);
      PicName := Dir + 'Screen-' + DateTimeToFilename + '.JPG';
      PicStream.SaveToFile(PicName);
      TThread.Queue(nil,
        procedure
        begin
          fScreenRecord.imgScreen.Picture.LoadFromFile(PicName);
        end;
      );
    except
    end;
  finally
    PicStream.Free;
  end;
end;

Delphi - Indy 流验证

Delphi - Indy stream validation

indy