【Delphi】以 WMI 方式 ping 網路設備

參考資料 ----
Making a PING with Delphi and the WMI


總算找到一個可以以一般使用者權限 ping 網路設備的方法了。

適用 XP 環境, Delphi 7 以上開發，也就是說在 Win7, Delphi2009 以上也可以開發。


在 Form 放 1 個  TEdit 和 1 個 Button

 
unit Unit1;

interface

// 注意要 uses ActiveX, ComObj
uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ActiveX, ComObj;

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetStatusCodeStr(statusCode:integer) : string;
begin
    case statusCode of
        0    :  Result := 'Success';
        11001:  Result := 'Buffer Too Small';
        11002:  Result := 'Destination Net Unreachable';
        11003:  Result := 'Destination Host Unreachable';
        11004:  Result := 'Destination Protocol Unreachable';
        11005:  Result := 'Destination Port Unreachable';
        11006:  Result := 'No Resources';
        11007:  Result := 'Bad Option';
        11008:  Result := 'Hardware Error';
        11009:  Result := 'Packet Too Big';
        11010:  Result := 'Request Timed Out';
        11011:  Result := 'Bad Request';
        11012:  Result := 'Bad Route';
        11013:  Result := 'TimeToLive Expired Transit';
        11014:  Result := 'TimeToLive Expired Reassembly';
        11015:  Result := 'Parameter Problem';
        11016:  Result := 'Source Quench';
        11017:  Result := 'Option Too Big';
        11018:  Result := 'Bad Destination';
        11032:  Result := 'Negotiating IPSEC';
        11050:  Result := 'General Failure'
    else
        result := 'Unknow';
    end;
end;


function Ping(const Address:string; BufferSize:Word): string;
var
    FSWbemLocator : OLEVariant;
    FWMIService   : OLEVariant;
    FWbemObjectSet: OLEVariant;
    FWbemObject   : OLEVariant;
    oEnum         : IEnumvariant;
    iValue        : LongWord;

    PacketsReceived : Integer;
    Minimum         : Integer;
    Maximum         : Integer;
    Average         : Integer;
begin
    PacketsReceived := 0;
    Minimum         := 0;
    Maximum         := 0;
    Average         := 0;

    FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
    FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');

    FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM Win32_PingStatus where Address=%s AND BufferSize=%d',[QuotedStr(Address),BufferSize]),'WQL',0);
    oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
    if (oEnum.Next(1,FWbemObject,iValue)=0) then
    begin
        if FWbemObject.StatusCode=0 then
            begin
                // ping 成功
                Inc(PacketsReceived);

                result := 'ping 的到';
            end
        else
            if not VarIsNull(FWbemObject.StatusCode) then
                result := GetStatusCodeStr(FWbemObject.StatusCode)
            else
                result := 'Error processing request';
    end;
    FWbemObject := Unassigned;
    FWbemObjectSet := Unassigned;

end;


procedure TForm1.Button1Click(Sender: TObject);
var
    str: string;
begin
    try
        CoInitialize(nil);
        try
            str := Ping(Edit1.Text, 32);
            showmessage(str);
        finally
            CoUninitialize;
        end;
    except
        on E:Exception do
            showmessage('意外錯誤: ' + E.Classname + ':' + E.Message);
    end;
end;

end.
 

相關筆記 ----
【Delphi】以 Indy TIdIcmpClient 去 ping 網路設備
【Delphi】以 icmp.dll 去 ping 網路設備