2012/10/09

寝た後に・・・

・・・おきつね鯖、また外界から断たれていた(´ヘ`;)

無償の鯖監視サービスの警告メールもスマホに届くのだが、眠さがキツいトキは着信音留めてて障害発生が判らない・・・
そもそも、寝てる部屋に おきつね鯖があるのだよ、にも関わらず メールでしか確認出来ナイ時点で意味が判らない状態だ(-_-;)

で、接続切れたら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     
< cBeep.vbs > 音を鳴らす本体、但しWScriptでは無くCScriptで実行しないと機能しない
    '***** ↓↓↓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 -  パラメータをカンマ区切りにした、1つの文字列で指定。     
            '            )      
         
        Public Function exScript(strScript, strParameters)      
            Set exScript = MySh.Exec("cscript.exe " & vbWq & strScript & vbWq)' & " " & vbWq & strParameters & vbWq)     
        End Function     
< iBeep.vbs > - エラー報告/BEEP停止制御用Popup
    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     
って、コレ、前述の通り、指定されているファイル名の関係で このまま .vbsファイルにしても機能しません。 WindowsScriptEncoderで、.vbeファイルに変換する必要があります・・・ ってのもナンnanoで、 ソースとEncode済みを纏めて Archiveしました → < iPing.zip > Archive内の .vbeファイルを同じフォルダにレイアウトして、iPing.vbe を 実行すると 正しく機能します。 ただ、Visたん機では音が鳴らなかったので、環境に依存するトコロが少なくナイ模様。 ・・・ソンなに 接続が不安なISPを使ってるヒトも少ないと思うので、殆ど需要の無いシリーズだろうね(爆

0 件のコメント:

コメントを投稿