'##############################################################
'# DSN レコードの更新処理
'# 機能：
'# 入力ファイルの情報からDSNレコードへ追加
'# 入力ファイルの情報からDSNレコードから削除
'# 入力パラメータのフォーマットチェック
'#
'# 実行方法：コマンドコンソールから実施する
'# cscript //nologo CS_DNSUpdate.vbs > DNSUpdate.log &
'# cscript //nologo CS_DNSUpdate.vbs CHK > DNSUpdate.log &
'#
'#
'# 実行時の注意
'# １．オプション：CHKを付けてエラーチェックのみを行う。
'# ２．エラーがある場合はエラーを修正し、CHKオプションでログにエラーが無くなるまで実行する
'# ３．エラーがない状態で、CHKオプションを外して本実行する
'#
'# 入力パラメータファイル：
'# 当スクリプトと同場所 CS_DNSUpdate.ini
'# フォーマット：
'# 項目左詰,半角スペースのセパレータ
'# 項目：
'# システム名、DNSアドレス、ドメイン名、ホスト名、IPアドレス、災対IPアドレス
'#
'# システムの単位で登録する
'# 行をコメントにする場合は、先頭＃文字
'# 全ての項目は、入力必須、ブランク、空白は不可でこの事象に該当する場合部分エラーとなる
'# CHKオプション付きで実行してフォーマットをチェックしてから、CHKオプションを外して実行することを推奨します。
'#
'# ログファイル：
'# 当スクリプトと同場所 DNSUpdate.log
'#
'# UPDATE 2013/10/24
'#
'##############################################################
'Option Explicit
' グローバル定義
Dim sCheck 'パラメータ１ １：チェック
Dim iStepNo : iStepNo = 1 'ステップ番号
Dim msg : msg = "" 'メッセージ
Dim sComputer
Dim URL
'****************************************************************
' 関数
'****************************************************************
'' メッセージレベル
Const MSGLEVEL_I = " I " ' INFOMATION
Const MSGLEVEL_W = " W " ' WARNING
Const MSGLEVEL_E = " E " ' ERROR_
Const MSGLEVEL_S = " S " ' SEVERE_ERROR
'' コマンド@@
Const DNSCMD = "xdnscmd" ' DNS CMD COMMAND
'' OPTION
Const CHK = "CHK" ' RUN OPTION
Const ExE = "EXE" ' RUN OPTION
Const INI_FILE = "CS_DNSUpdate.ini" ' Fie
Const LOG_FILE = "CS_DNSUpdate.log" ' Fie
'****************************************************************
sCheck = Main_Init()
Call Main(sCheck)
WScript.Quit (0)
'**************************************************************
' メイン処理
'**************************************************************
Sub Main(flg)
Dim infile
Dim outfile
infile = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\")) & INI_FILE
outfile = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\")) & LOG_FILE
WScript.Echo now & "** DNS UPDATE START ** "
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WScript.Echo now & "** DNS UPDATE Main ** flg=" & flg
DnsRecordAddMain infile,flg
DnsRecordDelMain infile,flg
WScript.Echo now & "** DNS UPDATE STOP ** "
End Sub
'************************************************************
' 関数： DnsRecordAddMain
' 用途： DSNレコード追加を行う
' 入力： パラメータ、処理フラグ
' 戻値：
'************************************************************
Function DnsRecordAddMain(infile,flg)
Dim objFSO ' ファイルシステムオブジェクト
Dim objTextStream ' テキストストリームオブジェクト
Dim strText ' テキスト内容
Dim sSysName
Dim sSysNameOld
Dim sRc
Dim iCnt
Dim iCntErr
iCnt = 0
iCntErr = 0
sSysName = ""
sSysNameOld = ""
On Error Resume Next
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFSO.OpenTextFile(infile, 1)
Do Until objTextStream.AtEndOfLine = True
strText = objTextStream.ReadLine
'コメント行の確認
IF Left(strText, 1) <> "#" THEN
'システム名の表示
aryStrings = Split(strText, " ")
sSysName = aryStrings(0)
IF sSysName <> sSysNameOld THEN
WScript.Echo "##### " & sSysName & "の災対レコードを追加します。#####"
END IF
sSysNameOld = sSysName
cmd = BildDnsAddCmd(strText)
IF cmd <> 1 THEN
'１行目（生成コマンドの表示）
WScript.Echo now & " " & cmd
IF flg <> CHK THEN
'２行目（コマンドの実行）
sRc= WshShell.run (cmd,1,true)
'３行目（実行結果の表示）
WScript.Echo now & " ** " & EXE & sRc & " ** "
END IF
Else
iCntErr = iCntErr + 1
END IF
iCnt = iCnt + 1
END IF
Loop
WScript.Echo now & " " & "** DnsAdd ** Mode=" & flg & " iCnt=" & iCnt & " iCnErr=" & iCntErr
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
End Function
'************************************************************
' 関数： dnsへのレコード追加コマンドを生成する
' 説明： 入力レコードからコマンドを組み立てて返す
' 入力： 入力レコード（スペース区切り）
' 戻値： コマンド
'************************************************************
Function BildDnsAddCmd(strText)
Dim sBildCmd
Dim sSysName
Dim sDnsIp
Dim sDomain
Dim sHostname
Dim sIp
Dim sIpEmg
sBildCmd =""
aryStrings = Split(strText, " ")
sSysName = aryStrings(0)
sDnsIp = aryStrings(1)
sDomain = aryStrings(2)
sHostname = aryStrings(3)
sIp = aryStrings(4)
sIpEmg = aryStrings(5)
'入力チェック --------------------------------------------------
errflg = 0
if sSysName = "" then
WScript.Echo now & " " & " ** INPUT FILE SYSNAME SPACE ERROR **"
errflg = 1
end if
if sDnsIp = "" then
WScript.Echo now & " " & " ** INPUT FILE DNSIP SPACE ERROR **"
errflg = 1
end if
if sDomain = "" then
WScript.Echo now & " " & " ** INPUT FILE DOMAIN SPACE ERROR **"
errflg = 1
end if
if sHostname = "" then
WScript.Echo now & " " & " ** INPUT FILE HOSTNAME SPACE ERROR **"
errflg = 1
end if
if sIp = "" then
WScript.Echo now & " " & " ** INPUT FILE IP SPACE ERROR **"
errflg = 1
end if
if sIpEmg = "" then
WScript.Echo now & " " & " ** INPUT FILE IPEMG SPACE ERROR **"
errflg = 1
end if
if errflg = 1 then
BildDnsDelCmd = errflg
return
end if
'入力チェック --------------------------------------------------
'コマンドの組み立て
sBildCmd = DNSCMD & " " & sDnsIp & " /recordadd " & sDomain & " " & sHostname & " A " & sIpEmg
'WScript.Echo now & " " & sBildCmd
BildDnsAddCmd = sBildCmd
End Function
'************************************************************
' 関数： DnsRecorddelMain
' 用途： DSNレコード削除を行う
' 入力： パラメータ、処理フラグ
' 戻値：
'************************************************************
Function DnsRecordDelMain(infile,flg)
Dim objFSO ' ファイルシステムオブジェクト
Dim objTextStream ' テキストストリームオブジェクト
Dim strText ' テキスト内容
Dim sSysname
Dim sSysNameOld
Dim sRc
Dim iCnt
Dim iCntErr
iCnt = 0
iCntErr = 0
sSysName = ""
sSysNameOld = ""
On Error Resume Next
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFSO.OpenTextFile(infile, 1)
Do Until objTextStream.AtEndOfLine = True
strText = objTextStream.ReadLine
'コメント行(先頭が#)の確認
IF Left(strText, 1) <> "#" THEN
'システム名の表示
aryStrings = Split(strText, " ")
sSysName = aryStrings(0)
IF sSysName <> sSysNameOld THEN
WScript.Echo "##### " & sSysName & "の災対レコードを削除します。#####"
END IF
sSysNameOld = sSysName
cmd = BildDnsDelCmd(strText)
IF cmd <> 1 THEN
'１行目（生成コマンドの表示）
WScript.Echo now & " " & cmd
IF flg <> CHK THEN
'２行目（コマンドの実行）
sRc = WshShell.run (cmd,1,true)
'３行目（実行結果の表示）
WScript.Echo now & " ** " & EXE & sRc & " ** "
END IF
Else
iCntErr = iCntErr + 1
END IF
iCnt = iCnt + 1
END IF
Loop
WScript.Echo now & " " & "** DnsDel ** Mode=" & flg & " iCnt=" & iCnt & " iCnErr=" & iCntErr
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
End Function
'************************************************************
' 関数： dnsへのレコード削除コマンドを生成する
' 説明： 入力レコードからコマンドを組み立てて返す
' 入力： 入力レコード（スペース区切り）
' 戻値： コマンド
'************************************************************
Function BildDnsDelCmd(strText)
Dim sBildCmd
Dim sSysName
Dim sDnsIp
Dim sDomain
Dim sHostname
Dim sIp
Dim sIpEmg
sBildCmd =""
aryStrings = Split(strText, " ")
sSysName = aryStrings(0)
sDnsIp = aryStrings(1)
sDomain = aryStrings(2)
sHostname = aryStrings(3)
sIp = aryStrings(4)
sIpEmg = aryStrings(5)
'入力チェック --------------------------------------------------
errflg = 0
if sSysName = "" then
WScript.Echo now & " " & " ** INPUT FILE SYSNAME SPACE ERROR **"
errflg = 1
end if
if sDnsIp = "" then
WScript.Echo now & " " & " ** INPUT FILE DNSIP SPACE ERROR **"
errflg = 1
end if
if sDomain = "" then
WScript.Echo now & " " & " ** INPUT FILE DOMAIN SPACE ERROR **"
errflg = 1
end if
if sHostname = "" then
WScript.Echo now & " " & " ** INPUT FILE HOSTNAME SPACE ERROR **"
errflg = 1
end if
if sIp = "" then
WScript.Echo now & " " & " ** INPUT FILE IP SPACE ERROR **"
errflg = 1
end if
if sIpEmg = "" then
WScript.Echo now & " " & " ** INPUT FILE IPEMG SPACE ERROR **"
errflg = 1
end if
if errflg = 1 then
BildDnsDelCmd = errflg
'return
end if
'入力チェック --------------------------------------------------
'コマンドの組み立て
sBildCmd = DNSCMD & " " & sDnsIp & " /recorddelete " & sDomain & " " & sHostname & " A " & sIp
'WScript.Echo now & " " & sBildCmd
BildDnsDelCmd = sBildCmd
End Function
'**************************************************************
' 1.1 初期処理
'**************************************************************
Function Main_Init()
' VBS起動するWSHコマンドがcScriptでない場合は
' エラーコード99で終了する
IF Not(IsCscript()) THEN
WScript.Quit (99)
END IF
msg="** Note:CScript ONLY RUN **"
sComputer = SetLogHeader(msg)
Main_Init = GetParam()
End Function
'-----------------------------------------------
' 1.1.1 パラメータ取得処理
'-----------------------------------------------
Function GetParam()
Dim i
Dim objParm
sCheck = EXE ' モード
Set objParm=WScript.Arguments
For i=1 To objParm.Count
WScript.echo now & MSGLEVEL_I & "** (" & i & ") " & objParm.Item(i - 1)
IF i = 1 THEN
sCheck = objParm.Item(i - 1)
END IF
Next
GetParam = sCheck
End Function
'****************************************************************
' 関数： IsCscript
' 用途： 自VBSを起動したWSH コマンドがcScriptを返信
' 入力： 無し
' 戻値： cScriptの時true wScriptの時false
'****************************************************************
Function IsCscript()
' WSH起動コマンド
Const WHS_COMMAND_WSCRIPT = "wscript.exe"
Const WHS_COMMAND_CSCRIPT = "cscript.exe"
IsCscript = true
IF LCase( Right(WScript.FullName, len(WHS_COMMAND_WSCRIPT)) ) = WHS_COMMAND_WSCRIPT THEN
IsCscript = false
END IF
End Function
'****************************************************************
' 関数： SetLogHeader
' 用途： ログヘッダーページをフォーマット
' 入力： ヘッダーのコメントメッセージ
' 戻値： コンピュータ名前
'****************************************************************
Function SetLogHeader(msg)
Dim objNetWork ' ネットワークオブジェクト
Dim objParm ' コマンドラインパラメータ
Dim i ' コマンドライン引数の個数
Dim chr
iStepNo = 0
WScript.Echo now & " ***********************************************************"
WScript.Echo now & EditTitleLine(" ** Script : " & Wscript.ScriptName)
WScript.Echo now & EditTitleLine(" ** " & Wscript.ScriptFullName)
WScript.Echo now & " ** ----------------------------------------------------- **"
WScript.Echo now & EditTitleLine(" ** WSH : " & Wscript.Name)
WScript.Echo now & EditTitleLine(" ** " & Wscript.FullName)
WScript.Echo now & EditTitleLine(" ** " & Wscript.Path)
WScript.Echo now & " ** ----------------------------------------------------- **"
Set objParm = WScript.Arguments
WScript.Echo now & EditTitleLine(" ** Command param count " & objParm.Count)
For i=1 To objParm.Count
WScript.echo now & EditTitleLine(" ** (" & i & ") " & objParm.Item(i - 1))
Next
WScript.Echo now & " ** ----------------------------------------------------- **"
' ネットワークオブジェクトの作成
Set objNetWork = WScript.CreateObject("WScript.Network")
' ユーザ名
WScript.echo now & EditTitleLine(" ** UserName : " & objNetWork.UserName)
' ドメイン名
WScript.echo now & EditTitleLine(" ** UserDomain : " & objNetWork.UserDomain)
' コンピュータ名
WScript.echo now & EditTitleLine(" ** ComputerName : " & GetComputer())
WScript.Echo now & " ***********************************************************"
WScript.Echo now & EditTitleLine(" ** " & msg)
WScript.Echo now & " ***********************************************************"
SetLogHeader = GetComputer()
Set objNetWork = Nothing
End Function
'****************************************************************
' 関数： EditTitleLine
' 用途： 文字列編集、所定のカラム位置に**の文字を挿入する
' 入力： 変種前文字列
' 戻値： 編集後文字列
'****************************************************************
Function EditTitleLine(chr)
Dim sEditTitleLine
Dim iMAXCOLS
iMAXCOLS = 60
sEditTitleLine = left(chr,len(chr)) & Space(iMAXCOLS-len(" **")-len(chr)) & " **"
EditTitleLine = sEditTitleLine
End Function
'****************************************************************
' 関数： GetComputer
' 用途： コンピュータ名を取得する
' 入力： 無し
' 戻値： コンピュータ名
'****************************************************************
Function GetComputer()
Dim objNetWork ' ネットワークオブジェクト
' ネットワークオブジェクトの作成
Set objNetWork = WScript.CreateObject("WScript.Network")
' コンピュータ名
GetComputer = objNetWork.ComputerName
Set objNetWork = Nothing
End Function
