' ***********************************************************************
'
'   NetSHAKER
'
'   Copyright(C) 2009 YASKAWA INFORMATION SYSTEMS Corporation
'                                             All Rights Reserved.
'
' ****************************************************************************
' NetSHAKER Red-Mail現地確認ツール main
' ==========+===========================================+========+===========
'   DATE    |                  Comments                 |Revision|   SIGN   
' ==========+===========================================+========+===========
' 2009/09/10| 新規作成                                  | New    |Kyuragi
' ----------+-------------------------------------------+--------+-----------
' 2009/xx/xx|                                           | <A>    |
' ----------+-------------------------------------------+--------+-----------
'
' 概要
' 引数で指定された設定シート(Excel)を読み込み、設定値を取得。
' 各チェックツールに引数で渡し、実行結果をチェック結果ファイルに出力する。
' チェック結果ファイルは、設定シート同じディレクトリ以下に出力する。
' 
' 引数
' 	0 : 設定シート(※絶対パス)
' 
' 戻り値
' 	0 : 正常終了
' 	1 : Excel読み込み失敗
' 
' 注意
' 	設定シートは必ず絶対パスで指定すること。(Excelモジュールの仕様)
' 	
' ----------------------------------------------------------------------------

' エラー発生時も処理継続
On Error Resume Next

' ============================================================================
' 定義
' ============================================================================
' シート名
Dim strSheetName 'As String
strSheetName = "ネットワークチェックツール"

' チェックツール
Dim chk_ping ' As String
Dim chk_dns  ' As String
Dim chk_smtp ' As String

chk_ping = "chk_ping.vbs"	' pingチェック
chk_dns  = "chk_dns.vbs"	' dnsチェック
chk_smtp = "chk_smtp.vbs"	' SMTPチェック

' 名前解決する外部サーバ
Dim OutServerFqdn
OutServerFqdn = "support.netshaker.com"

' メールを送信するNSMのローカルユーザ
Dim MailtoUser
MailtoUser = "admin"

' 結果出力ファイル名
Dim outputFile
outputFile = "chk_result.txt"

' 結果出力ファイル内の区切り
Dim Delimiter
Delimiter = "************************************************************" & vbCrLf

' ============================================================================
' 宣言
' ============================================================================
Dim exl         ' As Excel.Application
Dim xlBook      ' As Excel.Workbook
Dim xlSheet     ' As Excel.Worksheet
Dim objFSO      ' FileSystemObject
Dim objWshShell ' WshShell オブジェクト
Dim objExecCmd  ' 実行コマンド情報
Dim objShell    ' Shell オブジェクト
Dim objFile     ' ファイル情報

' 設定値格納用
Dim ParamEth0IpAddress    ' eth0 IPアドレス
Dim ParamEth0NetMask      ' eth0 ネットマスク
Dim ParamFqdn             ' FQDN
Dim ParamDnsServer        ' DNSサーバ(複数指定可能なため配列)
Dim ParamSmtpEnable       ' SMTPサーバ有効
Dim ParamSmtpPort         ' SMTPサーバ動作ポート
Dim ParamOuterMailAddress ' 外部メールアドレス
Dim ParamTypePrimary      ' 機器構成種別(プライマリの場合は、この値がY)
Dim ParamCommonAddress    ' 共通IPアドレス

' フォルダパス
Dim SettingSeetFolderPath

' ============================================================================
' メイン処理
' ============================================================================
' ----------------------------------------------------
' 引数チェック
' ----------------------------------------------------
If WScript.Arguments.Count <> 1 Then
	WScript.StdOut.WriteLine "Invalid Arguments"
	WScript.Quit(1)
End If

' 読み込み対象ファイルパス
Dim strFileName 'As String
strFileName = WScript.Arguments.Item(0)

' ファイル有無チェック
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFileName) = False Then
	WScript.StdOut.WriteLine "File Not Found"
	WScript.Quit(1)
End If

Set objFSO = Nothing

