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;