Option Explicit

Dim i, intByte
Dim objBinFile, objBinStream, objFile, objFSO, objScript
Dim strBinFile, strFileExt, strFileName, strLine, strOut, strScriptFile, strScriptVer

strScriptVer = "2.00"

Const ForAppending = 8
Const ForReading   = 1
Const ForWriting   = 2

Const TristateFalse      =  0
Const TristateMixed      = -2
Const TristateTrue       = -1
Const TristateUseDefault = -2

Set objFSO = CreateObject( "Scripting.FileSystemObject" )

With WScript.Arguments
	If .Named.Count   > 0 Then Syntax
	If .Unnamed.Count = 1 Then
		strBinFile = .Unnamed(0)
		If Not objFSO.FileExists( strBinFile ) Then
			WScript.Echo "Binary input file not found" & vbCrLf
			Syntax
		End If
		With objFSO
			strScriptFile = .BuildPath( .GetParentFolderName( .GetAbsolutePathName( strBinFile ) ), .GetBaseName( strBinFile ) & ".vbs" )
		End With
		If objFSO.FileExists( strScriptFile ) Then
			WScript.Echo "Output script file already exists" & vbCrLf
			Syntax
		End If
	Else
		Syntax
	End If
End With

Set objBinFile   = objFSO.GetFile( strBinFile )
Set objBinStream = objBinFile.OpenAsTextStream( ForReading, TristateFalse )
strFileName = objFSO.GetBaseName( strBinFile )
strFileExt  = objFSO.GetExtensionName( strBinFile )

i = 0
strOut = "Option Explicit" & vbCrLf _
       & "Dim arrLine, i, objFile, objFSO, objParent, objShell" & vbCrLf _
       & "Const ForWriting = 2" & vbCrLf _
       & "Set objFSO  = CreateObject( ""Scripting.FileSystemObject"" )" & vbCrLf _
       & "Set objFile = objFSO.CreateTextFile( """ & strFileName & "." & strFileExt & """, False, False )" & vbCrLf
Do While Not objBinStream.AtEndOfStream
	i = i + 1
	If i = 1024 Then
		i = 0
		strOut  = strOut _
		        & "arrLine = Split( """ & Mid( strLine, 2 ) & """, "";"" )" & vbCrLf _
		        & "For i = 0 To UBound( arrLine )" & vbCrLf _
		        &  vbTab & "objFile.Write Chr( arrLine(i) )" & vbCrLf _
		        & "Next" & vbCrLf
		strLine = ""
	End If
	intByte = Asc( objBinStream.Read(1) )
	strLine = strLine & ";" & intByte
Loop
If strLine <> "" Then
	strOut  = strOut _
	        & "arrLine = Split( """ & Mid( strLine, 2 ) & """, "";"" )" & vbCrLf _
	        & "For i = 0 To UBound( arrLine )" & vbCrLf _
	        &  vbTab & "objFile.Write Chr( arrLine(i) )" & vbCrLf _
	        & "Next" & vbCrLf
	strLine = ""
End If
objBinStream.Close
Set objBinStream = Nothing
Set objBinFile   = Nothing
strOut = strOut _
       & "objFile.Close" & vbCrLf _
       & "Set objShell  = CreateObject( ""Shell.Application"" )" & vbCrLf _
       & "Set objParent = objShell.NameSpace( objFSO.GetParentFolderName( objFSO.GetAbsolutePathName( """ & strFileName & "." & strFileExt & """ ) ) )" & vbCrLf _
       & "Set objFile   = objParent.ParseName( """ & objFSO.GetFileName( strFileName & "." & strFileExt ) & """ )" & vbCrLf _
       & "objFile.ModifyDate  = """ & CStr( objFSO.GetFile( strBinFile ).DateLastModified ) & """" & vbCrLf _
       & "Set objFile   = Nothing" & vbCrLf _
       & "Set objFSO    = Nothing" & vbCrLf _
       & "Set objShell  = Nothing" & vbCrLf _
       & "WScript.Echo ""Created """"" & strFileName & "." & strFileExt & """""""" & vbCrLf

Set objScript = objFSO.CreateTextFile( strScriptFile, False, False )
objScript.Write strOut
objScript.Close
Set objScript = Nothing
Set objFSO    = Nothing


Sub Syntax( )
	WScript.Echo "Bin2Vbs.vbs,  Version " & strScriptVer & vbCrLf _
	           & "Convert a (small) binary file to a script that can recreate that file" _
	           & vbCrLf & vbCrLf _
	           & "Usage:   BIN2VBS.VBS  binfile" _
	           & vbCrLf & vbCrLf _
	           & "Where:   ""binfile""    is the fully qualified path of the binary file" _
	           & vbCrLf & vbCrLf _
	           & "Result:  The VBScript file will be created in the binary file's parent folder," _
	           & vbCrLf _
	           & "         with the NAME of the binary file, and extension "".VBS""" _
	           & vbCrLf & vbCrLf _
	           & "Written by Rob van der Woude" & vbCrLf _
	           & "http://www.robvanderwoude.com"
	On Error Resume Next
	Set objBinFile   = Nothing
	Set objBinStream = Nothing
	Set objScript    = Nothing
	Set objFSO       = Nothing
	On Error GoTo 0
	WScript.Quit 1
End Sub