'Creates a self-extracting CMD file around three times
'the size of the original file. The created file will be named
'the same as the source file except for an additional CMD 
'extension. For example, "test.gif" would create "test.gif.cmd".
'When run, the self-extracting CMD file will create the original
'file in the current directory.
'
'FYI, the "shar" name of this script is taken from an old 
'UNIX command "shar", which stands for "shell archive". In other 
'words, an archive that can be extracted using nothing more than 
'the "shell", or built-in operating system commands. Which is 
'exactly what this script creates.


Dim fs, ts, wsh
Dim strLine, strStatus
Dim varByteArray
Dim intPos, intPercent, intOldPercent, lngCounter
Const ForWriting = 2
Const BYTES_PER_LINE = 16
Set wsh = CreateObject("Wscript.Shell")
Set fs = CreateObject("Scripting.FileSystemObject")

'Verify we have a good argument
If WScript.Arguments.Count <> 1 Then
	WScript.Echo "Drop a file on me. I will create a CMD (batch file) self-extracting archive."
	WScript.Quit 1
End If
If Not fs.FileExists(WScript.Arguments(0)) Then
	WScript.Echo "The argument you supplied does not exist as a file."
	WScript.Quit 1
End If
If fs.GetFile(WScript.Arguments(0)).Size > 65000 Then 'actually 65279 bytes
	WScript.Echo "The file you supplied is too large. There is a 64KB size limitation!"
	WScript.Quit 1
End If


'Verify we have the ADODB.Stream object available
If Not IsRegistered("ADODB.Stream") Then
	WScript.Echo "ADO is not installed on your system. Please install the latest Microsoft data access components from www.microsoft.com/data."
	WScript.Quit
End If

'Read the source file
varByteArray = ReadByteArray(WScript.Arguments(0))
'Begin writing the output file
Set ts = fs.OpenTextFile(WScript.Arguments(0) & ".bat", ForWriting, True)
ts.WriteLine "@echo off"
ts.WriteLine "echo This batch file will create a file named: "
ts.WriteLine "echo " & fs.GetFile(WScript.Arguments(0)).ShortName
ts.WriteLine "echo in the current directory. To continue, press any "
ts.WriteLine "echo key. To abort, press Ctrl-C or close this window. "
ts.WriteLine "pause>nul"
ts.WriteLine "echo e 100 00> debug.script"
'Now read every byte in the file and spit out batch debug script
intOldPercent = 0
strLine = ""
For lngCounter = 1 to UBound(varByteArray) + 1
	strLine = strLine & " " & Right("00" & Hex(Ascb(Midb(varByteArray,lngCounter,1))), 2)
	If lngCounter Mod BYTES_PER_LINE = 0 Then
		'Kick out the line of data
		ts.WriteLine "echo e " & Hex(lngCounter + 256 - (Len(strLine)/3)) & strLine & ">> debug.script"
		strLine = ""
		'Show progress
		intPercent = Cint(100 * lngCounter / UBound(varByteArray))
		If intOldPercent <> intPercent Then
			intOldPercent = intPercent
			'Status output to the batch file
			ts.WriteLine "echo " & intPercent & " percent"
			'Status output to the current window if host is CSCRIPT
			If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
				WScript.Echo intPercent & "%"
			End If
		End If
	End If
Next
'Pick up leftovers
If strLine <> "" Then
	ts.WriteLine "echo e " & Hex(lngCounter + 255 - (Len(strLine)/3)) & strLine & ">> debug.script"
End If
ts.Write "echo n "
ts.Write fs.GetFile(WScript.Arguments(0)).ShortName
ts.WriteLine ">> debug.script"
ts.WriteLine "echo rcx>> debug.script"
ts.WriteLine "echo " & Hex(lngCounter - 1) & ">> debug.script"
ts.WriteLine "echo w>> debug.script"
ts.WriteLine "echo q>> debug.script"
ts.WriteLine "debug.exe < debug.script"
ts.WriteLine "del debug.script"
ts.WriteLine "echo."
ts.WriteLine "echo."
ts.WriteLine "echo."
ts.WriteLine "echo."
ts.WriteLine "echo FINISHED creating a file named:"
ts.WriteLine "echo " & fs.GetFile(WScript.Arguments(0)).ShortName
ts.WriteLine "echo Press any key to close this window..."
ts.WriteLine "pause>nul"

Function IsRegistered(strObjectName)
'Returns True if object can be created
Dim obj
On Error Resume Next
	Set obj = Nothing
	Set obj = CreateObject(strObjectName)
	If obj Is Nothing Then
		IsRegistered = False
	Else
		IsRegistered = True
		Set obj = Nothing
	End If
End Function

Function ReadByteArray(strFileName)
Const adTypeBinary = 1
Dim bin
	Set bin = CreateObject("ADODB.Stream")
	bin.Type = adTypeBinary
	bin.Open
	bin.LoadFromFile strFileName
	ReadByteArray = bin.Read
End Function