'************************************************************
' bintob64.vbs converts binary file to base64-encoded file
' drag and drop some files or specify by command line.
'
' 				M. Gallant  07/23/2002
'************************************************************

Option Explicit

Const Title = "bintob64"
Const prefix = "_b64_"   'base64-encoded output file prefix
Const ForReading = 1, ForWriting = 2
Const CAPICOM_LOCAL_MACHINE_STORE = 1
Const CAPICOM_STORE_OPEN_READ_ONLY = 0
Const CAPICOMdnld = "http://www.microsoft.com/downloads/release.asp?ReleaseID=39546"
Dim oStore, oUtils, ofso, oFile
Dim i, fileargs, bfiledata, bstrfiledata, encString, parentpath, b64outfile

' Check syntax.
If Wscript.Arguments.Count <1  Then
    MsgBox "Usage:    bintob64.vbs   binfile1    [binfile2] .... ", _
	vbInformation, Title
    WScript.Quit(1)
End If

If NOT isCapicomAvailable Then
   MsgBox "CAPICOM is not installed." & vbCrLf & _
	"Install capicom first via: " & vbCrLf & _
	CAPICOMdnld, vbCritical, Title
  WScript.Quit(1)
End If


Set fileargs = WScript.Arguments
Set oUtils = CreateObject("CAPICOM.Utilities")
Set ofso = CreateObject("Scripting.FileSystemObject")

On Error Resume Next   
For i = 0 to fileargs.Count -1      'Get all files passed (or drag/dropped).
 If  FileExists(fileargs(i)) Then  'continue for vbs to ignore non-file items
  Set oFile = ofso.GetFile(fileargs(i))
  parentpath = ofso.GetParentFolderName(oFile) & "\"
  b64outfile = parentpath & prefix & ofso.getBaseName(oFile.Name)

  LoadBinFile fileargs(i), bfiledata   'get file content into byte array
  bstrfiledata = oUtils.ByteArrayToBinaryString(bfiledata)   ' convert to bstr
  encString = oUtils.Base64Encode(bstrfiledata)   'base64 encode

  If Err.Number <> 0 Then
    MsgBox "Could NOT encode the file " & fileargs(i) & vbCrLf & _
	 "Error: " & Hex(Err.Number) & "  " & Err.Description, vbCritical, Title
    Err.clear
   Else
    SaveFile b64outfile, encString  'since base64 is text, save with fso
    MsgBox "Encoded and wrote base64 file:  " & b64outfile, vbInformation, Title
  End If

 End If   'FileExists test
Next

Set oUtils = nothing
Set ofso = nothing
WScript.Quit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' isCapicomAvailable
'
' Checks if CAPICOM is installed
'
Function isCapicomAvailable()
 Dim oStore
 On Error Resume Next
 Set oStore = CreateObject("CAPICOM.Store")
 oStore.Open CAPICOM_LOCAL_MACHINE_STORE, "Root", CAPICOM_STORE_OPEN_READ_ONLY
 If Err.Number <> 0 Then
  isCapicomAvailable = False
  Exit Function
 End If
 isCapicomAvailable = True
 Set oStore = Nothing
 On Error GoTo 0
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' FileExists
'
' Checks if file exists (it not, it might be directory, or shorcut etc..)
'
Function FileExists(FileName)
 Dim fso
 Set fso = CreateObject("Scripting.FileSystemObject")
 If Not fso.FileExists(FileName) Then
   FileExists = False
   Exit Function
 End If
 FileExists = True
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' SaveFile
'
' Save string Buffer to FileName.
'
Sub SaveFile (FileName, Buffer)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim ts
    Set ts = fso.OpenTextFile(FileName, ForWriting, True)
    ts.Write Buffer
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' LoadBinFile
'
' Read content of FileName and return as byte array.
'
Sub LoadBinFile (FileName, bBuffer)   
  Const adReadAll = -1
  Dim oStream, bFileData
  Set oStream = WScript.CreateObject("ADODB.Stream")
  oStream.Open
  oStream.Type = 1  ' adTypeBinary
  oStream.LoadFromFile FileName
  bBuffer = oStream.Read(adReadAll)
  oStream.Close
  Set oStream = nothing
End Sub