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") 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>" 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) Set rFile = Fs.CreateTextFile(sF,0) WScript.Sleep 200 Do Until sFile.AtEndOfStream rL = sFile.ReadLine rL = Replace(rL,"<",sltc) fQp = InStr(1,rL,tSep) iQp = 0 isQp= 1 isQpc = 1 If fQp > 0 Then If fQp = 1 Then rL = hColor & rL & fColor Else Do iQp = InStr(isQp + 1,rL,tSep) isQp = InStr(isQpc + 1,rL,vbWq & tSep & vbWq) + 1 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 rFile.Close 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 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 Public Function iDT(dSplitter,dtSeparater,tSplitter,Control) Dim nX, nD, nS, strHMS, sResult nX = Now() nD = FormatDateTime(Date(),0) nS = ":" & Split(CStr(FormatDateTime(nX,3)),":")(2) strHMS = FormatDateTime(nX,4) & nS 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
|