德爾福 - 多線程端口檢查器

Question

我試圖將單個線程應用程序轉換爲多線程應用程序。

基本上，我想每10秒同時檢查50個端口，看他們是否在線或離線。

我使用一個列表框來加載所有的IP和端口（127.0.0.1:50008）他們我解析IP地址和端口號，並使用此功能檢查：

uses idTCPclient; 

function IsPortActive(AHost : string; APort : string): boolean; 
var 
    IdTCPClient : TIdTCPClient; 
begin 
    Result := False; 
    try 
    IdTCPClient := TIdTCPClient.Create(nil); 
    try 
     IdTCPClient.Host := AHost; 
     IdTCPClient.Port := strtoint(APort); 
     IdTCPClient.ConnectTimeout:=50; 
     IdTCPClient.Connect; 
     Result := True; 
    finally 
     IdTCPClient.Free; 
    end; 
    except 
    //Ignore exceptions 
    end; 
end; 

下面是該過程開始檢查端口和相應的信號結果：

procedure TForm2.Button1Click(Sender: TObject); 
begin 
    if isportactive('127.0.0.1','50008') then 
    listbox_online.items.add(ip+''+port) 
    else 
    listbox_offline.items.add(ip+''+port); 
end; 

可能有人請指導我如何將其轉換爲可以接受的IP和端口參數線程？

Answer 1

編寫線程的一種方法可以是這種。

我還沒有添加任何額外的TNotifyEvent方法，因爲您可以在線索的OnTerminate事件中查找您需要的屬性。

type 
    THostChecker = class(TThread) 
    strict private 
     FIdTCPClient: TIdTCPClient; 
     FHost: string; 
     FPort: Integer; 
     FConnectTimeout: Integer; 
     FIsPortActive: Boolean; 
    protected 
     procedure Execute; override; 
    public 
     constructor Create(const AHost: string; APort: Integer; AConnectTimeout: Integer = 50; CreateSuspended: Boolean = False); 
     property IsPortActive: Boolean read FIsPortActive; 
     property Host: string read FHost; 
     property Port: Integer read FPort; 
     destructor Destroy; override; 
    end; 

implementation 

{ THostChecker} 

constructor THostChecker.Create(const AHost: string; APort: Integer; AConnectTimeout: Integer; CreateSuspended: Boolean); 
begin 
    inherited Create(CreateSuspended); 
    FHost := AHost; 
    FPort := APort; 
    FConnectTimeout := AConnectTimeout; 
    FIdTCPClient := TIdTCPClient.Create(nil); 
    FIsPortActive := False; 
end; 

destructor THostChecker.Destroy; 
begin 
    FIdTCPClient.Free; 
    inherited; 
end; 

procedure THostChecker.Execute; 
begin 
    inherited; 
    with FIdTCPClient do begin 
    Host := FHost; 
    Port := FPort; 
    ConnectTimeout := FConnectTimeout; 
    Connect; 
    FIsPortActive := True; 
    end; 
end; 

這裏的形式相關的部分：

procedure TForm4.Button1Click(Sender: TObject); 
const 
    hosts: array [0..6] of string = ('google.com', 'stackoverflow.com', 'youtube.com', 'foo.org', 'null.org', 'porn.com', 'microsoft.com'); 
var 
i: Integer; 
begin 
    for i:=Low(hosts) to High(hosts) do 
    with THostChecker.Create(hosts[i], 80, 50, False) do begin 
     OnTerminate := HostCheckerTerminate; 
     FreeOnTerminate := True; 
    end; 
end; 

procedure TForm4.HostCheckerTerminate(Sender: TObject); 
var 
    hostChecker: THostChecker; 
    ex: Exception; 
    hostAndPort: string; 
begin 
    hostChecker := THostChecker(Sender); 

    ex := Exception(hostChecker.FatalException); 
    if Assigned(ex) then 
    //do something useful here or don't evaluate ex at all 

    hostAndPort := Format('%s:%d', [hostChecker.Host, hostChecker.Port]); 

    if hostChecker.IsPortActive then 
    listbox_online.items.add(hostAndPort) 
    else 
    listbox_offline.items.add(hostAndPort); 
end; 

酒店FreeOnTerminate是爲了避免線程本身調用Free設置爲True。

線程的OnTerminate事件中執行的代碼已在調用線程中同步。

線程不會在調用階段引發異常，但您可以檢查在OnTerminate事件中評估FatalException屬性的Execute方法中是否發生異常。