2013-05-15 27 views
0

在我解释我的问题之前,我很抱歉我的英语不好。 好的,这里是我的问题。当我的印服务器将位图帧的客户,总是出现警告这样的:为什么当发送位图帧到MemoryStream到客户端时出现警告?

“EAccessViolation地址004DD42A ......”

和错误语法蓝色高亮显示在此:

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; 

CLIENT

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; 

什么是错的难熬我的代码?我需要你的帮助。

之前谢谢你.. ^^

回答

1

您要发送的TMemoryStream甚至被创建之前。您不能在工作线程(调用OnExecute)中使用TTimerTForm。即使可以,在启用TTimer时,其OnTimer事件不会立即触发,但您的代码预计会发生。

您需要重新编写代码以将代码全部 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; 
+0

我有点困惑这个代码:类型 TLogNotify = A类(TIdNotify) 保护 程序DoNotify;覆盖; public Msg:String; 结束; –

+0

当我把这段代码放在初始声明中时,警告出现它找不到TidNotify标识符。 –

+0

'TIdNotify'位于'IdSync.pas'单元中。它是一个工具类,可以帮助工作线程异步地在主线程中运行代码,类似于'TThread.Queue()'。还有一个'TIdSync'类用于在主线程中同步运行代码,类似于TThread.Synchronize()。在大多数Delphi版本中使用'TIdNotify'和'TIdSync'的优点是能够传递数据,TThread.Queue()和TThread.Synchronize()直到最近才引入匿名过程。 –

相关问题