' Base64Encoded2Image
  ' This script will create a binary image file from a base64 encoded image.
  '
  ' Usage: Drag and drop a text file onto this script.
  '
  ' Base64Encoded2Image.vbs
  ' © Robert Dunham - 12/13/2007
  ' Created by Nilpo
  ' You may use or modify this script in any way as long as this copyright remains intact.
  ' Webpage: http://www.nilpo.com/
  ' Download: http://www.nilpo.com/pub/scripts/Base64Encoded2Image.vbs

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")

strInputFile = InputFile
strContents = Base64Decoded(Base64String(strInputFile))

strOutputPath = objFso.GetParentFolderName(objFso.GetAbsolutePathName(strInputFile))
strOutputName = objFso.GetBaseName(strInputFile)
strImage = CreateOutputFile(strContents, strOutputPath, strOutputName)

strImageName = objFso.GetFileName(strImage)
strPathToImage = objFso.GetParentFolderName(strImage)

Set objFolder = objShell.NameSpace(strPathToImage)
Set objImage = objFolder.ParseName(strImageName)
objImage.InvokeVerb("Pre&view")
WScript.Sleep 5000
WScript.Quit

Function CreateOutputFile(ByRef strContents, strPath, strName)
	strOutputFile = objFso.BuildPath(strPath, strName & ".jpg")
	Set objOutputFile = objFso.CreateTextFile(strOutputFile, vbTrue)
	
	objOutputFile.Write strContents
	objOutputFile.Close
	
	CreateOutputFile = strOutputFile
End Function

Function InputFile
	Set colArgs = WScript.Arguments

	If WScript.Arguments.Count = 0 Then
		WScript.Echo "Please drop a text file onto this script."
		WScript.Quit
	End If

	For i = 0 To colArgs.Count - 1
		strTemp = strTemp & " " & colArgs(i)
	Next

	InputFile = Trim(strTemp)
End Function

Function Base64String(strInputFile)
	Set objInputFile = objFso.OpenTextFile(strInputFile)
	Do While Not objInputFile.AtEndOfStream
		strBase64 = strBase64 & objInputFile.ReadLine
	Loop
	objInputFile.Close
	
	Base64String = strBase64
End Function

Function Base64Decoded(ByVal Base64String)
	' Decodes a base-64 encoded string (BSTR type).
	' 1999 - 2004 Antonin Foller, http://www.motobit.com
	' 1.01 - solves problem with Access And 'Compare Database' (InStr)
	'rfc1521
	'1999 Antonin Foller, Motobit Software, http://Motobit.cz
	Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
	Dim dataLength, sOut, groupBegin

	'remove white spaces, If any
	Base64String = Replace(Base64String, VbCrLf, "")
	Base64String = Replace(Base64String, vbTab, "")
	Base64String = Replace(Base64String, " ", "")
	
	'The source must consists from groups with Len of 4 chars
	dataLength = Len(Base64String)
	If dataLength Mod 4 <> 0 Then
		Err.Raise 1, "Base64Decode", "Bad Base64 string."
		Exit Function
	End If

	' Now decode each group:
	For groupBegin = 1 To dataLength Step 4
		Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
		' Each data group encodes up To 3 actual bytes.
		numDataBytes = 3
		nGroup = 0

		For CharCounter = 0 To 3
			' Convert each character into 6 bits of data, And add it To
			' an integer For temporary storage.	If a character is a '=', there
			' is one fewer data byte.	(There can only be a maximum of 2 '=' In
			' the whole string.)

			thisChar = Mid(Base64String, groupBegin + CharCounter, 1)

			If thisChar = "=" Then
				numDataBytes = numDataBytes - 1
				thisData = 0
			Else
				thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
			End If
			If thisData = -1 Then
				Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
				Exit Function
			End If

			nGroup = 64 * nGroup + thisData
		Next
		
		'Hex splits the long To 6 groups with 4 bits
		nGroup = Hex(nGroup)
		
		'Add leading zeros
		nGroup = String(6 - Len(nGroup), "0") & nGroup
		
		'Convert the 3 byte hex integer (6 chars) To 3 characters
		pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
			Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
			Chr(CByte("&H" & Mid(nGroup, 5, 2)))
		
		'add numDataBytes characters To out string
		sOut = sOut & Left(pOut, numDataBytes)
	Next

	Base64Decoded = sOut
End Function