multithreading - 多线程程序的输出显示不正确

Question

我写了一个程序，一直被网络困扰。它用于多线程。问题是线程输出。该计划是混合的。并且输出无法正确显示。

我编写了两个示例程序，但都不能正常工作。

程序 1

unit Unit1;

interface

uses
  Windows, Classes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdRawBase,IdRawClient, IdIcmpClient, Messages, SysUtils, Variants, Graphics, Controls, Forms,
  Dialogs,StdCtrls,ExtCtrls;

type
  TPSThread=class(TThread)
  protected
    procedure execute; override;
end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
  Procedure WndProc(var Message: TMessage); Override;
    { Public declarations }
  end;

var
  Form1: TForm1;
  PortG:Integer;
  HostG:string;
  FormG:TForm;
  WM_Msg_PS:DWORD;
implementation

{$R *.dfm}


procedure TPSThread.execute;
var
  IcmpClient:TIdIcmpClient;
  TCPClient:TIdTCPClient;
  HostT:string;
  PortT:Integer;
  ActiveServer:Boolean;
begin
  inherited;
  HostT:=HostG;
  PortT:=PortG;

  IcmpClient:= TIdIcmpClient.Create();
  try
    with IcmpClient do
    begin
      ReceiveTimeout := 5000;
      Protocol := 1;
      ProtocolIPv6 := 0;
      PacketSize := 1024;
      Host:=HostT;
    end;
    IcmpClient.Ping(HostT,Random(1024));
    if IcmpClient.ReplyStatus.BytesReceived=0 then
    begin
      SendMessage(FormG.Handle, WM_Msg_PS, Integer(HostT+'*'+IntToStr(1)+'#'), 0);
      ActiveServer:=False;
    end
    else
      ActiveServer:=True;
  finally
    IcmpClient.Free;
  end;

  if ActiveServer then
  begin
    TCPClient:=TIdTCPClient.Create(nil);
    try
      with TCPClient do
      begin
        Host:=HostT;
        Port:=PortT;
        try
          Connect;
          try
            IOHandler.WriteLn('salam');
            SendMessage(FormG.Handle, WM_Msg_PS, Integer(HostT+'*'+IntToStr(2)+'#'), 0);
          finally
            Disconnect;
          end;
        except
          SendMessage(FormG.Handle, WM_Msg_PS, Integer(HostT+'*'+IntToStr(3)+'#'), 0);
        end;
      end;
    finally
      TCPClient.Free;
    end;
  end;
end;

procedure PS_System(FormNameForMessage:TForm;HostP:string;PortP:Integer);
var
  PSThread:TPSThread;
begin
  HostG:=HostP;
  PortG:=PortP;
  FormG:=FormNameForMessage;
  PSThread:=TPSThread.Create(false);
  PSThread.FreeOnTerminate:=true;
  PSThread.Resume;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  PS_System(form1,Edit1.Text,4321);
  PS_System(form1,Edit2.Text,4321);
  PS_System(form1,Edit3.Text,4321);
  PS_System(form1,Edit4.Text,4321);
  PS_System(form1,Edit5.Text,4321);
end;

procedure TForm1.WndProc(var Message: TMessage);
var Id:byte;
    Ip:string;
begin
  if Message.Msg= WM_Msg_PS then
  begin
    Ip:=copy(String(Message.WParam),1,pos('*',String(Message.WParam))-1);
    id:=strtoint(copy(String(Message.WParam),pos('*',String(Message.WParam))+1,(pos('#',String(Message.WParam))-pos('*',String(Message.WParam))-1)));
    case id of
      1:
        begin
          Memo1.Lines.Add(' Server '+ip+' Is inactive ');
          //ShowMessage(' Server '+ip+' Is inactive ');
        end;
      2:
        begin
          Memo1.Lines.Add(' Message was sent successfully to server '+ip);
          //ShowMessage(' Message was sent successfully to server '+ip);
        end;
      3:
        begin
          Memo1.Lines.Add(' Send message to the server fails '+ip);
          //ShowMessage(' Send message to the server fails '+ip);
        end;
    end;
  end;
  inherited;
end;

end.

节目二

unit Unit1;

interface

uses
  Windows, Classes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdRawBase,IdRawClient, IdIcmpClient, Messages, SysUtils, Variants, Graphics, Controls, Forms,
  Dialogs,StdCtrls,ExtCtrls;

