Option Explicit
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const BinaryCompare = 0
Const TextCompare = 1
Const DatabaseCompare = 2
Dim blnBreak, blnIndent, blnOverWrite, blnTabConvert, blnUnicode
Dim i, 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
' /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 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
' Check if the script is running in WSCRIPT.EXE, and if
' so, run it in CSCRIPT.EXE to use the proper Code Page.
If InStr( LCase( WScript.FullName ), "\wscript.exe" ) Then
Set wshShell = CreateObject( "WScript.Shell" )
strCommand = """" & WScript.ScriptFullName & """"
For i = 0 To WScript.Arguments.Count - 1
If Left( WScript.Arguments(i), 1 ) = "/" Then
strCommand = strCommand & " " & WScript.Arguments(i)
Else
If InStr( WScript.Arguments(i), " " ) Then
strCommand = strCommand & " """ & WScript.Arguments(i) & """"
Else
strCommand = strCommand & " " & WScript.Arguments(i)
End If
End If
Next
wshShell.Run "CSCRIPT.EXE //NoLogo " & strCommand, 1, True
WScript.Quit
End If
' 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 all "special" characters in the text by their HTML code
strText = Replace( strText, "&", "&", 1, -1, vbBinaryCompare )
strText = Replace( strText, "<", "<", 1, -1, vbBinaryCompare )
strText = Replace( strText, ">", ">", 1, -1, vbBinaryCompare )
strText = Replace( strText, """", """, 1, -1, vbBinaryCompare )
strText = Replace( strText, "^", "ˆ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "~", "˜", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¨", "¨", 1, -1, vbBinaryCompare )
strText = Replace( strText, "´", "´", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¸", "¸", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¡", "¡", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¿", "¿", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¢", "¢", 1, -1, vbBinaryCompare )
strText = Replace( strText, "£", "£", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¤", "¤", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¥", "¥", 1, -1, vbBinaryCompare )
strText = Replace( strText, "€", "€", 1, -1, vbBinaryCompare )
strText = Replace( strText, "§", "§", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¶", "¶", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ª", "ª", 1, -1, vbBinaryCompare )
strText = Replace( strText, "º", "º", 1, -1, vbBinaryCompare )
strText = Replace( strText, "«", "«", 1, -1, vbBinaryCompare )
strText = Replace( strText, "»", "»", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¬", "¬", 1, -1, vbBinaryCompare )
strText = Replace( strText, "", "", 1, -1, vbBinaryCompare )
strText = Replace( strText, "©", "©", 1, -1, vbBinaryCompare )
strText = Replace( strText, "®", "®", 1, -1, vbBinaryCompare )
strText = Replace( strText, "™", "™", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¯", "¯", 1, -1, vbBinaryCompare )
strText = Replace( strText, "°", "°", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¹", "¹", 1, -1, vbBinaryCompare )
strText = Replace( strText, "²", "²", 1, -1, vbBinaryCompare )
strText = Replace( strText, "³", "³", 1, -1, vbBinaryCompare )
strText = Replace( strText, "·", "·", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¼", "¼", 1, -1, vbBinaryCompare )
strText = Replace( strText, "½", "½", 1, -1, vbBinaryCompare )
strText = Replace( strText, "¾", "¾", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Á", "Á", 1, -1, vbBinaryCompare )
strText = Replace( strText, "á", "á", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Â", "Â", 1, -1, vbBinaryCompare )
strText = Replace( strText, "â", "â", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ä", "Ä", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ä", "ä", 1, -1, vbBinaryCompare )
strText = Replace( strText, "À", "À", 1, -1, vbBinaryCompare )
strText = Replace( strText, "à", "à", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Å", "Å", 1, -1, vbBinaryCompare )
strText = Replace( strText, "å", "å", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ã", "Ã", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ã", "ã", 1, -1, vbBinaryCompare )
strText = Replace( strText, "æ", "æ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Æ", "Æ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ç", "Ç", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ç", "ç", 1, -1, vbBinaryCompare )
strText = Replace( strText, "É", "É", 1, -1, vbBinaryCompare )
strText = Replace( strText, "é", "é", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ê", "Ê", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ê", "ê", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ë", "Ë", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ë", "ë", 1, -1, vbBinaryCompare )
strText = Replace( strText, "È", "È", 1, -1, vbBinaryCompare )
strText = Replace( strText, "è", "è", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Í", "Í", 1, -1, vbBinaryCompare )
strText = Replace( strText, "í", "í", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Î", "Î", 1, -1, vbBinaryCompare )
strText = Replace( strText, "î", "î", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ï", "Ï", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ï", "ï", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ì", "Ì", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ì", "ì", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ñ", "Ñ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ñ", "ñ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ó", "Ó", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ó", "ó", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ô", "Ô", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ô", "ô", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ö", "Ö", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ö", "ö", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ò", "Ò", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ò", "ò", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Õ", "Õ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "õ", "õ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ø", "Ø", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ø", "ø", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ß", "ß", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ú", "Ú", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ú", "ú", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Û", "Û", 1, -1, vbBinaryCompare )
strText = Replace( strText, "û", "û", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ü", "Ü", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ü", "ü", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ù", "Ù", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ù", "ù", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ÿ", "Ÿ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ÿ", "ÿ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ý", "Ý", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ý", "ý", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Ð", "Ð", 1, -1, vbBinaryCompare )
strText = Replace( strText, "ð", "ð", 1, -1, vbBinaryCompare )
strText = Replace( strText, "Þ", "Þ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "þ", "þ", 1, -1, vbBinaryCompare )
strText = Replace( strText, "±", "±", 1, -1, vbBinaryCompare )
strText = Replace( strText, "×", "×", 1, -1, vbBinaryCompare )
strText = Replace( strText, "÷", "÷", 1, -1, vbBinaryCompare )
strText = Replace( strText, "µ", "µ", 1, -1, vbBinaryCompare )
' 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, vbBinaryCompare )
strtab = " "
strText = Replace( strText, " ", strTab, 1, -1, vbBinaryCompare )
End If
' Add indents if specified on the command line
If blnIndent Then
strText = Replace( strText, vbCrLf, _
vbCrLf & Space( intIndent ), 1, -1, vbBinaryCompare )
strText = Space( intIndent ) & strText
End If
' Add
if specified on the command line
If blnBreak Then
strText = Replace( strText, vbCrLf, _
"
" & vbCrLf, 1, -1, vbBinaryCompare )
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 1.20" & vbCrLf _
& "Convert special characters in a text file to HTML code" _
& vbCrLf & vbCrLf _
& "Usage: TXT2SRC source_file [target_file] [/BR] " _
& "[/I:n] [/T:n] [/U] [/Y]" & vbCrLf & vbCrLf _
& "Where: ""source_file"" is the text file to be read" _
& vbCrLf _
& " ""target_file"" is the file which will contain the converted text" _
& vbCrLf _
& " (default is source_file name with .src extension)" _
& vbCrLf _
& " ""/BR"" add ""
"" at each line break" _
& 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: This script must be run in CSCRIPT.EXE to use the right Code Page." _
& vbCrLf _
& " If it finds itself running in WSCRIPT.EXE, it will restart itself" _
& vbCrLf _
& " with CSCRIPT.EXE in a new window." _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo myMsg
' In CSCRIPT.EXE, wait 10 seconds to allow people to read the message
If InStr( LCase( WScript.FullName ), "\cscript.exe" ) Then
WScript.Sleep 10000
End If
WScript.Quit 1
End Sub