2013-05-15 29 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()直到最近才引入匿名過程。 –

相關問題