Option Explicit
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const BinaryCompare = 0
Const TextCompare = 1
Const DatabaseCompare = 2
Dim arrCP(255)
Dim blnBreak, blnCodePage, blnIndent, blnOverWrite, blnTabConvert, blnUnicode
Dim i, intCodePage, intIndent, intTabConvert, intValidArgs
Dim objFSO, objInFile, objOutFile, objStreamIn, wshShell
Dim strCommand, strInFile, strOutFile, strScriptEnv, strTab, strText
' Check command line arguments
With WScript.Arguments
' Check for /?
If .Named.Exists( "?" ) Then
Syntax ""
End If
' Initialize counter for valid named arguments
intValidArgs = 0
' /BR = add "
" at the end of each line
If .Named.Exists( "BR" ) Then
blnBreak = True
intValidArgs = intValidArgs + 1
Else
blnIndent = False
End If
' /C:nnn = use codepage nnn for character translation
If .Named.Exists( "C" ) Then
intValidArgs = intValidArgs + 1
blnCodePage = True
If .Named( "C" ) = "" Then
intCodePage = GetCodePage( )
If intCodePage = 0 Then
Syntax "ERROR: Unable to determine current codepage"
Else
Select Case intCodePage
Case "437"
FillArrayCP437
Case "850"
FillArrayCP850
Case "858"
FillArrayCP858
Case "1252"
FillArrayCP1252
Case Else
Syntax "ERROR: Invalid codepage specified"
End Select
End If
Else
intCodePage = .Named( "C" )
Select Case intCodePage
Case "437"
FillArrayCP437
Case "850"
FillArrayCP850
Case "858"
FillArrayCP858
Case "1252"
FillArrayCP1252
Case Else
Syntax "ERROR: Invalid codepage specified"
End Select
End If
Else
blnCodePage = False
FillArrayCP1252
End If
' /I:n = indent each line with n spaces (default 8)
If .Named.Exists( "I" ) Then
blnIndent = True
intIndent = CInt( .Named( "I" ) )
If intIndent = 0 Then intIndent = 8
intValidArgs = intValidArgs + 1
Else
blnIndent = False
End If
' /T:n = replace tabs with n times " " (default 4),
' and also replace double spaces with double " "
If .Named.Exists( "T" ) Then
blnTabConvert = True
intTabConvert = CInt( .Named( "T" ) )
If intTabConvert = 0 Then intTabConvert = 4
intValidArgs = intValidArgs + 1
Else
blnTabConvert = False
End If
' /U = treat text as Unicode (default is ASCII)
If .Named.Exists( "U" ) Then
blnUnicode = True
intValidArgs = intValidArgs + 1
Else
blnUnicode = False
End If
' /Y = overwrite existing target file
If .Named.Exists( "Y" ) Then
blnOverWrite = True
intValidArgs = intValidArgs + 1
Else
blnOverWrite = False
End If
' Check if any "undefined" switches were used
If intValidArgs <> .Named.Count Then Syntax "ERROR: Invalid switches"
' Check for forbidden combination of switches
If blnCodePage And blnUnicode Then Syntax "ERROR: Switches /C and /U are mutually exclusive"
' Check the "unnamed" arguments (source and optionally target file)
Select Case .Unnamed.Count
Case 1
strInFile = .Unnamed( 0 )
Case 2
strInFile = .Unnamed( 0 )
strOutFile = .Unnamed( 1 )
Case Else
Syntax "ERROR: Invalid argument or invalid number of arguments"
End Select
End With
' Create a file system object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
With objFSO
' Abort if the source file doesn't exist
If Not .FileExists( strInFile ) Then
Syntax "ERROR: File not found: " & strInFile
End If
' If no target file was specified, we will use the file
' PATH and NAME of the source file, with a .SRC extension
If WScript.Arguments.Unnamed.Count = 1 Then
strOutFile = .BuildPath( .GetParentFolderName( strInFile ), _
.GetBaseName( strInFile ) ) & ".src"
End If
' Abort if the target file exists, unless Overwrite was specified
If .FileExists( strOutFile ) And Not blnOverWrite Then
Syntax "ERROR: File exists: " & strOutFile
End If
' Open the source file for reading and the target file for writing
Set objInFile = .GetFile( strInFile )
Set objStreamIn = objInFile.OpenAsTextStream( ForReading, blnUnicode )
Set objOutFile = .OpenTextFile( strOutFile, ForWriting, True, blnUnicode )
End With
' Read the text from the source file and close it
strText = objStreamIn.ReadAll( )
objStreamIn.Close
' Replace each "special" character in the text by its HTML entity
strText = Replace( strText, "&", "&", 1, -1, vbTextCompare )
strText = Replace( strText, "<", "<", 1, -1, vbTextCompare )
strText = Replace( strText, ">", ">", 1, -1, vbTextCompare )
strText = Replace( strText, "^", "ˆ", 1, -1, vbTextCompare )
For i = 128 To 255
If arrCP(i) <> "" Then
strText = Replace( strText, Chr(i), arrCP(i), 1, -1, vbTextCompare )
End If
Next
' Replace tabs if specified on the command line
If blnTabConvert Then
For i = 1 To intTabConvert
strTab = strTab & " "
Next
strText = Replace( strText, vbTab, strTab, 1, -1, vbTextCompare )
strTab = " "
strText = Replace( strText, " ", strTab, 1, -1, vbTextCompare )
End If
' Add indents if specified on the command line
If blnIndent Then
strText = Replace( strText, vbCrLf, vbCrLf & Space( intIndent ), 1, -1, vbTextCompare )
strText = Space( intIndent ) & strText
End If
' Add
if specified on the command line
If blnBreak Then
strText = Replace( strText, vbCrLf, _
"
" & vbCrLf, 1, -1, vbTextCompare )
End If
' Write the modified text to the target file and close the file
objOutFile.Write( strText )
objOutFile.Close
' Release the objects
Set objInFile = Nothing
Set objOutFile = Nothing
Set objFSO = Nothing
Sub Syntax( myMsg )
If myMsg <> "" Then myMsg = myMsg & vbCrLf & vbCrLf
myMsg = myMsg _
& "Txt2Src.vbs, Version 2.00" & vbCrLf _
& "Convert special characters in a text file to HTML entities" _
& vbCrLf & vbCrLf _
& "Usage: TXT2SRC source [target] [/BR] [/C[:n]] [/I:n] [/T:n] [/U] [/Y]" _
& vbCrLf & vbCrLf _
& "Where: ""source"" is the text file to be read" _
& vbCrLf _
& " ""target"" is the file which will contain the converted text" _
& vbCrLf _
& " (default is source path and name, with "".src"" extension)" _
& vbCrLf _
& " ""/BR"" add ""
"" at each line break" _
& vbCrLf _
& " ""/C[:n]"" use alternative codepage instead of 1252; valid n=437," _
& vbCrLf _
& " n=850, n=858 or n=1252, default n=current (" & GetCodePage( ) & ")" _
& vbCrLf _
& " ""/I[:n]"" indent each line with n spaces (default n=8)" _
& vbCrLf _
& " ""/T[:n]"" convert tabs to n non-breaking spaces (default n=4)" _
& vbCrLf _
& " and double spaces to double non-breaking spaces" _
& vbCrLf _
& " ""/U"" treat text as Unicode (default ASCII)" _
& vbCrLf _
& " ""/Y"" overwrite the target file if it exists" _
& vbCrLf & vbCrLf _
& "Note: Switches /C and /U are mutually exclusive." _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo myMsg
WScript.Quit 1
End Sub
Function GetCodePage( )
Dim arrCodepage, objExec, wshShell
GetCodePage = 0
Set wshShell = CreateObject( "WScript.Shell" )
Set objExec = wshShell.Exec( "%ComSpec% /C CHCP" )
Do Until objExec.Status
Wscript.Sleep 100
Loop
If objExec.StdErr.ReadAll = "" Then
arrCodepage = Split( objExec.StdOut.ReadAll, " " )
GetCodePage = CInt( arrCodepage( UBound( arrCodepage ) ) )
End If
Set objExec = Nothing
Set wshShell = Nothing
End Function
Sub FillArrayCP437
Dim i
For i = 0 To 255
arrCP(i) = ""
Next
arrCP(7) = "{BEL}"
arrCP(8) = "{Backspace}"
arrCP(9) = vbTab
arrCP(26) = "{EOF}"
arrCP(27) = "{ESC}"
arrCP(128) = "Ç"
arrCP(129) = "ü"
arrCP(130) = "é"
arrCP(131) = "â"
arrCP(132) = "ä"
arrCP(133) = "à"
arrCP(134) = "å"
arrCP(135) = "ç"
arrCP(136) = "ê"
arrCP(137) = "ë"
arrCP(138) = "è"
arrCP(139) = "ï"
arrCP(140) = "î"
arrCP(141) = "ì"
arrCP(142) = "Ä"
arrCP(143) = "Å"
arrCP(144) = "É"
arrCP(145) = "æ"
arrCP(146) = "Æ"
arrCP(147) = "ô"
arrCP(148) = "ö"
arrCP(149) = "ò"
arrCP(150) = "û"
arrCP(151) = "ù"
arrCP(152) = "ÿ"
arrCP(153) = "Ö"
arrCP(154) = "Ü"
arrCP(155) = "¢"
arrCP(156) = "£"
arrCP(157) = "¥"
arrCP(158) = "{Pts}"
arrCP(159) = "ƒ"
arrCP(160) = "á"
arrCP(161) = "í"
arrCP(162) = "ó"
arrCP(163) = "ú"
arrCP(164) = "ñ"
arrCP(165) = "Ñ"
arrCP(166) = "ª"
arrCP(167) = "º"
arrCP(168) = "¿"
arrCP(170) = "¬"
arrCP(171) = "½"
arrCP(172) = "¼"
arrCP(173) = "¡"
arrCP(174) = "«"
arrCP(175) = "»"
arrCP(224) = "α"
arrCP(225) = "ß"
arrCP(226) = "γ"
arrCP(227) = "π"
arrCP(228) = "Σ"
arrCP(229) = "σ"
arrCP(230) = "µ"
arrCP(231) = "τ"
arrCP(232) = "φ"
arrCP(233) = "Θ"
arrCP(234) = "Ω"
arrCP(235) = "δ"
arrCP(236) = "∞"
arrCP(237) = "Φ"
arrCP(238) = "ε"
arrCP(239) = "∩"
arrCP(240) = "≡"
arrCP(241) = "±"
arrCP(242) = "≥"
arrCP(243) = "≤"
arrCP(246) = "÷"
arrCP(247) = "≈"
arrCP(248) = "°"
arrCP(250) = "·"
arrCP(251) = "√"
arrCP(252) = "n"
arrCP(253) = "²"
arrCP(255) = " "
End Sub
Sub FillArrayCP850
FillArrayCP437
arrCP(155) = "ø"
arrCP(157) = "Ø"
arrCP(158) = "×"
arrCP(169) = "®"
arrCP(181) = "Á"
arrCP(182) = "Â"
arrCP(183) = "À"
arrCP(181) = "©"
arrCP(198) = "ã"
arrCP(199) = "Ã"
arrCP(207) = "¤"
arrCP(208) = "ð"
arrCP(209) = "Ð"
arrCP(210) = "Ê"
arrCP(211) = "Ë"
arrCP(212) = "È"
arrCP(213) = "ı"
arrCP(214) = "Í"
arrCP(215) = "Î"
arrCP(216) = "Ï"
arrCP(221) = "¦"
arrCP(222) = "Ì"
arrCP(224) = "Ó"
arrCP(226) = "Ô"
arrCP(227) = "Ò"
arrCP(228) = "õ"
arrCP(229) = "Õ"
arrCP(231) = "þ"
arrCP(232) = "Þ"
arrCP(233) = "Ú"
arrCP(234) = "Û"
arrCP(235) = "Ù"
arrCP(236) = "ý"
arrCP(237) = "Ý"
arrCP(238) = "¯"
arrCP(239) = "´"
arrCP(240) = "'"
arrCP(241) = "±"
arrCP(242) = "‗"
arrCP(243) = "¾"
arrCP(244) = "¶"
arrCP(245) = "§"
arrCP(247) = "¸"
arrCP(249) = "¨"
arrCP(251) = "¹"
arrCP(252) = "³"
arrCP(255) = " "
End Sub
Sub FillArrayCP858
FillArrayCP850
arrCP(213) = "€"
End Sub
Sub FillArrayCP1252
FillArrayCP437
arrCP(128) = "€"
arrCP(129) = ""
arrCP(130) = "‚"
arrCP(131) = "ƒ"
arrCP(132) = "„"
arrCP(133) = "…"
arrCP(134) = "†"
arrCP(135) = "‡"
arrCP(136) = "ˆ"
arrCP(137) = "‰"
arrCP(138) = "Š"
arrCP(139) = "‹"
arrCP(140) = "Œ"
arrCP(141) = ""
arrCP(142) = "Ž"
arrCP(143) = ""
arrCP(144) = ""
arrCP(145) = "‘"
arrCP(146) = "’"
arrCP(147) = "“"
arrCP(148) = "”"
arrCP(149) = "•"
arrCP(150) = "–"
arrCP(151) = "—"
'arrCP(152) = "˜"
arrCP(153) = "™"
arrCP(154) = "š"
arrCP(155) = "›"
arrCP(156) = "œ"
arrCP(157) = ""
arrCP(158) = "ž"
arrCP(159) = "Ÿ"
arrCP(160) = " "
arrCP(161) = "¡"
arrCP(162) = "¢"
arrCP(163) = "£"
arrCP(164) = "¤"
arrCP(165) = "¥"
arrCP(166) = "¦"
arrCP(167) = "§"
arrCP(168) = "¨"
arrCP(169) = "©"
arrCP(170) = "ª"
arrCP(171) = "«"
arrCP(172) = "¬"
arrCP(173) = ""
arrCP(174) = "®"
arrCP(175) = "¯on;"
arrCP(176) = "°"
arrCP(177) = "±"
arrCP(178) = "²"
arrCP(179) = "³"
arrCP(180) = "´"
arrCP(181) = "µ"
arrCP(182) = "¶"
arrCP(183) = "·"
arrCP(184) = "¸"
arrCP(185) = "¹"
arrCP(186) = "º"
arrCP(187) = "»"
arrCP(188) = "¼"
arrCP(189) = "½"
arrCP(190) = "¾"
arrCP(191) = "¿"
arrCP(192) = "À"
arrCP(193) = "Á"
arrCP(194) = "Â"
arrCP(195) = "Ã"
arrCP(196) = "Ä"
arrCP(197) = "Å"
arrCP(198) = "Æ"
arrCP(199) = "Ç"
arrCP(200) = "È"
arrCP(201) = "É"
arrCP(202) = "Ê"
arrCP(203) = "Ë"
arrCP(204) = "Ì"
arrCP(205) = "Í"
arrCP(206) = "Î"
arrCP(207) = "Ï"
arrCP(208) = "Ð"
arrCP(209) = "Ñ"
arrCP(210) = "Ò"
arrCP(211) = "Ó"
arrCP(212) = "Ô"
arrCP(213) = "Õ"
arrCP(214) = "Ö"
arrCP(215) = "×"
arrCP(216) = "Ø"
arrCP(217) = "Ù"
arrCP(218) = "Ú"
arrCP(219) = "Û"
arrCP(220) = "Ü"
arrCP(221) = "Ý"
arrCP(222) = "Þ"
arrCP(223) = "ß"
arrCP(224) = "à"
arrCP(225) = "á"
arrCP(226) = "â"
arrCP(227) = "ã"
arrCP(228) = "ä"
arrCP(229) = "å"
arrCP(230) = "æ"
arrCP(231) = "ç"
arrCP(232) = "è"
arrCP(233) = "é"
arrCP(234) = "ê"
arrCP(235) = "ë"
arrCP(236) = "ì"
arrCP(237) = "í"
arrCP(238) = "î"
arrCP(239) = "ï"
arrCP(240) = "ð"
arrCP(241) = "ñ"
arrCP(242) = "ò"
arrCP(243) = "ó"
arrCP(244) = "ô"
arrCP(245) = "õ"
arrCP(246) = "ö"
arrCP(247) = "÷"
arrCP(248) = "ø"
arrCP(249) = "ù"
arrCP(250) = "ú"
arrCP(251) = "û"
arrCP(252) = "ü"
arrCP(253) = "ý"
arrCP(254) = "þ"
arrCP(255) = "ÿ"
End Sub