0

在我解释我的问题之前，我很抱歉我的英语不好。好的，我的问题来了。当我的 Indy 服务器向客户端发送位图帧时，总是出现这样的警告：

“地址 004DD42A 的 EAccessViolation...”

并在此突出显示错误语法蓝色：

Athread.Connection.WriteInteger(MemoryStream.Size);

这是我的源代码：

服务器

 procedure TFormHome.TCPServerConnect(AThread: TIdPeerThread);
 var
 NewClient: PClient;
 begin
 GetMem(NewClient, SizeOf(TClient));
 NewClient.PeerIP := AThread.Connection.Socket.Binding.PeerIP;
 NewClient.HostName := GStack.WSGetHostByAddr(NewClient.PeerIP);
 NewClient.Connected := Now;
 NewClient.LastAction := NewClient.Connected;
 NewClient.Thread := AThread;

 AThread.Data := TObject(NewClient);

 try
 Clients.LockList.Add(NewClient);
 finally
 Clients.UnlockList;
 end;

 procedure TFormHome.TCPServerExecute(AThread: TIdPeerThread);
 var
 pesan:string;
 begin
 pesan:=Athread.Connection.ReadLn;
 if pesan = 'video' then
 begin
 Athread.Connection.WriteLn('send');
 Timer1.Enabled:=true;
 FormStream.Show;
 Athread.Connection.WriteInteger(MemoryStream.Size);
 Athread.Connection.OpenWriteBuffer;
 Athread.Connection.WriteStream(MemoryStream);
 AThread.Connection.CloseWriteBuffer;
 FreeAndNil(MemoryStream);
 FormStream.Image1.Picture.Bitmap.Free;
 end;

 procedure TFormHome.Timer1Timer(Sender: TObject);
 begin
 pic := TBitmap.Create;
 MemoryStream:=TMemoryStream.Create;
 VideoGrabber.GetBitmap(FormStream.image1.Picture.Bitmap);
 pic := FormStream.Image1.Picture.Bitmap;
 pic.SaveToStream(MemoryStream);
 //Pic.Free;
 //FreeAndNil(Pic);
 end;

客户

 procedure TFormClient.TCPClientConnected(Sender: TObject);
 var
 pesan : string;
 begin
 IncomingMessages.Lines.Insert(0,'Connected to Server');
 TCPClient.WriteLn('video');
 pesan := TCPClient.ReadLn;
 if pesan = 'send' then Timer1.Enabled:=true;
 end;

 procedure TFormClient.Timer1Timer(Sender: TObject);
 var
 Size : integer;
 ReadStream : TMemoryStream;
 begin
 ReadStream := TMemoryStream.Create;
 Size := TCPClient.ReadInteger;
 TCPClient.ReadStream(ReadStream,Size,True);
 Image1.Picture.Bitmap.LoadFromStream(ReadStream);
 Image1.Picture.Bitmap.Free;
 FreeAndNil(ReadStream);
 end;

我的代码有什么问题？我需要你的帮助。

之前谢谢你。。^^

4

1 回答 1

1

您正在尝试TMemoryStream在它创建之前发送它。您不能在工作线程（被调用）中使用TTimer或。即使您可以，当启用时，它的事件也不会立即触发，但您的代码期望它会触发。TFormOnExecuteTTimerOnTimer

您需要重新编写代码以将所有UI 工作委托给它所属的主线程。尝试更多类似的东西：

服务器：

Uses
  ..., IdSync;

type
  TVideoStartNotify = class(TIdNotify)
  protected
    procedure DoNotify; override;
  public
    Thread: TIdPeerThread;
  end;

procedure TFormHome.TCPServerDisconnect(AThread: TIdPeerThread);
begin
  TIdNotify.NotifyMethod(VideoStop);
end;

procedure TFormHome.TCPServerExecute(AThread: TIdPeerThread);
var
  pesan: string;
begin
  pesan := AThread.Connection.ReadLn;
  if pesan = 'videostart' then
  begin
    AThread.Connection.WriteLn('send');
    with TVideoStartNotify.Create do
    begin
      Thread := AThread;
      Notify;
    end;
  end
  else if pesan = 'videostop' then
  begin
    AThread.Connection.WriteLn('stop');
    TIdNotify.NotifyMethod(VideoStop);
  end;
end;

procedure TVideoStartNotify.DoNotify;
begin
  FormHome.VideoStart(Thread);
end;

procedure TFormHome.VideoStart(AThread: TIdPeerThread);
begin
  ThreadToSendTo := AThread;
  Timer1.Enabled := true;
  FormStream.Show;
end;

procedure TFormHome.VideoStop;
begin
  ThreadToSendTo := nil;
  Timer1.Enabled := false;
  FormStream.Hide;
end;

procedure TFormHome.Timer1Timer(Sender: TObject);
var
  pic: TBitmap;
  MemoryStream: TMemoryStream;
begin
  if ThreadToSendTo = nil then
  begin
    Timer1.Enabled := False;
    Exit;
  end;

  pic := FormStream.Image1.Picture.Bitmap;
  try
    MemoryStream := TMemoryStream.Create;
    try
      VideoGrabber.GetBitmap(pic);
      pic.SaveToStream(MemoryStream);
      try
        ThreadToSendTo.Connection.WriteStream(MemoryStream, True, True);
      except
        ThreadToSendTo := nil;
        Timer1.Enabled := False;
      end;
    finally
      MemoryStream.Free;
    end;
  finally
    FormStream.Image1.Picture := nil;
  end;
end;

客户：

Uses
  ..., IdSync;

type
  TLogNotify = class(TIdNotify) 
  protected
    procedure DoNotify; override;
  public
    Msg: String;
  end;

procedure TLogNotify.DoNotify;
begin
  FormClient.LogMsg(Msg);
end;

procedure TFormClient.Button1Click(Sender: TObject);
begin
  TCPClient.Connect;
end;

procedure TFormClient.Button2Click(Sender: TObject);
begin
  try
    TCPClient.WriteLn('videostop');
  finally
    TCPClient.Disconnect;
  end;
end;

procedure TFormClient.TCPClientConnected(Sender: TObject);
var
  pesan : string;
begin
  with TLogNotify.Create do
  begin
    Msg := 'Connected to Server';
    Notify;
  end;
  TCPClient.WriteLn('videostart');
  pesan := TCPClient.ReadLn;
  if pesan = 'send' then
    TIdNotify.NotifyMethod(VideoStart);
end;

procedure TFormClient.TCPClientDisconnected(Sender: TObject);
begin
  with TLogNotify.Create do
  begin
    Msg := 'Disconnected from Server';
    Notify;
  end;
  TIdNotify.NotifyMethod(VideoStop);
end;

procedure TFormClient.LogMsg(const AMsg: string);
begin
  IncomingMessages.Lines.Insert(0, AMsg);
end;

procedure TFormClient.VideoStart;
begin
  Timer1.Enabled := true;
end;

procedure TFormClient.VideoStop;
begin
  Timer1.Enabled := false;
  Image1.Picture := nil;
end;

procedure TFormClient.Timer1Timer(Sender: TObject);
var
  ReadStream : TMemoryStream;
begin
  ReadStream := TMemoryStream.Create;
  try
    TCPClient.ReadStream(ReadStream, -1, False);
    ReadStream.Position := 0;
    Image1.Picture.Bitmap.LoadFromStream(ReadStream);
  finally
    ReadStream.Free;
  end;
end;
于 2013-05-15T17:03:51.483 回答