Source code for b64coder.vbs

(view source code of b64coder.vbs as plain text)

Option Explicit
 
Dim errResult
 
WScript.Echo "Base64 encoding . . ."
errResult = Base64Encode( "b64coder.vbs", "b64coder.enc" )
If errResult <> 0 Then
	ShowError errResult
End If
 
WScript.Echo "Decoding again . . ."
errResult = Base64Decode( "b64coder.enc", "b64coder.dec" )
If errResult <> 0 Then
	ShowError errResult
Else
	WScript.Echo "Done." & vbCrLf _
	           & "Compare the files ""b64coder.vbs"" and " _
	           & """b64coder.dec"", they should be identical."
End If
 
 
Sub ShowError( myError )
	On Error Resume Next
	Err.Raise myError
	WScript.Echo "ERROR " & Err.Number & ": " & Err.Description
	Err.Clear
	On Error Goto 0
	WScript.Quit
End Sub
 
 
Function Base64Encode( myFileIn, myFileOut )
' This function uses Belus Technology's XBase64 component to Base64 encode a file.
' The XBase64 component is available at
' http://www.xstandard.com/page.asp?p=F5096C20-DF8F-4FAA-A1A5-CC85A934139A
'
' Arguments:
' myFileIn   [string]  the file to be encoded
' myFileOut  [string]  the encoded file to be created
'
' Return Code:
' 0 if all goes well, otherwise the appropriate error number
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
 
	' Standard housekeeping
	Dim i, objBase64, objFSO, objFileIn, objFileOut
	Dim objStreamIn, strCode, strText
 
	Const ForAppending       =  8
	Const ForReading         =  1
	Const ForWriting         =  2
	Const TristateFalse      =  0
	Const TristateMixed      = -2
	Const TristateTrue       = -1
	Const TristateUseDefault = -2
	Const otSafeArray        =  0
	Const otString           =  2
 
	' Use custom error handling
	'On Error Resume Next
 
	' Open a file system object
	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
 
	' Open the input file if it exists
	If objFSO.FileExists( myFileIn ) Then
		Set objFileIn   = objFSO.GetFile( myFileIn )
		Set objStreamIn = objFileIn.OpenAsTextStream( ForReading, TriStateFalse )
	Else
		' Error 53: File not found
		Base64Encode = 53
		' Close input file and release objects
		objStreamIn.Close
		Set objStreamIn = Nothing
		Set objFileIn   = Nothing
		Set objFSO      = Nothing
		' Abort
		Exit Function
	End If
 
	' Create the output file, unless it already exists
	If objFSO.FileExists( myFileOut ) Then
		' Error 58: File already exists
		Base64Encode = 58
		' Close input file and release objects
		objStreamIn.Close
		Set objStreamIn = Nothing
		Set objFileIn   = Nothing
		Set objFSO      = Nothing
		' Abort
		Exit Function
	Else
		Set objFileOut = objFSO.CreateTextFile( myFileOut, True, False )
	End If
 
	' Read the text from the input file and close the file
	strText = objStreamIn.ReadAll( )
	objStreamIn.Close
 
	' Base64 encode the text stream
	Set objBase64 = CreateObject( "XStandard.Base64" )
	strCode       = objBase64.Encode( strText, otString )
	Set objBase64 = Nothing
 
	' Write the result to the output file and close the file
	objFileOut.Write strCode
	objFileOut.Close
 
	' Release the objects
	Set objStreamIn = Nothing
	Set objFileIn   = Nothing
	Set objFileOut  = Nothing
	Set objFSO      = Nothing
 
	' Return any error codes
	Base64Encode = Err.Number
	On Error Goto 0
End Function
 
 
Function Base64Decode( myFileIn, myFileOut )
' This function uses Belus Technology's XBase64 component to Base64 decode a file.
' The XBase64 component is available at
' http://www.xstandard.com/page.asp?p=F5096C20-DF8F-4FAA-A1A5-CC85A934139A
'
' Arguments:
' myFileIn   [string]  the file to be decoded
' myFileOut  [string]  the decoded file to be created
'
' Return Code:
' 0 if all goes well, otherwise the appropriate error number
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
 
	' Standard housekeeping
	Dim i, objBase64, objFSO, objFileIn, objFileOut
	Dim objStreamIn, strCode, strText
 
	Const ForAppending       =  8
	Const ForReading         =  1
	Const ForWriting         =  2
	Const TristateFalse      =  0
	Const TristateMixed      = -2
	Const TristateTrue       = -1
	Const TristateUseDefault = -2
	Const otSafeArray        =  0
	Const otString           =  2
 
	' Use custom error handling
	'On Error Resume Next
 
	' Open a file system object
	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
 
	' Open the input file if it exists
	If objFSO.FileExists( myFileIn ) Then
		Set objFileIn   = objFSO.GetFile( myFileIn )
		Set objStreamIn = objFileIn.OpenAsTextStream( ForReading, TriStateFalse )
	Else
		' Error 53: File not found
		Base64Decode = 53
		' Close input file and release objects
		objStreamIn.Close
		Set objStreamIn = Nothing
		Set objFileIn   = Nothing
		Set objFSO      = Nothing
		' Abort
		Exit Function
	End If
 
	' Create the output file, unless it already exists
	If objFSO.FileExists( myFileOut ) Then
		' Error 58: File already exists
		Base64Decode = 58
		' Close input file and release objects
		objStreamIn.Close
		Set objStreamIn = Nothing
		Set objFileIn   = Nothing
		Set objFSO      = Nothing
		' Abort
		Exit Function
	Else
		Set objFileOut = objFSO.CreateTextFile( myFileOut, True, False )
	End If
 
	' Read the encoded text from the input file and close the file
	strCode = objStreamIn.ReadAll( )
	objStreamIn.Close
 
	' Base64 decode the text stream
	Set objBase64 = CreateObject( "XStandard.Base64" )
	strText       = objBase64.Decode( strCode, otString )
	Set objBase64 = Nothing
 
	' Write the result to the output file and close the file
	objFileOut.Write strText
	objFileOut.Close
 
	' Release the objects
	Set objStreamIn = Nothing
	Set objFileIn   = Nothing
	Set objFileOut  = Nothing
	Set objFSO      = Nothing
 
	' Return any error codes
	Base64Decode = Err.Number
	On Error Goto 0
End Function
 

page last modified: 2024-04-16; loaded in 0.0073 seconds