' ----------------------------------------------------
' 開始時刻取得
' ----------------------------------------------------
Dim StartTime
StartTime = "check start " & Now & vbCrLf

' ----------------------------------------------------
' 設定値取得
' ----------------------------------------------------
' 設定シートオープン
Set exl = CreateObject("Excel.Application")		' Excel操作オブジェクト生成
exl.Workbooks.Open(strFileName)					' Excelファイルオープン
exl.Visible = False								' Excelの表示

' シートチェック
'Set xlBook = exl.Workbooks(Dir(strFileName))	' Workbookの選択
Set xlSheet = exl.Worksheets(strSheetName)		' Worksheetの選択

' 設定値取得 ※※※※ シートのフォーマットが変更になったら、ここを変更 ※※※※
ParamTypePrimary   = xlSheet.Cells(3, 4)	' プライマリかどうか(セルD3)
ParamEth0IpAddress = xlSheet.Cells(5, 4)	' eth0 IPアドレス(セルD5)
ParamEth0NetMask   = xlSheet.Cells(6, 4)	' eth0 ネットマスク(セルD6)
ParamFqdn          = xlSheet.Cells(7, 4)	' FQDN(セルD7)
ParamCommonAddress = xlSheet.Cells(8, 4)	' 共通IPアドレスポート(セルD8)
ParamSmtpEnable    = xlSheet.Cells(13, 4)	' SMTPサーバ有効(セルD13)
ParamSmtpPort      = xlSheet.Cells(14, 4)	' SMTPサーバ動作ポート(セルD14)
ParamOuterMailAddress = xlSheet.Cells(15, 4)	' SMTPサーバ動作ポート(セルD15)

' DNSサーバ(セルD9〜12)
Dim dns1
Dim dns2
Dim dns3
Dim dns4
' 配列に直接"xlSheet.Cells"を指定すると配列が作れない。
' アクセスすると、オブジェクトがないと言われる。
' そのため、一旦変数に取得する。
dns1 = xlSheet.Cells(9, 4)
dns2 = xlSheet.Cells(10, 4)
dns3 = xlSheet.Cells(11, 4)
dns4 = xlSheet.Cells(12, 4)
ParamDnsServer = Array(dns1, dns2, dns3, dns4)

' 終了時の確認ダイアログの指定
'	True : 確認メッセージを表示して終了(デフォルト)
'	False : 確認メッセージを表示せずに終了する
exl.Application.DisplayAlerts = False

' ファイルクローズ
exl.Application.Quit
Set exl = Nothing

' デバッグ
'WScript.StdOut.WriteLine "ip " & ParamEth0IpAddress
'WScript.StdOut.WriteLine "netmask " & ParamEth0NetMask
'WScript.StdOut.WriteLine "fqdn " & ParamFqdn
'WScript.StdOut.WriteLine "smtp enable " & ParamSmtpEnable
'WScript.StdOut.WriteLine "smtp port " & ParamSmtpPort
'WScript.StdOut.WriteLine "配列min" & LBound(ParamDnsServer)
'WScript.StdOut.WriteLine "配列max" & UBound(ParamDnsServer)
'WScript.StdOut.WriteLine "dns1 " & ParamDnsServer(0)
'WScript.StdOut.WriteLine "dns2 " & ParamDnsServer(1)
'WScript.StdOut.WriteLine "dns3 " & ParamDnsServer(2)
'WScript.StdOut.WriteLine "dns4 " & ParamDnsServer(3)

' 設定シートフォルダパス取得
Set objFile = WScript.CreateObject("Scripting.FileSystemObject")
SettingSeetFolderPath = objFile.GetParentFolderName(strFileName)
Set objFile = Nothing

' チェック結果出力先ファイルパス
outputFile = SettingSeetFolderPath & "\" & outputFile

' ----------------------------------------------------
' pingチェック
' ----------------------------------------------------
' 共通IPアドレス、各機のプライマリインタフェース(eth0)に対してpingを実行
Dim cmdPing
Dim retPing
Dim cmdoutPing


