'Encodes a VBS script using simple hex encoding. Dim fs, ts, wsh Dim strLine, varByteArray, lngCounter, blnFirst 'BYTES_PER_LINE is chosen to limit generated line length. 'Line length = (2 * BYTES_PER_LINE) + 16 'Use + 14 if you don't want to count CRLF as part of the line. 'A value of 26 is suggested for in-body email, '248 max recommended, 251 max allowed. Const BYTES_PER_LINE = 248 Const ForWriting = 2 Set wsh = CreateObject("Wscript.Shell") Set fs = CreateObject("Scripting.FileSystemObject") 'Verify we have a good argument If WScript.Arguments.Count <> 1 Then WScript.Echo "Pass a VBS file as an argument. I'll hex-encode that file while leaving it functional!" 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 Not Lcase(Right(WScript.Arguments(0), 4)) = ".vbs" Then WScript.Echo "The file you supplied is not a VBS file." WScript.Quit 1 End If 'Verify we have the ADODB.Stream object available If Not IsRegistered("ADODB.Stream") Then WScript.Echo "ADODB 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)) 'Open the script for writing -- we'll be modifying the original script! Set ts = fs.OpenTextFile(WScript.Arguments(0), ForWriting, True) 'Now read every byte in the file and spit out hex strLine = "" blnFirst = True 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 'write the accumulated data line If blnFirst Then ts.WriteLine "x = Hd(""" & strLine & """)" blnFirst = False Else ts.WriteLine "x = x & Hd(""" & strLine & """)" End If strLine = "" End If Next 'Handle leftovers If strLine <> "" Then ts.WriteLine "x = x & Hd(""" & strLine & """)" End If 'Write the "action" line! ts.WriteLine "ExecuteGlobal x" 'Write the hex decode function (x = hex data, n = index, s = buffer) 'If our lines will be long enough, put the function on a single line If BYTES_PER_LINE < 44 Then ts.WriteLine "Function Hd(x)" ts.WriteLine vbTab & "For n = 1 To Len(x) Step 2" ts.WriteLine vbTab & vbTab & "s = s & Chr(Clng(""&H"" & Mid(x, n, 2)))" ts.WriteLine vbTab & "Next" ts.WriteLine vbTab & "Hd = s" ts.WriteLine "End Function" Else ts.WriteLine "Function Hd(x) : For n = 1 To Len(x) Step 2 : s = s & Chr(Clng(""&H"" & Mid(x, n, 2))) : Next : Hd = s : End Function" End If 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