德尔福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;