' プライマリインタフェースへのping
' 実行コマンド
cmdPing = "cscript /nologo " & chk_ping & " " & ParamEth0IpAddress

' 実行
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objExecCmd = objWshShell.Exec(cmdPing)
Do While objExecCmd.Status = 0
	WScript.Sleep 100
Loop

' 実行結果(標準出力)
cmdoutPing = objExecCmd.StdOut.ReadAll & vbCrLf & vbCrLf	' 標準出力読み込み

' 実行結果(戻り値)
retPing = objExecCmd.ExitCode


' 共通IPアドレスへのping
If ParamCommonAddress <> "0" Then
	' 実行コマンド
	cmdPing = "cscript /nologo " & chk_ping & " " & ParamCommonAddress

	' 実行
	Set objWshShell = WScript.CreateObject("WScript.Shell")
	Set objExecCmd = objWshShell.Exec(cmdPing)
	Do While objExecCmd.Status = 0
		WScript.Sleep 100
	Loop
	' 実行結果(標準出力)
	cmdoutPing = cmdoutPing & objExecCmd.StdOut.ReadAll & vbCrLf	' 標準出力読み込み

	' 実行結果(戻り値)
	retPing = retPing  + objExecCmd.ExitCode
End If

Set objWshShell = Nothing
Set objExecCmd  = Nothing

' ----------------------------------------------------
' DNSチェック
' ----------------------------------------------------
Dim cmdDns
Dim retDns
Dim cmdoutDns
Dim ret

Dim lngLoop	' ループカウンタ

' NSM自身のFQDNを問合せ、eth0が返ってくるかのチェック
For lngLoop = 0 To UBound(ParamDnsServer)
	' 未指定の場合は飛ばす
	If ParamDnsServer(lngLoop) <> "0" Then
		' 実行コマンド
		cmdDns = "cscript /nologo " & chk_dns & " " & ParamDnsServer(lngLoop) & " " & ParamFqdn & " " & ParamEth0IpAddress

		' 実行
		Set objWshShell = WScript.CreateObject("WScript.Shell")
		Set objExecCmd = objWshShell.Exec(cmdDns)
		Do While objExecCmd.Status = 0
			WScript.Sleep 100
		Loop

		' 実行結果(戻り値)
		' 一つでもNGがあれば、NGとなるようにする
		ret = objExecCmd.ExitCode
		retDns = retDns + ret

		' 実行結果(標準出力)
		cmdoutDns = cmdoutDns & objExecCmd.StdOut.ReadAll & vbCrLf	' 標準出力読み込み

		Set objWshShell = Nothing
		Set objExecCmd = Nothing
	End If
Next

' 外部サーバのFQDNを問い合わせる
For lngLoop = 0 To UBound(ParamDnsServer)
	' 未指定の場合は飛ばす
	If ParamDnsServer(lngLoop) <> "0" Then
		' 実行コマンド
		cmdDns = "cscript /nologo " & chk_dns & " " & ParamDnsServer(lngLoop) & " " & OutServerFqdn

		' 実行
		Set objWshShell = WScript.CreateObject("WScript.Shell")
		Set objExecCmd = objWshShell.Exec(cmdDns)
		Do While objExecCmd.Status = 0
			WScript.Sleep 100
		Loop

		' 実行結果(戻り値)
		' 一つでもNGがあれば、NGとなるようにする
		ret = objExecCmd.ExitCode
		retDns = retDns + ret

		' 実行結果(標準出力)
		cmdoutDns = cmdoutDns & objExecCmd.StdOut.ReadAll & vbCrLf	' 標準出力読み込み

		Set objWshShell = Nothing
		Set objExecCmd = Nothing
	End If
Next

' ----------------------------------------------------
' SMTPチェック
' ----------------------------------------------------
Dim cmdSmtp
Dim retSmtp
Dim cmdoutSmtp

