VBScriptでラクをする そにょ２･･･

VB/JavaScript作成は、フリーのテキストエディタ VxEditorを利用させてもらっている。
拡張子毎に、表示条件を設定できるのも便利だ。
ちなみに当方のVBScript向け設定は、以下アーカイブ内のファイルで再現できる。

   VxEditor - VBScript.zip    
▲ を、右クリックしてファイルとして保存してください。


また、記述の際、自分で処理を追いやすくする為、Tabを結構多用する。コメントもまた然りだ。
それらをVXの見た目のまま サイトうpするのには、手作業では結構手間だ。

そもそもBloggerでは、Tabがスペースに置換されてしまうし、
ああいったコードを使うのは、閲覧者サイドの環境にも依存してしまう･･･

で、少し前に、Tabを4つのスペースに置き換えるだけのスクリプトを組んだ。
ドロップすれば、日時付きファイル名で、処理済ファイルが出来た。

だが、コメント部分に書式を割り当てたいと欲が出た。
しかし、これも手作業では結構難だ･･･

そこで、今しがた、前述のスクリプトを改良して出来上がったのが、
   s2Hcnv.zip    
▲ を、右クリックしてファイルとして保存してください。

実のトコ、デバッグ中に、思わぬ難があった。
まず、' クォーテーション、VBScriptでのコメントを表すアレだ。
ｺｲｼをInStrで単純走査した結果で書式充てを処理したら、
実行処理内の文字列としてのクォーテーション"'"でまで、コメント向け書式を充ててしまう結果に･･･(-_-;)
結局Do～Loopで、' と "'" を探す処理を繰り返して、差異を検知して回避した。

次に変換ソース、スクリプトを主にターゲットとして作成したとは云え、
文字列としてHTMLタグが入る可能性は大きい、つか、今回のモノがそうだった･･･(´ﾍ｀；)
で、試行錯誤の後、対策として、< を HTMLコードに置換するように変えてみた･･･ 一見スゴく良かったのだが、
逆に、このHTMLコード自体を、そのままの見た目で必要とする部分に表記できない と云うジレンマが･･･(ﾟДﾟ;)

今回は、このスクリプト自身も完全に変換できるようにしたいっっ! と、云うコトで、
少し無駄だが、変数宣言部に
    ltc = Split("&,l,t,;",",")     
    sltc = Join(ltc,"")     
を、追加して対応、目的達成と相成った。

また、このスクリプトを利用して作成されたテキストを利用する際には、
対象となるサイトに、以下のようなスタイルシートの記述が必要になる。
(様式は任意で変更してもらってイイと思う)
    <style type="text/css">     
         
        .ScriptExp     
            {     
                background-color: #FFFFFF;     
                border: 0;     
                align: center;     
                color: #1e50a2;     
                line-height: 100%;     
            }     
        .ScriptComments     
            {     
                font-weight: normal;         
                color: #FFFFFF;     
                background-color: #288285;     
                border: 0;     
            }     
         
    </style>     



今回も、既出でない関数を追加した
レジストリから、既定のテキストエディタのパスを取得するだけのモノ･･･
    '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
    'TextViwer - テキストファイルを開く既定アプリケーションをフルパスで返します。     
    '- Created by LazwardFox -     

        ' Release 20090315 2053     
        ' DevStart 20090315 0938     
                 
        TextViewer(
                  ResultKey      既定のテキストエディタのパスをレジストリより取得し返します。     
                                 任意の変数を割り当ててください。
                  )     

確かに、こんな面倒な手順を踏まなくとも、rundll32 url.dll で、処理すれば、
適切なアプリケーションで勝手に開いてくれるのだが、前ログのフォルダの例も含め、
通常開くアプリケーションを変更している向きには、意外に使いが悪い場合もあったり、
その逆もまた然り だったりで、こういう処理方法のほうが適切な場合が多い。
なので少し面倒だが、レジストリから読み出すことにした。

と、前置きが長かったが、本体ソースは以下参照。今まで通り アーカイブのvbsファイルの内容そのもの。
    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
        ' Script to HTML Converter     
        '- Created by LazwardFox -     
         
        ' スクリプト(VBS/JS)/ini/テキストファイル中の、     
        ' [Tab]を４つのスペースに置き換える ／ コメントに書式を充てる     
        '                    ▼                         
        ' HTMLファイルを作成後、エディタで開く。     
             
            ' Update 20090317 1424 font設定が正しく適用されないBlogger対策      
            ' Update 20090317 1311 JavaScript→HTML変換に対応     
            ' Update 20090317 0928 コメント処理修正     
            ' Update 20090317 0201 Tab to 4 Space Converter から名称変更     
            ' Update 20090317 0201 本文中の"'"を無視するよう変更     
            ' Update 20090317 0146 Headder/Footerを追記し、     
                                 ' コメント部分に書式を割り当てる処理を追加。     
            ' Update 20090315 2053     
            ' Release 20090313 1855 発行     
            ' DevStart 20090313 1736     
         
    '***** ↓↓↓ ObjectDecralations ↓↓↓ *************************************************     
        Dim Parameters, WSHShell, Fs     
         
        Set Parameters = WScript.Arguments 'パラメーター取得     
        If Parameters.Count <= 0 Then     
            Wscript.Quit     
        End If     
        Set WSHShell = WScript.CreateObject("WScript.Shell")     
        Set Fs = WScript.CreateObject("Scripting.FileSystemObject") 'ファイル操作     
         
    '***** ↓↓↓Decralations↓↓↓ *********************************************************     
        Const vbWq = """"     
        Dim vbSp, vbTc, vbCt, vbWt, vbTs, vbCs     
        Dim sDt, iC, nS, rF, tN, tE, tSep, sF, tFile, sFile, rFile     
        Dim sHeadder, sFooter, hColor, fColor, rL,ltc, sltc, fQp, iQp, isQp, isQpc, lrL, nrL, rrL, wL     
         
        vbSp = "    "     
        vbTc = vbTab & vbCrlf     
        vbCt = vbCrlf & vbTab     
        vbWt = vbWq & vbTab     
        vbTs = String(2,vbTab)      
        vbCs = String(2,vbCrLf)     
        ltc = Split("&,l,t,;",",")     
        sltc = Join(ltc,"")     
        sHeadder = "<table class=" & vbWq & "ScriptExp" & vbWq & "><tr class=" & vbWq & "ScriptExp" & vbWq & "><td><pre>"     
        sFooter = "</pre></td></tr></table>"     
        hColor = "<a class=" & vbWq & "ScriptComments" & vbWq & "><font color=" & vbWq & "#ffffff" & vbWq & ">"     
        fColor = "</Font></a>"         
         
    '***** ↓↓↓MainRoutine↓↓↓ *********************************************************     
        For iC = 0 To Parameters.count - 1     
            tFile = Parameters(iC)     
            If Fs.FileExists(tFile) then     
                sDt = iDT(""," ","",0)     
                nS = Fs.GetFile(tFile).size     
                If nS < 1 Then     
                Else     
                    tE = Ucase(Fs.GetExtensionName(tFile))     
                    If tE = "VBS" or tE = "TXT" or tE = "INI" or tE = "JS" then     
                        If tE = "JS" Then     
                            tSep = "//"     
                        Else     
                            tSep = "'"     
                        End If     
                        rF = Fs.GetParentFolderName(tFile)     
                        tN = Fs.GetBaseName(tFile)     
                        sF = Fs.BuildPath(rF,tN & " t2H " & sDt & ".html")     
                        Set sFile = Fs.OpenTextFile(tFile,1) 'Sourceファイルを読み取りモードで開く     
                        Set rFile = Fs.CreateTextFile(sF,0) 'Resultファイルを追記モードで開く     
                        WScript.Sleep 200     
                        Do Until sFile.AtEndOfStream      
                            rL = sFile.ReadLine '行読み込み     
                            rL = Replace(rL,"<",sltc) '不等号 < を HTMLコードに置き換え     
                            fQp = InStr(1,rL,tSep) '最左クォーテーション(以後q)位置     
                            iQp = 0     
                            isQp= 1     
                            isQpc = 1     
                            If fQp > 0 Then '行内のq有     
                                If fQp = 1 Then '行頭にq     
                                    rL = hColor & rL & fColor     
                                Else '行頭以外にq     
                                    Do     
                                        iQp = InStr(isQp + 1,rL,tSep)     
                                        isQp = InStr(isQpc + 1,rL,vbWq & tSep & vbWq) + 1 '文字列表記のq有無     
                                        If isQp = 0 Then     
                                            Exit Do     
                                        End If     
                                        isQpc = isQp     
                                    Loop While iQp = isQp     
                                    If iQp > 0 Then     
                                    lrL = Left(rL,iQp - 1)     
                                    nrL = Len(rL) - iQp      
                                    rrL = Right(rL,nrL + 1)     
                                    rL = lrL & hColor & rrL & fColor     
                                    End If     
                                End If     
                            End If     
                            If sHeadder <> "" And rL = "" Then     
                            Else     
                                wL = sHeadder & "    " & Replace(rL,vbTab,vbSp) & "     "     
                                rFile.WriteLine wL     
                                sHeadder = ""     
                            End If     
                        Loop     
                        rFile.WriteLine sFooter     
                        WScript.Sleep 200     
                        sFile.Close 'Sourceファイルを閉じる     
                        rFile.Close 'Resultファイルを閉じる     
                        TextViewer tTV     
                        If tTV = "NotSetting" Then     
                            MsgBox "Converted",vbYesNo,"Script to HTML Converter"     
                        Else     
                            WSHShell.Run tTV & vbWq & sF & vbWq, 1     
                            Wscript.Sleep 1000     
                        End If     
                    End If     
                End If     
            End If     
        Next     
        Set Parameters = Nothing     
        Set Fs = Nothing     
        Set WSHShell = Nothing     
        Wscript.Quit     
             
    '***** ↓↓↓Functions↓↓↓ *********************************************************     
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'TextViwer - テキストファイルを開く既定アプリケーションをフルパスで返します。     
        '- Created by LazwardFox -     
             
            ' Release 20090315 2053     
            ' DevStart 20090315 0938     
                 
        Function TextViewer(ResultKey)     
            Dim sTV     
            Const RegKey = "HKCR\txtfile\shell\open\command\"     
            sTV = WSHShell.RegRead(RegKey)     
            sTV = Replace(sTV, " " & vbWq & "%1" & vbWq, "")     
            If Fs.FileExists(sTV) Then     
                ResultKey = sTv & " "     
            Else     
                ResultKey = "NotSetting"      
            End If     
        End Function     
         
        '－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－     
        'iDT - 日時文字列 ないし 日/時配列取得 for VBScript     
        '- Created by LazwardFox -     
         
            ' Update 20090228 0458 変数宣言変更     
            ' Update 20090223 0959 時刻桁処理変更     
            ' Update 20090223 0253 Len記述忘れ修正     
            ' Update 20090223 0135 変数宣言忘れ修正     
            ' Update 20090210 0218     
            ' Update 20090210 0115     
            ' Release 20090209 2035     
         
            '    iDT (     
            '     dSplitter - DateSplitString             (Normal - "/")     
            '    ,dtSeparater - Date/Time SepaleteString (Normal - " ")     
            '    ,tSplitter - TimeSplitString             (Normal - ":")     
            '    ,Control - 文字列 0 or 配列 1            (Default - 1)     
            '    )     
         
        Public Function iDT(dSplitter,dtSeparater,tSplitter,Control)     
            Dim nX, nD, nS, strHMS, sResult 'Update 20090228 0458     
            nX = Now()     
            nD = FormatDateTime(Date(),0)     
            nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2)     'Update 20090223 0951     
            strHMS = FormatDateTime(nX,4) & nS                      'Update 20090223 0951     
            If tSplitter = ":" Then     
            Else     
                strHMS = Replace(strHMS,":",tSplitter)     
            End If     
            sResult = Cstr(Replace(nD,"/",dSplitter)) & "*" & strHMS     
            If Control = 1 Then     
                iDT = Split(sResult,"*")     
            Else     
                iDT = Replace(sResult,"*",dtSeparater)                 
            End If     
        End Function     


しかし、JavaScript使いには向かないモノになってるっポイ。
と云うのも、文字列を表すときにシングルクォーテーション使われたらドウにもナリません(´ﾍ｀；)
元々、VBS向けに作成したワケだし･･･
当方みたく、JSでも、ダブルクォーテーション使うって向きなら問題ナシ。

まぁ、このスクリプト中の 検出用のクォーテーションを // に差し替えればJSでも使えるケド･･･
アトで その機能追加しようカナ、拡張子で分岐して･･･

結局、スグに拡張してしまった^_^;
多分問題なく動く･･･ハズw
＜そのまま使えるVBscript スクリプト HTML 公開化 変換 pre＞