德尔福 - Indy流验证

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，所以它读取数据流大小为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事件处理程序请求/接收流。

尝试更多的东西是这样的：

客户端现在

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命令o当您准备好停止接收图像时（当客户端在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;