type
  TPSThread=class(TThread)
  protected
    procedure execute; override;
end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  PortG:Integer;
  HostG:string;
  WM_Msg_PS:DWORD;
implementation

{$R *.dfm}
procedure IsInactiveServer(M:string);
begin
  Form1.Memo1.Lines.Add(' Server '+M+' Is inactive ');
  //ShowMessage(' Server '+M+' Is inactive ');
end;

procedure SentSuccessfullyToServer(M:string);
begin
   Form1.Memo1.Lines.Add(' Message was sent successfully to server '+M);
   //ShowMessage(' Message was sent successfully to server '+M);
end;

procedure SendMessageFails(M:string);
begin
  Form1.Memo1.Lines.Add(' Send message to the server fails '+M);
  //ShowMessage(' Send message to the server fails '+M);
end;

procedure TPSThread.execute;
var
  IcmpClient:TIdIcmpClient;
  TCPClient:TIdTCPClient;
  HostT:string;
  PortT:Integer;
  ActiveServer:Boolean;
begin
  inherited;
  HostT:=HostG;
  PortT:=PortG;

  IcmpClient:= TIdIcmpClient.Create();
  try
    with IcmpClient do
    begin
      ReceiveTimeout := 5000;
      Protocol := 1;
      ProtocolIPv6 := 0;
      PacketSize := 1024;
      Host:=HostT;
    end;
    IcmpClient.Ping(HostT,Random(1024));
    if IcmpClient.ReplyStatus.BytesReceived=0 then
    begin
      IsInactiveServer(HostT);
      ActiveServer:=False;
    end
    else
      ActiveServer:=True;
  finally
    IcmpClient.Free;
  end;

  if ActiveServer then
  begin
    TCPClient:=TIdTCPClient.Create(nil);
    try
      with TCPClient do
      begin
        Host:=HostT;
        Port:=PortT;
        try
          Connect;
          try
            IOHandler.WriteLn('salam');
            SentSuccessfullyToServer(HostT);
          finally
            Disconnect;
          end;
        except
          SendMessageFails(HostT);
        end;
      end;
    finally
      TCPClient.Free;
    end;
  end;
end;

procedure PS_System(HostP:string;PortP:Integer);
var
  PSThread:TPSThread;
begin
  HostG:=HostP;
  PortG:=PortP;
  PSThread:=TPSThread.Create(false);
  PSThread.FreeOnTerminate:=true;
  PSThread.Resume;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  PS_System(Edit1.Text,4321);
  PS_System(Edit2.Text,4321);
  PS_System(Edit3.Text,4321);
  PS_System(Edit4.Text,4321);
  PS_System(Edit5.Text,4321);
end;

end.

---

谢谢 但是我的问题不是ping 我的问题是发送消息。它们还会干扰线程发送消息。如果有零件，我会删除我的 ping。还有一个额外的问题。

Answer 1

这能编译吗？TThread.Execute() 是抽象的 - 您不能在后代“TPSThread.execute”中调用“继承”。你没有从编译器得到错误吗？

将“CreateSuspended”设置为 false 创建 TPSThread 意味着线程可以“立即”运行。创建调用后设置字段可能无效。

不断地创建和销毁线程是浪费、低效且容易出错的。努力不去做。

如果您希望您的四个“PS_System”调用在不同的线程中执行网络 ping 操作（以免阻塞主线程），但按顺序，您应该将输出请求排队到一个正在等待的线程一个生产者-消费者队列来执行它们。

由于 ICMP 没有套接字层，因此在单独的线程上并行执行 ICMP 操作可能会出现问题。PING 回复可能不会返回到发出请求的同一线程。有一种解决方法——ping 有效负载可能包含请求线程 ID，并且 ICMP 组件中的“路由”层可以确定哪个等待线程做好准备。我不知道 Indy ICMP 是否已经实现了这一点。

从线程调用的帮助程序直接将文本添加到 GUI 线程。你不能那样做——你必须正确地发出信号。

多线程 PING 示例，（TCP 连接显然失败 - 我没有服务器）：

unit foPinger;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, SyncObjs,Contnrs, IdBaseComponent,
  IdComponent, IdRawBase, IdRawClient, IdIcmpClient, IdTCPConnection,
  IdTCPClient;

type

EthreadRequest=(EtcDoPing,EtcReport,EtcError,EtcSuicide);

