Delphi-Indy流验证

Question

我正在尝试从客户端进行实时截屏。

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

带有消息“ JPEG错误＃53”的EJPEG

我用google搜索，发现此错误是由于内存不足-图像已损坏。

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

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

是否在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错误。 无法在主UI线程之外安全地访问VCL / FMX UI控件，您必须同步对其的访问。

实际上，您的流读取逻辑实际上属于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;

服务器端

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;

现在，随着中说，为了更好地优化您的协议，我会建议发送RecordScreen命令只有一次，当你准备好开始接收图像（当客户端在ListView被选中），并发送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;