我无法确定您收到 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;
现在，话虽如此，为了更好地优化您的协议，我建议仅在您准备好开始接收图像时（当在 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;