德爾福2009，IdTCPServer1訪問衝突退出

Question

我剛剛開始使用線程在Delphi 2009中使用onexecute事件，indy IdTCPServer1。我寫了一個非常基本的應用程序進行測試，並在退出時遇到訪問衝突。該應用程序運行良好，並做我想要的一切，但我認爲我離開「線程運行」退出。我沒有線程的經驗，所以任何幫助，將不勝感激。

繼承人我的代碼

unit FT_Communicator_pas; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, ScktComp, IdContext, IdTCPServer, 
    INIFiles, ExtCtrls, ComCtrls, adscnnct, 
    DB, adsdata, adsfunc, adstable, Wwdatsrc, Grids, Wwdbigrd, Wwdbgrid, 
    IdBaseComponent, IdComponent, IdCustomTCPServer; 


type 
    TfrmMain = class(TForm) 
    IdTCPServer1: TIdTCPServer; 
    PgMain: TPageControl; 
    TsMain: TTabSheet; 
    tsConfig: TTabSheet; 
    Label1: TLabel; 
    Label2: TLabel; 
    txtServer: TEdit; 
    txtPort: TEdit; 
    Panel1: TPanel; 
    Panel3: TPanel; 
    tsLog: TTabSheet; 
    mnolog: TMemo; 
    Button1: TButton; 
    Button3: TButton; 
    procedure IdTCPServer1Connect(AContext: TIdContext); 
    procedure IdTCPServer1Execute(AContext: TIdContext); 
    procedure Button3Click(Sender: TObject); 
    procedure IdTCPServer1Disconnect(AContext: TIdContext); 
    procedure Logit(const Logstr: String); 
    procedure FormShow(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    { Public declarations } 
    end; 



var 
    frmMain: TfrmMain; 

implementation 
{$R *.dfm} 

procedure TfrmMain.Button1Click(Sender: TObject); 
begin 


    IdTCPServer1.Active:=FALSE; 

    application.Terminate; 
end; 

procedure TfrmMain.Button3Click(Sender: TObject); 
begin 
    IdTCPServer1.Active:=true; 
end; 

procedure TfrmMain.FormShow(Sender: TObject); 
begin 
    PgMain.ActivePage:=tsMain; 
    EnableMenuItem(GetSystemMenu(handle, False),SC_CLOSE, MF_BYCOMMAND or MF_GRAYED); 
end; 


procedure TfrmMain.IdTCPServer1Connect(AContext: TIdContext); 
begin 
    mnoLog.lines.Add ('Connected from: ' + AContext.Connection.Socket.Binding.PeerIP); 
end; 

procedure TfrmMain.IdTCPServer1Disconnect(AContext: TIdContext); 
begin 
    mnoLog.lines.Add ('Disconnected from: ' + AContext.Connection.Socket.Binding.PeerIP); 
end; 

procedure TfrmMain.IdTCPServer1Execute(AContext: TIdContext); 
var 
    myReadln,mySendln,sqlqry:string; 
begin 


    sleep(10); 

    myReadln:=AContext.Connection.IOHandler.ReadLn(); 
    mnolog.Lines.Add(AContext.Connection.Socket.Binding.PeerIP + '>' + myReadln); 
    mySendln:= AContext.Connection.Socket.Binding.PeerIP + ' Sent me ' + myReadln; 
    AContext.Connection.IOHandler.WriteLn(mySendln); 

    try 
    except 
     on E:Exception do 
     begin 
      logit('Error occured During execute function ' + #13#10 + e.message); 
     end; 
    end; 

end; 

procedure TfrmMain.logit(const logstr:String); 
var 
    curdate,Curtime:string; 
    StrGUID:string; 
begin 
    StrGUID:=FormatDateTime('YYYYMMDDHHnnsszzz', Now())+'_ '; 
    mnolog.lines.add(StrGUID +logstr); 
end; 

end. 

Answer 1

你TIdTCPServer事件處理程序包含在其中不安全的代碼。

TIdTCPServer是一個多線程組件，它的事件在工作線程的上下文中被觸發。但是，您直接訪問VCL UI控件（mnoLog）而不與主UI線程同步。當你不同步時會發生壞事，因爲VCL不是線程安全的。從工作線程訪問UI時，必須正確同步。

當從主UI線程停用TIdTCPServer時避免執行同步同步也很重要，因爲這會導致死鎖。改爲使用異步同步。

嘗試更多的東西像下面這樣：

procedure TfrmMain.IdTCPServer1Connect(AContext: TIdContext); 
begin 
    Logit('Connected from: ' + AContext.Connection.Socket.Binding.PeerIP); 
end; 

procedure TfrmMain.IdTCPServer1Disconnect(AContext: TIdContext); 
begin 
    Logit('Disconnected from: ' + AContext.Connection.Socket.Binding.PeerIP); 
end; 

procedure TfrmMain.IdTCPServer1Execute(AContext: TIdContext); 
var 
    myReadln, mySendln, peerIP: string; 
begin 
    myReadln := AContext.Connection.IOHandler.ReadLn(); 
    peerIP := AContext.Connection.Socket.Binding.PeerIP; 
    Logit(peerIP + '>' + myReadln); 
    mySendln := peerIP + ' Sent me ' + myReadln; 
    AContext.Connection.IOHandler.WriteLn(mySendln); 
end; 

procedure TfrmMain.IdTCPServer1Exception(AContext: TIdContext; AException: Exception); 
begin 
    if not (AException is EIdConnClosedGracefully) then 
    Logit('Error occured. ' + AException.Message); 
end; 

procedure TfrmMain.Logit(const Logstr: String); 
var 
    Str: string; 
begin 
    Str := Trim(Logstr); 
    TThread.Queue(nil, 
    procedure 
    begin 
     mnolog.Lines.Add(FormatDateTime('YYYYMMDDHHnnsszzz', Now()) + ': ' + Str); 
    end 
); 
end;