' プライマリ機のみチェックを行う
If ParamTypePrimary = "Y" Then
	' SMTPサービスが有効な場合のみ行う
	If ParamSmtpEnable = "Y" Then
		' 共通IPが指定されている場合は、共通IPに対してチェックを実施
		' 共通IPがない場合は、プライマリに対して実施
		Dim SmtpServer
		If ParamCommonAddress = "0" Then
			SmtpServer = ParamEth0IpAddress
		Else
			SmtpServer = ParamCommonAddress
		End If


		' 実行コマンド(1) NSM内部宛
		cmdSmtp = "cscript /nologo " & chk_smtp & " " & SmtpServer & " " & ParamSmtpPort & " " & MailtoUser & "@" & ParamFqdn

		' 実行
		Set objWshShell = WScript.CreateObject("WScript.Shell")
		Set objExecCmd = objWshShell.Exec(cmdSmtp)
		Do While objExecCmd.Status = 0
			WScript.Sleep 100
		Loop

		' 実行結果(戻り値)
		retSmtp = objExecCmd.ExitCode

		' 実行結果(標準出力)
		cmdoutSmtp = cmdoutSmtp & objExecCmd.StdOut.ReadAll & vbCrLf & vbCrLf	' 標準出力読み込み

		Set objWshShell = Nothing
		Set objExecCmd = Nothing

		' 実行コマンド(2) 外部宛
		cmdSmtp = "cscript /nologo " & chk_smtp & " " & SmtpServer & " " & ParamSmtpPort & " " & ParamOuterMailAddress

		' 実行
		Set objWshShell = WScript.CreateObject("WScript.Shell")
		Set objExecCmd = objWshShell.Exec(cmdSmtp)
		Do While objExecCmd.Status = 0
			WScript.Sleep 100
		Loop

		' 実行結果(戻り値)
		ret = objExecCmd.ExitCode
		retSmtp = retSmtp + ret

		' 実行結果(標準出力)
		cmdoutSmtp = cmdoutSmtp & objExecCmd.StdOut.ReadAll & vbCrLf	' 標準出力読み込み

		Set objWshShell = Nothing
		Set objExecCmd = Nothing
	End If
End If

' ----------------------------------------------------
' 終了時刻取得
' ----------------------------------------------------
Dim EndTime
EndTime = "check end " & Now & vbCrLf

' ----------------------------------------------------
' 結果出力
' ----------------------------------------------------
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
' 第2引数 1...読み取りモード
'         2...書き込みモード
'         8...追記モード
' 第3引数 ファイルが存在しない場合の動作
'         True...新規作成
'         False..エラー発生
Set objFile = objFSO.OpenTextFile(outputFile, 2, True)

' チェック開始時刻
objFile.Write(StartTime)

' OK/NG出力
' ping
If retPing <> 0 Then
	objFile.Write("ping check : NG")
	objFile.Write(vbCrLf)
Else
	objFile.Write("ping check : OK")
	objFile.Write(vbCrLf)
End If

' DNS
If retDns <> 0 Then
	objFile.Write("DNS check : NG")
	objFile.Write(vbCrLf)
Else
	objFile.Write("DNS check : OK")
	objFile.Write(vbCrLf)
End If

' SMTP
If ParamSmtpEnable = "Y" Then
	If retSmtp <> 0 Then
		objFile.Write("SMTP check : NG")
		objFile.Write(vbCrLf)
	Else
		objFile.Write("SMTP check : OK")
		objFile.Write(vbCrLf)
	End If
End If

' チェック終了時刻
objFile.Write(EndTime)

' pingチェック実行結果
objFile.Write(vbCrLf)
objFile.Write(Delimiter)
objFile.Write(cmdoutPing)

' DNSチェック実行結果
objFile.Write(Delimiter)
objFile.Write(cmdoutDns)

' SMTPチェック実行結果
If ParamSmtpEnable = "Y" Then
	objFile.Write(Delimiter)
	objFile.Write(cmdoutSmtp)
End If

objFile.Write(Delimiter)
objFile.Close

Set objFile = Nothing
Set objFSO = Nothing

' ----------------------------------------------------
' 正常終了
' ----------------------------------------------------
WScript.Quit(0)