TpingRequest=class(TObject)  // a thread comms object
  command:EthreadRequest;
  hostName:string;
  port:string;
  reportText:string;
  errorMess:string;
end;

pObject=^Tobject;

TsemaphoreMailbox=class(TobjectQueue)  // Producer-consumer queue
private
  countSema:Thandle;
protected
  access:TcriticalSection;
public
  property semaHandle:Thandle read countSema;
  constructor create; virtual;
  procedure push(aObject:Tobject); virtual;
  function pop(pResObject:pObject;timeout:DWORD):boolean;  virtual;
  function peek(pResObject:pObject):boolean;  virtual;
  destructor destroy; override;
end;

TPSThread=class(TThread)   // The thread to try the network comms
  private
    FinQueue:TsemaphoreMailbox;
    IcmpClient:TIdIcmpClient;
    TCPClient:TIdTCPClient;
    ActiveServer:Boolean;
    FmyForm:TForm;
  protected
    procedure execute; override;
  public
    constructor create(myForm:TForm;inputQueue:TsemaphoreMailbox);
    procedure postToMain(mess:TpingRequest);
    procedure postReport(text:string);
end;

  TpingerForm = class(TForm)                    // main form
    Panel1: TPanel;
    sbPing1: TSpeedButton;
    ebHostName: TEdit;
    Memo1: TMemo;
    ebPort: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    ebThreadCount: TEdit;
    Label3: TLabel;
    procedure sbPing1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ebThreadCountChange(Sender: TObject);
  private
    threadCount:integer;
    queueToThreads:TsemaphoreMailbox;
  protected
    procedure WMAPP(var message:Tmessage); message WM_APP;
  public
    { Public declarations }
  end;

var
  pingerForm: TpingerForm;

implementation

{$R *.dfm}

{ TsemaphoreMailbox }

constructor TsemaphoreMailbox.create;
begin
   inherited Create;
  access:=TcriticalSection.create;
  countSema:=createSemaphore(nil,0,maxInt,nil);
end;

destructor TsemaphoreMailbox.destroy;
begin
  access.free;
  closeHandle(countSema);
  inherited;
end;

function TsemaphoreMailbox.pop(pResObject: pObject;
  timeout: DWORD): boolean;
// dequeues an object, if one is available on the queue.  If the queue is empty,
// the caller is blocked until either an object is pushed on or the timeout
// period expires
begin // wait for a unit from the semaphore
  result:=(WAIT_OBJECT_0=waitForSingleObject(countSema,timeout));
  if result then // if a unit was supplied before the timeout,
  begin
    access.acquire;
    try
      pResObject^:=inherited pop; // get an object from the queue
    finally
      access.release;
    end;
  end;
end;

procedure TsemaphoreMailbox.push(aObject: Tobject);
// pushes an object onto the queue.  If threads are waiting in a 'pop' call,
// one of them is made ready.
begin
  access.acquire;
  try
    inherited push(aObject); // shove the object onto the queue
  finally
    access.release;
  end;
  releaseSemaphore(countSema,1,nil); // release one unit to semaphore
end;

function TsemaphoreMailbox.peek(pResObject: pObject): boolean;
begin
  access.acquire;
  try
    result:=(Count>0);
    if result then pResObject^:=inherited pop; // get an object from the queue
  finally
    access.release;
  end;
end;

{ TPSThread }

constructor TPSThread.create(myForm:TForm;inputQueue:TsemaphoreMailbox);
begin
  inherited create(true);
  FmyForm:=myForm;
  FinQueue:=inputQueue;
  FreeOnTerminate:=true;
  Resume;
end;

procedure TPSThread.postToMain(mess:TpingRequest);
begin
  PostMessage(FmyForm.Handle,WM_APP,integer(FmyForm),integer(mess));
end;

procedure TPSThread.postReport(text:string);
var reportMess:TpingRequest;
begin
  reportMess:=TpingRequest.Create;
  reportMess.command:=EtcReport;
  reportMess.reportText:=text;
  postToMain(reportMess);
end;


procedure TPSThread.execute;
var inMess:TpingRequest;
  ActiveServer:Boolean;

    procedure tryConnect;
    begin
        with IcmpClient do
        begin
          ReceiveTimeout := 5000;
          Protocol := 1;
          ProtocolIPv6 := 0;
          PacketSize := 1024;
          Host:=inMess.hostName;
        end;
        IcmpClient.Ping(inMess.hostName,Random(1024));
        if IcmpClient.ReplyStatus.BytesReceived=0 then
        begin
          inMess.errorMess:=('PING failed');
          ActiveServer:=False;
        end
        else
          ActiveServer:=True;

      if ActiveServer then
      begin
          with TCPClient do
          begin
            Host:=inMess.hostName;
            Port:=strToInt(inMess.port);
            try
              Connect;
              try
                IOHandler.WriteLn('salam');
                inMess.reportText:='Message was sent successfully to server';
              finally
                Disconnect;
              end;
            except
              on e:exception do
              begin
                inMess.errorMess:=('TCP connection failed : '+e.Message);
              end;
            end;
          end;
      end;
    end;

begin
  postReport('PING thread started');
  IcmpClient:= TIdIcmpClient.Create();  // make Indy components
  TCPClient:=TIdTCPClient.Create(nil);
  try
    while FinQueue.pop(@inMess,INFINITE) do  // wait for message
    begin
      try
        case inMess.command of               // switch on command in message
          EtcDoPing: tryConnect;
          EtcSuicide: begin
                        inMess.command:=EtcReport;
                        inMess.reportText:='Thread exit';
                        exit;
                      end;
        else
          begin
            inMess.command:=EtcError;;
            inMess.errorMess:='Command not understood in PSThread';
          end;
        end;
      finally
        postToMain(inMess);                  // send message back with results
      end;
    end;
  finally
    IcmpClient.Free; // free off all the stuff made in ctor
    TCPClient.Free;
  end;
end;

{ TpingerForm }

procedure TpingerForm.ebThreadCountChange(Sender: TObject);
var newThreads:integer;
    suicideMess:TpingRequest;
begin
  try
    newThreads:=strToInt(ebThreadCount.Text);
    while threadCount<newThreads do
    begin
      TPSThread.create(self,queueToThreads);
      inc(threadCount);
    end;
    while threadCount>newThreads do
    begin
      suicideMess:=TpingRequest.Create;
      suicideMess.command:=EtcSuicide;
      queueToThreads.push(suicideMess);
      dec(threadCount);
    end;
  except;
  end;
end;

procedure TpingerForm.FormCreate(Sender: TObject);
var editThreadCount:integer;
begin
  queueToThreads:=TsemaphoreMailbox.create;
  editThreadCount:=strToInt(ebThreadCount.Text);
  while(threadCount<editThreadCount) do // make initial number of threads
  begin
    TPSThread.create(self,queueToThreads);
    inc(threadCount);
  end;
end;

procedure TpingerForm.sbPing1Click(Sender: TObject);
var outMess:TpingRequest;
begin
  outMess:=TpingRequest.Create;  // make a thread comms object
  outMess.command:=EtcDoPing;    // fill up
  outMess.hostName:=ebHostName.Text;
  outMess.port:=ebPort.Text;
  queueToThreads.push(outMess);
end;

// Message-handler for messages from thread
procedure TpingerForm.WMAPP(var message: Tmessage);
var inMess:TpingRequest;

  procedure messReport;
  begin
    memo1.Lines.Add(inMess.reportText);
  end;

  procedure messError;
  begin
    memo1.Lines.Add('>*Error*< '+inMess.errorMess);
  end;

  procedure messPing;
  var reportOut:string;
  begin
    reportOut:='Host '+inMess.hostName+', port: '+inMess.port+', ';
    if (inMess.errorMess='') then
       reportOut:=reportOut+'comms OK'
    else
      begin
        reportOut:=reportOut+'comms failed: '+inMess.ErrorMess;
      end;
      memo1.Lines.Add(reportOut);
      memo1.Lines.Add('');
  end;

begin
  inMess:=TpingRequest(message.LParam);
  try
    case inMess.command of
      EtcReport: messReport;
      EtcError: messError;
      EtcDoPing:messPing;
    end;
  finally
    inMess.Free;
  end;
end;

end.

Answer 2

使用线程编写代码时，您需要了解执行顺序是不能保证的，事实上，在多线程中编程时，您应该知道未锁定（同步）的代码可能会被执行并导致不安全调用并导致数据行为不如预期。

请阅读有关线程的更多信息并了解临界区线程同步的情况是一个很好的起点。

如果您需要执行顺序，则在打印之前进行所有计算，等待所有线程完成，然后进行所有打印。此命令的缺点不是实时打印，但是，您可以获得干净的输出。