Question

我正试图从客户端拍摄实时屏幕截图。

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

EJPEG，消息“JPEG错误＃53”

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

如何在保存/显示之前验证流？

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

是在 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，以便将流大小读为{{ 1}}：

Int64

这将使Indy的负担始终如一地发送和接收流，而不是您尝试手动执行。

现在，说到这一点，你的代码更重要的问题是你的TMyContext(Ctx).Connection.IOHandler.LargeStream := True; TMyContext(Ctx).Connection.IOHandler.ReadStream(PicStream, -1, False);函数显然在一个工作线程中运行，但它实际上并不是线程安全的。具体而言，您在访问ScreenRecord()或致电lvMain.Selected时未与主UI线程同步。这本身就可能导致JPG错误。无法在主UI线程之外安全地访问VCL / FMX UI控件，您必须同步对它们的访问。

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

尝试更像这样的事情：

客户端

OnExecute

服务器端

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;

现在，为此，为了更好地优化您的协议，我建议您在准备开始接收图像时（在ListView中选择客户端时）仅发送一次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中取消选择客户端时），仅执行一次{1}}命令。让客户端在收到RecordScreen后发送连续的图像流，直到收到RecordScreenDone或客户端断开连接。

这样的事情：

客户端

ReccordScreen

服务器端

RecordScreenDone

Delphi - Indy流验证

1 个答案: