0

ネットワークに悩まされているプログラムを書きました。マルチスレッドで使用しました。問題はスレッド出力です。プログラムは混合です。また、出力が正しく表示されません。

2 つのサンプル プログラムを作成しましたが、どちらも正しく動作しません。

プログラム 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 を削除します。ここでも追加の問題があります。

4

2 に答える 2

5

これはコンパイルされますか？TThread.Execute() は抽象的です。子孫の 'TPSThread.execute' で 'inherited' を呼び出すことはできません。コンパイラからエラーが発生しませんか?

「CreateSuspended」を false にして TPSThread を作成すると、スレッドが「すぐに」実行される可能性があります。Create 呼び出しの後にフィールドを設定すると、有効にならない場合があります。

継続的にスレッドを作成および破棄することは、無駄が多く、非効率的であり、エラーが発生しやすくなります。しないように頑張ってください。

4 つの「PS_System」呼び出しでネットワーク ping 操作を別のスレッドで (メイン スレッドをブロックしないように) 順番に実行する場合は、待機中の 1 つのスレッドに出力要求をキューに入れる必要があります。それらを実行するプロデューサー/コンシューマー キュー。

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.

10 スレッドで動作するピンガー

于 2012-04-17T12:32:59.287 に答える
2

スレッドでコードを書く場合、実行順序が保証されていないことを理解しておく必要があります。安全な呼び出しを行い、データが期待どおりに動作しない原因となります。

スレッドの詳細を読んで、クリティカル セクション スレッド同期のケースが開始点として適していることを理解してください。

実行順序が必要な場合は、印刷の前にすべての計算を行い、すべてのスレッドが終了するのを待ってから、すべての印刷を行います。この順序の欠点は、リアルタイム印刷ではありませんが、きれいな出力が得られます。

于 2012-04-17T12:07:40.173 に答える