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.

计划2

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（）是抽象的 - 你无法调用＆＃39;继承＆＃39;在你的后代＆＃39; TPSThread.execute＆＃39;。你没有从编译器中得到错误吗？

使用＆＃39; CreateSuspended＆＃39;创建TPSThread如果为false则意味着该主题可以立即运行＆＃39;。在Create调用之后设置字段可能无效。

不断创建和销毁线程是浪费，低效且容易出错的。尽量不要这样做。

如果你想要你的四个PS_System＆＃39;调用在不同的线程中执行网络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.

Pinger working with 10 threads

Answer 2

使用线程编写代码时，您需要了解执行顺序无法保证，事实上，在多线程编程时，您应该知道未锁定（同步）的代码可以执行并导致非安全调用并导致数据表现不尽如人意。

请阅读有关主题的更多内容，并了解critical section thread synchronization的情况，这是一个很好的起点。

如果您需要执行订单，则在打印前执行所有计算，等待所有线程完成，然后执行所有打印。这个订单的下行，不是实时打印，但是，你得到干净的输出。

多线程程序的输出无法正确显示

2 个答案: