' FileToBase64.vbs
' VBScript program to convert a file into a base64 encoded string.
'
' ----------------------------------------------------------------------
' Copyright (c) 2010 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - January 7, 2010
'
' Syntax:
'     cscript //nologo FileToBase64.vbs <file name> <text)
' where:
'     <file name> is the name of the file to be encoded. Include the
'         path if the file is not in the current folder. Enclose in
'         quotes if there are spaces.
'     <text> is an optional parameter indicating if the file contains
'         lines delimited by carriage return line feed sequences. The
'         default is "True" (or "T"), meaning the file can be read in
'         lines. "False" (or "F") means the file must be read all at
'         once.
' If no parameters are supplied, the program will prompt.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

Option Explicit

Dim strValue, strHexValue, strBase64
Dim strFile, objFSO, objFile, strText

Const ForReading = 1

Const B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Select Case Wscript.Arguments.Count
    Case 0
        strFile = InputBox("Enter file to be encoded", "FileToBase64.vbs")
        strText = InputBox("Enter ""T"" if the file has separate lines." _
            & vbCrLf & "Otherwise enter ""F"".", "FileToBase64.vbs", "T")
    Case 1
        strFile = Wscript.Arguments(0)
        strText = "True"
    Case 2
        strFile = Wscript.Arguments(0)
        strText = Wscript.Arguments(1)
    Case Else
        Wscript.Echo "Wrong number of arguments."
        Call Syntax()
        Wscript.Quit
End Select

' Check for syntax help.
If (strFile = "/?") _
        Or (strFile = "-?") _
        Or (strFile = "?") _
        Or (strFile = "/H") _
        Or (strFile = "/h") _
        Or (strFile = "-H") _
        Or (strFile = "-h") _
        Or (strFile = "/help") _
        Or (strFile = "-help") Then
    Call Syntax()
    Wscript.Quit
End If

If (LCase(strText) = "t") Or (LCase(strText) = "true") then
    strText = "True"
ElseIf (LCase(strText) = "f") Or (LCase(strText) = "false") then
    strText = "False"
Else
    Wscript.Echo "Invalid parameter: " & strText
    Call Syntax()
    Wscript.Quit
End If

' Open the file.
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFile, ForReading)
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "File not found or unable to open: " & strFile
    Call Syntax()
    Wscript.Quit
End If
On Error GoTo 0

' Read the file.
Do Until objFile.AtEndOfStream
    If (strText = "True") Then
        ' Read the file one line at a time.
        strValue = objFile.ReadLine
    Else
        ' Read the file all at once.
        strValue = objFile.ReadAll
    End If

    ' Convert the file into hexadecimal bytes.
    strHexValue = TextToHex(strValue)
    ' Convert the hexadecimal bytes into Base64 characters.
    strBase64 = HexToBase64(strHexValue)

    If (strText = "True") Then
        ' Output each line.
        Wscript.Echo strBase64
    Else
        ' Output Base64 encoded string in lines of 76 characters each.
        Do Until Len(strBase64) = 0
            Wscript.Echo Mid(strBase64, 1, 76)
            If (Len(strBase64) > 76) Then
                strBase64 = Right(strBase64, Len(strBase64) - 76)
            Else
                Exit Do
            End If
        Loop
    End If
Loop
objFile.Close

Function TextToHex(strText)
    ' Function to convert a text string into a string of hexadecimal bytes.
    Dim strChar, k

    TextToHex = ""
    For k = 1 To Len(strText)
        strChar = Mid(strText, k, 1)
        TextToHex = TextToHex & Right("00" & Hex(Asc(strChar)), 2)
    Next
End Function

Function HexToBase64(strHex)
    ' Function to convert a hex string into a base64 encoded string.
    ' Constant B64 has global scope.
    Dim lngValue, lngTemp, lngChar, intLen, k, j, strWord, str64, intTerm

    intLen = Len(strHex)

    ' Pad with zeros to multiple of 3 bytes.
    intTerm = intLen Mod 6
    If (intTerm = 4) Then
        strHex = strHex & "00"
        intLen = intLen + 2
    End If
    If (intTerm = 2) Then
        strHex = strHex & "0000"
        intLen = intLen + 4
    End If

    ' Parse into groups of 3 hex bytes.
    j = 0
    strWord = ""
    HexToBase64 = ""
    For k = 1 To intLen Step 2
        j = j + 1
        strWord = strWord & Mid(strHex, k, 2)
        If (j = 3) Then
            ' Convert 3 8-bit bytes into 4 6-bit characters.
            lngValue = CCur("&H" & strWord)

            lngTemp = Fix(lngValue / 64)
            lngChar = lngValue - (64 * lngTemp)
            str64 = Mid(B64, lngChar + 1, 1)
            lngValue = lngTemp

            lngTemp = Fix(lngValue / 64)
            lngChar = lngValue - (64 * lngTemp)
            str64 = Mid(B64, lngChar + 1, 1) & str64
            lngValue = lngTemp

            lngTemp = Fix(lngValue / 64)
            lngChar = lngValue - (64 * lngTemp)
            str64 = Mid(B64, lngChar + 1, 1) & str64

            str64 = Mid(B64, lngTemp + 1, 1) & str64

            HexToBase64 = HexToBase64 & str64
            j = 0
            strWord = ""
        End If
    Next
    ' Account for padding.
    If (intTerm = 4) Then
        HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 1) & "="
    End If
    If (intTerm = 2) Then
        HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 2) & "=="
    End If

End Function

Sub Syntax()
    ' Subroutine to display syntax message.
    Wscript.Echo "Syntax:"
    Wscript.Echo "  cscript //nologo FileToBase64.vbs <file name> <text>"
    Wscript.Echo "where:"
    Wscript.Echo "  <file name> is the name of a file. Include the path if"
    Wscript.Echo "      the file is not in the current folder. Enclose in quotes"
    Wscript.Echo "      if the value has embedded spaces"
    Wscript.Echo "  <text> is optional. ""True"" or ""T"" (the default) indicates"
    Wscript.Echo "      the file is text with lines separated by carriage returns."
    Wscript.Echo "      ""False"" or ""F"" means the file must be read all at once."
    Wscript.Echo "      In any case, the decoded file is assumed to be a text file."
    Wscript.Echo "For example:"
    Wscript.Echo "  cscript //nologo FileToBase64.vbs ""c:\My Folder\Test.txt"" True"
End Sub