･･･おきつね鯖、また外界から断たれていた(´ﾍ｀；) 無償の鯖監視サービスの警告メールもスマホに届くのだが、眠さがキツいトキは着信音留めてて障害発生が判らない･･･ そもそも、寝てる部屋に おきつね鯖があるのだよ、にも関わらず メールでしか確認出来ナイ時点で意味が判らない状態だ(-_-;) で、接続切れたらBEEP鳴りまくるスクリプトセットを組んだ、[タスク]に 23min毎に実行する様に設定して利用する。 スクリプト自体も起動して20min程常駐、約3min毎に 違うサイトへアクセスして接続が有効かを確認、相手が落ちている可能性を考慮し、 繋がらなかった場合は 設定されている残りのサイトへのアクセスを利用し、全てが断たれていた場合に、おきつね回線の切断と識別、 おきつね鯖でBEEP音を鳴らしまくる♪ ただ、ナニが参ったって、最近はBEEPもコマンド無いのな･･･ 鳴らすだけ鳴らして ワンタッチで音を留める ただソレだけの為に スクリプトが3つ必要になる始末･･･ 折角組んだし、ココに曝しておこうかな、カナ？ で、既存流用の関数以外は 取り敢えず動くようにしてあるだけnanoだか、一部Encode済ませないと有効にならない部分が在ったり、 いつものライブラリでも 使わナイ部分を非実行にして放置していたりnanoで、あくま で 参考と云うコトで･･･(^_^;) < iPing.vbs > - 複数サイトを用いて分散的に接続が有効であるかを確認する。
'***** ↓↓↓ScriptTitle↓↓↓ ********************************************************* ' DisconnectAleart ' - Created by LazwardFox - ' ' Update ' Release ' Update ' βRelease 20121009 111709 - おきつね鯖 切断警報スクリプト、就寝時ローカル向け。 ' DevStart 20121009 081549 '***** ↓↓↓ ObjectDecralations ↓↓↓ ************************************************* Option Explicit Public My, MySh, Parameters, Fs, objMx ', objSMTP ,objADO, objSvMx Set My = WScript With My Set Parameters = .Arguments 'パラメーター取得 'If Parameters.Count <= 0 Then 'パラメータなし起動の無効化 誤操作による起動を防止 ' .Quit 'End If Set MySh = .CreateObject("WScript.Shell") Set Fs = .CreateObject("Scripting.FileSystemObject") 'ファイル制御 'Set objSMTP = .CreateObject("CDO.Message") ' SMTP Object Set objMx = .CreateObject("MSXML2.XMLHTTP") ' URL Check 'Set objADO = .CreateObject("ADODB.Stream") 'Set objSvMx = .CreateObject("Msxml2.ServerXMLHTTP") End With '***** ↓↓↓ GlobalDecralations ↓↓↓ ************************************************* 'Public Start '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' スクリプトの実行環境を取得。 ' Update 20120914 030508 - Function から DecralationSet へ 移行。 ' Release 20120913 051307 ' DevStart 20120913 031859 Public MyNameFull, MyName, MyRoot 'ThisScript MyNameFull = My.ScriptFullName MyName = Fs.GetBaseName(MyNameFull) MyRoot = Fs.GetParentFolderName(MyNameFull) '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ Const vbSp = " ", vbWq = """" ', sTitle = "Wakeup/Terminate LogSender" Public vbTc, vbCt, vbWt, vbTs, vbCs vbTc = vbTab & vbCrlf vbCt = vbCrlf & vbTab vbWt = vbWq & vbTab vbTs = String(2,vbTab) vbCs = String(2,vbCrLf) '***** ↓↓↓ exFunctionDecralations ↓↓↓ ************************************************* 'Const exProgressViewFile = "C:\Program Files\Okitsunesama\Scripts\exProgressView.vbe" 'Dim exProgress, exParameters, exResult '***** ↓↓↓ Decralations ↓↓↓ ************************************************* 'Dim cR, Pc 'Dim strDT , sPostTime 'Dim arPostTime(), strResultSet(), strSvSet() 'Dim ResultMsg, sResult 'Dim arResultSet, strReport, arResult Dim Online Dim arURL, strURL arURL = Array("https://www.google.co.jp/","http://ext.okitsunesama.com","http://akiba-pc.watch.impress.co.jp/","http://www.cman.jp/","http://japan.cnet.com/","http://okitsunesama.posterous.com/") 'iDT ,"",,"", 1, sPostTime ' 開始時刻文字列取得 (0)日付/(1)時刻 'strDT = sPostTime(0) & " " & sPostTime(1) '***** ↓↓↓MainRoutine↓↓↓ ********************************************************* 'On Error Resume Next For Each strURL in arURL Online = False Online = iPing(strURL) ' ネットワーク有効確認 My.Sleep 200 If Online Then My.Sleep 180000 ' 3min End If Next If Online Then Else Beep ' Vistaでは機能せず。 End If MyQuit '***** ↓↓↓Functions↓↓↓ ********************************************************* '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' MyQuit - 終了処理 ' - Created by LazwardFox - ' MySh ' Update ' Release ' Update ' βRelease 20120914 085236 ' DevStart 20120914 Function MyQuit() 'Set objSMTP = Nothing Set objMx = Nothing Set MySh = Nothing My.Quit End Function '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' Beep - アラームサウンドを鳴らす為のCScriptを呼び出します。 ' - Created by LazwardFox - ' cBeep.vbe ' Update ' Release ' βRelease 20121009 111709 ' DevStart 20121009 081549 Function Beep() MySh.Run "CScript cBeep.vbe",2,True End Function ' X3FManeger (fCopy) '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' iPing ' 対象URLへのアクセスの可否を返す。 ' - Created by LazwardFox - ' My, Fs, URLExist ' Update ' Update 20121009 123428 - uWaitS からの改変。 ' Release 20120731 - fWaitS からの改変。 ' Update 20091105 0228 ' βRelease 20091104 2357 ' Update 20091104 2342 nWaitMinute誤代入に対応。 ' DevStart 20091101 0155 ' シンプル版、 エラーチェックは最小限 ' iPing - TargetURLに文字列以外代入／タイムアウト で、Falseを返す。 ' ( ' TargetURL - 接続待機対象、対象サイトのURLを文字列で指定 (必須) ' ) Function iPing(strTargetURL) ', nWaitMinute) ', Result) Dim iResult iPing = (VarType(strTargetURL) = 8) ' 文字列以外拒否 If iPing Then Dim nWaitSec, wTime, qTime nWaitSec = 15 wTime = 3000 ' 3sec qTime = Now() + TimeSerial(0,0,nWaitSec) ' 未検出自動終了時間 iResult = True Do Until URLExist(strTargetURL) My.Sleep wTime If Now() > qTime Then ' タイムアウト iResult = False Exit Do End If Loop iPing = iResult End If End Function 'from fCopy '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' URLExist - 指定URLの存在を確認する。 ' - Created by LazwardFox - ' objMx ' Update 20090---- ---- ' Release 200900717 1445 Function URLExist(TargetURL) On Error Resume Next Dim exMx Set exMx = objMx With exMx .open "GET", TargetURL, False .send My.Sleep 500 If .Status = 200 Then URLExist = True Else URLExist = False End If End With Set exMx = Nothing End Function ' X3FManeger (fCopy) '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' iDT - 日時文字列 ないし 日/時配列取得 for VBScript ' - Created by LazwardFox - ' VarChk ' Update 20091103 1149 パラメータチェックを完全外部化。 ' Update 20091010 1736 文字列／シリアル値による日時指定、 ' 及び パラメータ省略に対応。 ' Update 20090228 0458 変数宣言変更 ' Update 20090223 0959 時刻桁処理変更 ' Update 20090223 0253 Len記述忘れ修正 ' Update 20090223 0135 変数宣言忘れ修正 ' Update 20090210 0218 ' Update 20090210 0115 ' Release 20090209 2035 ' iDT ( ' {tDateTime} - Serial / DateTimeStrings (省略可、既定値 - Now) ' ,{dSplitter} - DateSplitString (省略可、既定値 - "/") ' ,{dtSeparater} - Date/Time SepaleteString (省略可、既定値 - " ") ' ,{tSplitter} - TimeSplitString (省略可、既定値 - ":") ' ,{Control} - 戻り値 文字列／配列指定 0 or 1 (省略可、既定値 - 1) ' ,Result - 結果日時文字列 (省略不可) ' ) ' Memo - いずれかのSplitterに ~|" を設定すると、全ての要素が、配列として返されます。 ' iDT ,"|",,,,arDT ' → arDT = (0) YYYY / (1) MM / (2) DD / (3) HH / (4) NN / (5) SS Public Function iDT(tDateTime, dSplitter, dtSeparater, tSplitter, Control, Result) Dim vDateTime, cDateTime, nD, nS, strYMD, strHNS Dim dVal, cVar, arVar dVal = Array(Now(),"/"," ",":",1) ' 既定値配列 cVar = Array(Array(tDateTime,7,False,dVal(0)),Array(dSplitter,10,True,dVal(1)), _ Array(dtSeparater,10,True,dVal(2)),Array(tSplitter,10,True,dVal(3)), _ Array(Control,2,False,dVal(4))) arVar = VarChk(cVar) tDateTime = arVar(0) strYMD = FormatDateTime(DateValue(tDateTime),0) 'Update 20091010 1736 nS = ":" & Split(CStr(FormatDateTime(tDateTime,3)),":")(2) 'Update 20090223 0951 strHNS = FormatDateTime(tDateTime,4) & nS 'Update 20090223 0951 If arVar(3) = dVal(3) Then Else strHNS = Replace(strHNS,dVal(3),arVar(3)) End If If arVar(1) = dVal(1) Then Else strYMD = Cstr(Replace(strYMD,dVal(1),arVar(1))) End If If arVar(4) = dVal(4) Then Result = Split(strYMD & "|" & strHNS,"|") Else Result = strYMD & arVar(2) & strHNS End If End Function ' X3FManeger (fCopy) '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' VarChk ' 変数内データの確認と、既定値への置換をサポート。 ' 関数への代入パラメータ確認向け ' - Created by LazwardFox - ' Update ' Release ' βRelease 20091103 1152 ' DevStart 20091103 1014 ' VarChk - 結果を配列で返す。 ' ( ' arVar - 調査対象と条件を配列で代入する。 (省略不可) ' ) ' arVar = Array(Array(Value,VarTypes,Boolean,DefaultData),Array(Value,VarTypes,Boolean,DefaultData),・・・) ' Value - 確認対象となる値、ないし変数 ' VarTypes - VarType定数 (日時値を得る場合は、基が文字列代入であっても 8 を指定) ' Boolean - 条件の可否 ' DefaultData - 代替規定値 (データ型自由) Function VarChk(arVar) If VarType(arVar) >= 8192 Then ReDim iResult(UBound(arVar)) Dim Pc, iVar, cVar ,vVar, vDT, cDT Pc = 0 For Each iVar In arVar cVar = VarType(iVar) >= 8192 And Ubound(iVar) = 3 If cVar Then cVar = VarType(iVar(1)) = 2 And VarType(iVar(2)) = 11 If cVar Then If iVar(1) = 8 Then vDT = VarType(iVar(0)) cDT = vDT <> 10 And (vDT = 7 Or (vDT = 8 And IsDate(iVar(0)))) If cDT Then ' シリアル値／日時文字列 識別 iResult(Pc) = DateValue(iVar(0)) + TimeValue(iVar(0)) Else iResult(Pc) = iVar(3) ' Now() End If Else vVar = VarType(iVar(0)) If iVar(2) = (vVar = iVar(1)) Then iResult(Pc) = iVar(3) Else iResult(Pc) = iVar(0) End If End If End If End If Pc = Pc + 1 Next End If VarChk = iResult End Function |
'***** ↓↓↓ScriptTitle↓↓↓ ********************************************************* ' AleartDisplay ' - Created by LazwardFox - ' ' Update ' Release ' Update ' βRelease 20121009 111709 - おきつね鯖 切断警報スクリプト、就寝時ローカル向け。 ' DevStart 20121009 081549 '***** ↓↓↓ ObjectDecralations ↓↓↓ ************************************************* Option Explicit Public My, MySh ', Parameters, Fs, objMx, objSMTP ,objADO, objSvMx Set My = WScript With My 'Set Parameters = .Arguments 'パラメーター取得 'If Parameters.Count <= 0 Then 'パラメータなし起動の無効化 誤操作による起動を防止 ' .Quit 'End If Set MySh = .CreateObject("WScript.Shell") 'Set Fs = .CreateObject("Scripting.FileSystemObject") 'ファイル制御 'Set objSMTP = .CreateObject("CDO.Message") ' SMTP Object 'Set objMx = .CreateObject("MSXML2.XMLHTTP") ' URL Check 'Set objADO = .CreateObject("ADODB.Stream") 'Set objSvMx = .CreateObject("Msxml2.ServerXMLHTTP") End With '***** ↓↓↓ GlobalDecralations ↓↓↓ ************************************************* Const vbSp = " ", vbWq = """" ', sTitle = "Wakeup/Terminate LogSender" Public vbTc, vbCt, vbWt, vbTs, vbCs vbTc = vbTab & vbCrlf vbCt = vbCrlf & vbTab vbWt = vbWq & vbTab vbTs = String(2,vbTab) vbCs = String(2,vbCrLf) '***** ↓↓↓ exFunctionDecralations ↓↓↓ ************************************************* 'Const exProgressViewFile = "C:\Program Files\Okitsunesama\Scripts\exProgressView.vbe" 'Dim exProgress, exParameters, exResult '***** ↓↓↓ Decralations ↓↓↓ ************************************************* 'Dim cR, Dim Pc 'Dim strDT, sPostTime 'Dim arPostTime(), strResultSet(), strSvSet() 'Dim ResultMsg, sResult 'Dim arResultSet, strReport, arResult 'Dim Online 'Dim tgtSet Dim strBeep, exBeep 'iDT ,"",,"", 1, sPostTime ' 開始時刻文字列取得 (0)日付/(1)時刻 'strDT = sPostTime(0) & " " & sPostTime(1) '***** ↓↓↓MainRoutine↓↓↓ ********************************************************* 'On Error Resume Next With My For Pc = 1 to 8 strBeep = strBeep & Chr(7) Next Set exBeep = exScript("iBeep.vbe","") ' 進捗メッセージを外部プロセスで表示 .Sleep 200 Do Until exBeep.Status = 1 .Echo strBeep .Sleep 200 Loop Set exBeep = Nothing End With MyQuit '***** ↓↓↓Functions↓↓↓ ********************************************************* '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' MyQuit - 終了処理 ' - Created by LazwardFox - ' MySh ' Update ' Release ' Update ' βRelease 20120914 085236 ' DevStart 20120914 Function MyQuit() 'Set objSMTP = Nothing 'Set objMx = Nothing Set MySh = Nothing My.Quit End Function ' exPopup '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ ' exScript ' 外部スクリプトを、リモート制御可能なオブジェクトとして起動する。 ' - Created by LazwardFox - ' MySh ' Update ' Release ' Update ' βRelease CScript向けに訂正。 ' αRelease 20100120 2007 汎用化/エラー回避不可の暫定版 ' DevStart 20100120 1549 進捗メッセージウィンドウとしてexPopupを呼び出す向きとして･･･ ' exScript - ' ( ' strScript - 起動対象となるスクリプトのファイル名を指定。 ' ,strParameters - パラメータをカンマ区切りにした、１つの文字列で指定。 ' ) Public Function exScript(strScript, strParameters) Set exScript = MySh.Exec("cscript.exe " & vbWq & strScript & vbWq)' & " " & vbWq & strParameters & vbWq) End Function |
Option Explicit
' for CScript - 20121009 081549
Dim My, MySh
Set My = WScript
With My
Set MySh = .CreateObject("WScript.Shell")
MySh.Popup "Aleart!! ",,"Information",48
End With |
0 件のコメント:
コメントを投稿
注: コメントを投稿できるのは、このブログのメンバーだけです。