Question

我刚刚开始使用Threads使用带有Delphi 2009的onexecute事件，indy IdTCPServer1。我写了一个非常基本的测试应用程序，并在退出时获得访问冲突。应用程序运行正常并完成我想要的所有内容，但我认为我要离开＆＃34;线程正在运行＆＃34;在退出。我对线程没有经验，所以任何帮助都会受到赞赏。

继承我的代码

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是一个多线程组件，其事件在工作线程的上下文中触发。但是，您无需与主UI线程同步即直接访问VCL UI控件（mnoLog）。不同步时会发生错误，因为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;

Delphi 2009，IdTCPServer1退出

1 个答案: