2009/03/19

VBScriptでラクをする そにょ2b・・・


Script to HTML 改訂しました。

   s2Hcnv.zip    
▲ を、右クリックしてファイルとして保存してください。
以前のログのアーカイブも、コチラの版に更新しています。
ただ、サイト上のテキストソースはそのままなので、旧版が欲しい場合は、そっちからコピペして使ってください。

仕上がりをスグにみたいのに、以前の版では HTMLとして最低限の記述すら追記しない為、
ブログに貼るか、Head情報を追記するかしないと、確認できなかったので、
今回は、それらを追記するよう応急処置を施し、
出力ファイルを、ブラウザでそのまま検証できるようにしました。

    '***** ↓↓↓ScriptTitle↓↓↓ *********************************************************     
' Script to HTML Converter
'- Created by LazwardFox -

' スクリプト(VBS/JS)/ini/テキストファイル中の、
' [Tab]を4つのスペースに置き換える / コメントに書式を充てる
' ▼
' HTMLファイルを作成後、エディタで開く。

' Update 20090318 2125 Hedderほか、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 sHs, sHe, sTops, sHeadders, sUnders
Dim 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)
vbCts = vbCrLf & vbTs
vbCs = String(2,vbCrLf)
ltc = Split("&,l,t,;",",")
sltc = Join(ltc,"")

sHs = "<html>" & vbCt & "<head>" & vbCts & "<link rel=" & vbWq & "stylesheet" & vbWq & " type=" & vbWq & "text/css" & vbWq & " href=" & vbWq & "http://www.okitsunesama.com/Okitsunesama.css" & vbWq & ">" & vbCts & "<!-- <link rel=" & vbWq & "stylesheet" & vbWq & " type=" & vbWq & "text/css" & vbWq & " href=" & vbWq & "OkitsunesamaLabo.css" & vbWq & "> -->" & vbCts & "<title>おきつねさまのろぐてすと "
sHe = "</title>" & vbCt & "</head>" & vbCt & "<body class=" & vbWq & "CatalogView" & vbWq & ">" & vbCrLf
sTops = vbCrLf & "<table class=" & vbWq & "ScriptExp" & vbWq & "><tr class=" & vbWq & "ScriptExp" & vbWq & "><td><pre>"
sUnders = "</pre></td></tr></table>" & vbCrLf & vbCt & "</body>" & vbCrLf & "</html>"

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 ' or tE = "HTML" or tE = "HTM" then
If tE = "JS" Then
tSep = "//"
'ElseIf tE = "HTML" or tE = "HTM" Then
Else
tSep = "'"
End If
rF = Fs.GetParentFolderName(tFile)
tN = Fs.GetBaseName(tFile)
sF = Fs.BuildPath(rF,tN & " t2H " & sDt & ".html")
sHeadders = sHs & tn & "." & Lcase(tE) & sHe & sTops
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 sHeadders <> "" And rL = "" Then
Else
wL = sHeadders & " " & Replace(rL,vbTab,vbSp) & " "
rFile.WriteLine wL
sHeadders = ""
End If
Loop
rFile.WriteLine sUnders
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


また、今、コレとは別に、HTMLファイルで JavaScript/VBScript混在ソースを、同様に処理でき、
Hedder/Footer/コメント書式をiniファイルから取得するよう、更なる改訂を行っています。
<そのまま使えるVBscript VBScript JavaScript Tab 注釈 HTML 変換>

0 件のコメント:

コメントを投稿