Delphi 2009，IDTCPSERVER1出口时违反访问情况

Question

我刚刚开始使用线程使用Delphi 2009，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时，避免执行A 同步同步，因为这将导致僵局。使用异步同步。

尝试以下更像：

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;