マシンの死活監視に欠かせないのがPing。
くろねこも社内でアプリケーションサーバーがDBサーバーに接続しに行く前に死活監視を...と言う話を切り出してからはなかなか実現できず、問題だけが積み上がっていた。
だって、それに集中する時間が無いんだもん...
すでに、社内のマネージャからは「ライフワーク」といわれ始めた...
そんな状況を打開するために、ちょっと気合いを入れて調査してみる。
よくあるPingのサンプルプログラムでは管理者権限が必要。
管理者権限が不要といわれているプログラムをいくつか試してみたが動かず暗礁に乗り上げていたが...
本日、先日買ったノートPCで帰宅中に、最悪.net Frameworkでもいいか～と調べていると...
やっぱり、Pingクラスってあるんですね。
さらに、Pingクラスを使っている例が無いかググってみると、WMIで実行する方法がある。
WMIはWin32でも実行できるので、今回はこちらでコーディングしてみることにした。
できあがったソース。
なお、このプログラムのコンパイルにはタイプライブラリの取り込みが必要です。
Microsoft WMI Scripting V1.2 Library を取り込み、作成されたユニットをプロジェクトと同じフォルダに置くことを前提に作成してある。
※取り込み方法：メニューの「コンポーネント｜コンポーネントのインポート」で、コンポーネントのインポートウィザードを表示し、次にタイプライブラリのインポートを選択し「次へ」、一覧からMicrosoft WMI Scripting V1.2 Library を選択し「次へ」、ユニットの作成を選択し「完了」ボタンをクリック。
program PingExec;
{$APPTYPE CONSOLE}
uses
SysUtils,
Variants,
ComObj,
ActiveX,
WbemScripting_TLB in 'WbemScripting_TLB.pas';
type
// 参考
// Win32_PingStatus = record
// string Address;
// uint32 BufferSize = 32;
// boolean NoFragmentation = FALSE;
// uint32 PrimaryAddressResolutionStatus;
// string ProtocolAddress = "";
// string ProtocolAddressResolved = "";
// uint32 RecordRoute = 0;
// boolean ReplyInconsistency;
// uint32 ReplySize;
// boolean ResolveAddressNames = FALSE;
// uint32 ResponseTime;
// uint32 ResponseTimeToLive;
// string RouteRecord[];
// string RouteRecordResolved[];
// String SourceRoute = "";
// uint32 SourceRouteType = 0;
// uint32 StatusCode;
// uint32 Timeout = 1000;
// uint32 TimeStampRecord[];
// string TimeStampRecordAddress[];
// string TimeStampRecordAddressResolved[];
// uint32 TimeStampRoute = 0;
// uint32 TimeToLive = 80;
// uint32 TypeofService = 0;
// end;
TPingResult = record
BufferSize: cardinal;
ProtocolAddress: string;
ResponseTime: cardinal;
ResponseTimeToLive: cardinal;
end;
function SendPing(address: string; var pr: TPingResult): integer;
var
Locator: ISWbemLocator;
Services: ISWbemServices;
SObjSet: ISWbemObjectSet;
SObject: ISWbemObject;
Enum: IEnumVariant;
TempObj: OleVariant;
TempVal: Cardinal;
Query: string;
begin
Result := -1;
if Failed(CoInitialize(nil)) then Exit;
try
Locator := CoSWbemLocator.Create;
Services := Locator.ConnectServer('.', 'root\cimv2', '', '', '', '', 0, nil);
Query := 'SELECT * FROM Win32_PingStatus WHERE address=' + QuotedStr(address);
SObjSet := Services.ExecQuery(Query, 'WQL', wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
TempVal := 0;
Enum := (SObjSet._NewEnum) as IEnumVariant;
if (Succeeded(Enum.Next(1, TempObj, TempVal)) and (TempVal > 0)) then
begin
try
SObject := IUnknown(TempObj) as ISWBemObject;
if (SObject <> nil) then
begin
if VarIsNull(SObject.Properties_.Item('StatusCode', 0).Get_Value) then exit;
Result := (SObject.Properties_.Item('StatusCode', 0).Get_Value);
if (Result = 0) then
begin
with SObject.Properties_ do
begin
pr.ProtocolAddress := VarToStr(Item('ProtocolAddress', 0).Get_Value);
pr.BufferSize := StrToIntDef(VarToStr(Item('BufferSize', 0).Get_Value), 0);
pr.ResponseTime := StrToIntDef(VarToStr(Item('ResponseTime', 0).Get_Value), 0);
pr.ResponseTimeToLive := StrToIntDef(VarToStr(Item('ResponseTimeToLive', 0).Get_Value), 0);
end;
end;
end;
finally
SObject := nil;
VarClear(TempObj);
end;
end;
finally
Enum.Reset;
SObjSet := nil;
Services := nil;
Locator := nil;
end;
end;
(** Main **)
var
pr: TPingResult;
begin
if (SendPing(ParamStr(1), pr) = 0) then
begin
System.Writeln(Format('%s からの応答: バイト数 =%d 時間 =%dms TTL=%d', [
pr.ProtocolAddress, pr.BufferSize, pr.ResponseTime, pr.ResponseTimeToLive]));
end
else
begin
System.Writeln(Format('%s からの応答: 宛先ホストに到達できません。', [ParamStr(1)]));
end;
end.
RFC 791準拠.ちなみにパラメータはコンピュータ名でもIPアドレスでも実行可能。IPv6 and IPv4 Support in WMIということなのでIPアドレスはIPv4, IPv6 双方可能だと思われる。
■参考URI