3

I have a vbscript script that takes a .ico file and creates a desktop shortcut using it as its icon, but I want to be able to have everything the script needs stored in itself, if possible.

Crattik
  • 31
  • 1
  • 3
  • I can think of a couple ways. If you used a `WSF`, you could embed the binary data as Base64 in a `CDATA` section. Or you could use a regular `VBS` file and embed Base64 as comments after your script. In either case, you'd just need to read the Base64 and convert it to binary and write it to an `ICO` file. – Bond Oct 29 '14 at 19:00
  • Thanks for the quick response. Do you know where I can find an example of the second option you mentioned? I tried Googling it but I have so far only found ways to convert the Base64 data into a text string. – Crattik Oct 29 '14 at 21:10

3 Answers3

3

There's an easier (and much faster) method to convert binary data to Base64 in VBScript than by using the code @Hackoo found. You can take advantage of Microsoft's implementation of Base64 by using the MSXML2.DOMDocument class. Here's a script that takes a binary file c:\test.jpg and converts it to Base64. The resulting Base64-encoded string is saved in a text file (c:\out.txt). It uses an ADO Stream to read the file into a binary array and then passes that to the routine that uses a DOMDocument to convert that binary data to Base64-encoded text.

Const BINARY_FILE = "c:\test.jpg"
Const BASE64_FILE = "c:\out.txt"

With CreateObject("Scripting.FileSystemObject").CreateTextFile(BASE64_FILE, True)
    .Write BinaryFileToBase64(BINARY_FILE)
    .Close
End With

Function BinaryFileToBase64(strFileName)

    With CreateObject("ADODB.Stream")
        .Type = 1                                   ' Specify binary data (adTypeBinary)
        .Open
        .LoadFromFile strFileName
        BinaryFileToBase64 = Base64Encode(.Read)    ' Read binary contents into VT_UI1 | VT_ARRAY
    End With

End Function

' This function accepts binary (VT_UI1 | VT_ARRAY) data and converts it to Base64-encoded text (Unicode string).
Function Base64Encode(BinaryData) ' As String

    With CreateObject("MSXML2.DOMDocument.3.0").CreateElement("Base64")
        .DataType = "bin.base64"        ' Set the type of data the element should store
        .NodeTypedValue = BinaryData    ' Write the binary data
        Base64Encode = .Text            ' Read it back as text
    End With

End Function

So you can use this script to convert any binary file to its Base64-encoded string representation. For example, this is Stack Overflow's icon, saved as a 12x15 bitmap:

Qk1SAgAAAAAAADYAAAAoAAAADAAAAA8AAAABABgAAAAAABwCAAAAAAAAAAAAAAAAAAAAAAAA
hoOChoOChoOChoOChoOChoOChoOChoOChoOChoOC3uPl3uPlhoOC3uPl3uPl3uPl3uPl3uPl
3uPl3uPl3uPlhoOC3uPl3uPlhoOC3uPlhoOChoOChoOChoOChoOChoOC3uPlhoOC3uPl3uPl
hoOC3uPl3uPl3uPl3uPl3uPl3uPl3uPl3uPlhoOC3uPl3uPlhoOC3uPlcIyocIyocIyocIyo
cIyocIyo3uPlhoOC3uPl3uPlhoOC3uPl3uPl3uPl3uPl3uPlwtTdn8DV3uPlhoOC3uPl3uPl
3uPl3uPl2uHknL/UcafJVpfCVJbCbKPI3uPl3uPl3uPl3uPl3+Tm3+TmVZfCXJvEeKvLr8na
3+Tmbq7cVKHZ3+Tm3+Tm3+Tm4eXn4eXn3ePm4eXn4eXnsM3iP5fYQZjXs8/jV6Tx097o4eXn
4ubo4ubo4ubo3uToY6jbN5PXdbLc3eToOJb0K4/0e63vdqrw4+fp4+fp4+fpQZjYRZvYwNbl
3uXpOJb0LZD00t7qMYP1lLvu5Ojq5Ojq5OjqxNjm5Ojq3+bqOpf0LpH01uHrcafwPInz5Ojq
5enr5enr5enr5enr5enrRJzzLpH01+Lr3OTrMIP1psbu5enr5+rs5+rs5+rs5+rs5+rsrs7u
3eXs5+rsZqLyQ4705+rs5+rs6Ovt6Ovt6Ovt6Ovt6Ovt6Ovt6Ovt6OvtN4f0s83v6Ovt6Ovt

To decode the Base64-encoded string, we just need to perform the steps in reverse. First, we decode the text back into its original binary form. Then, we write that binary data to a file.

CONST NEW_BINARY_FILE = "c:\test2.jpg"

With CreateObject("Scripting.FileSystemObject").OpenTextFile(BASE64_FILE)
    Base64ToBinaryFile .ReadAll(), NEW_BINARY_FILE
    .Close
End With

Sub Base64ToBinaryFile(strBase64, strFileName)

    With CreateObject("ADODB.Stream")
        .Type = 1                       ' adTypeBinary
        .Open
        .Write Base64Decode(strBase64)  ' Write the byte array
        .SaveToFile strFileName, 2      ' Overwrite if file exists (adSaveCreateOverWrite)
    End With

End Sub

Function Base64Decode(ByVal strText) ' As ByteArray

    With CreateObject("MSXML2.DOMDocument.3.0").CreateElement("Base64")
        .DataType = "bin.base64"
        .Text = strText
        Base64Decode = .NodeTypedValue
    End With

End Function

So, back to your original question, how do you embed a binary (ICO) file in your VBScript file? You can just add the Base64 string somewhere. Put it at the end, the beginning, somewhere in the middle. But it'll need to be commented out, of course, since it's not valid VBScript. And you may want to add a start and end delimiter so you know where it begins and ends. For example:

' Read ourself...
With CreateObject("Scripting.FileSystemObject").OpenTextFile(WScript.ScriptFullName)

    ' Look for the "start"...
    Do Until .AtEndOfStream

        strLine = .ReadLine()

        If strLine = "' ~END~" Then fRead = False
        If fRead Then strBase64 = strBase64 & Mid(strLine, 3)
        If strLine = "' ~START~" Then fRead = True

    Loop

End With

' Re-create our bitmap!
Base64ToBinaryFile strBase64, "c:\stack_overflow.bmp"

' ~START~
' Qk1SAgAAAAAAADYAAAAoAAAADAAAAA8AAAABABgAAAAAABwCAAAAAAAAAAAAAAAAAAAAAAAA
' hoOChoOChoOChoOChoOChoOChoOChoOChoOChoOC3uPl3uPlhoOC3uPl3uPl3uPl3uPl3uPl
' 3uPl3uPl3uPlhoOC3uPl3uPlhoOC3uPlhoOChoOChoOChoOChoOChoOC3uPlhoOC3uPl3uPl
' hoOC3uPl3uPl3uPl3uPl3uPl3uPl3uPl3uPlhoOC3uPl3uPlhoOC3uPlcIyocIyocIyocIyo
' cIyocIyo3uPlhoOC3uPl3uPlhoOC3uPl3uPl3uPl3uPl3uPlwtTdn8DV3uPlhoOC3uPl3uPl
' 3uPl3uPl2uHknL/UcafJVpfCVJbCbKPI3uPl3uPl3uPl3uPl3+Tm3+TmVZfCXJvEeKvLr8na
' 3+Tmbq7cVKHZ3+Tm3+Tm3+Tm4eXn4eXn3ePm4eXn4eXnsM3iP5fYQZjXs8/jV6Tx097o4eXn
' 4ubo4ubo4ubo3uToY6jbN5PXdbLc3eToOJb0K4/0e63vdqrw4+fp4+fp4+fpQZjYRZvYwNbl
' 3uXpOJb0LZD00t7qMYP1lLvu5Ojq5Ojq5OjqxNjm5Ojq3+bqOpf0LpH01uHrcafwPInz5Ojq
' 5enr5enr5enr5enr5enrRJzzLpH01+Lr3OTrMIP1psbu5enr5+rs5+rs5+rs5+rs5+rsrs7u
' 3eXs5+rsZqLyQ4705+rs5+rs6Ovt6Ovt6Ovt6Ovt6Ovt6Ovt6Ovt6OvtN4f0s83v6Ovt6Ovt
' ~END~
Bond
  • 16,071
  • 6
  • 30
  • 53
1

This HTA show you how to embed a file exe or com zipped in a vbscript

For exemple i embeded the WGET.EXE to download a PNG file = estabanner5.png just for the test

[HTA] Encapsulate a zipped exe file in a VBScript

And i found this Vbscript on the net named Basic Base64- Encode- Decode.vbs You just Drop a file onto script and click YES to encode. And Click NO to decode a Base64 string.

'-- This is a barebones Base64 encoder/decoder. Drop a file onto script and click YES
'-- to encode. Click NO to decode a Base64 string.
'-- This script uses only VBS and FileSystemObject to do its work. The basic function
' of Base64 conversion is to take each 3 bytes of binary data and convert it to 4
' 6-bit units, which allows any data to be stored as plain text because on plain
' text ASCII characters are used. Decoding is the reverse.
' FSO is designed to only handle text data. Special treatment is required to handle
' binary data, but FSO *can* do it. For example, Textstream.ReadAll expects to read
' a string, so it will return file bytes up until the first null byte. But Textstream.Read(length-of-file)
' can be used to read in the entire file as a string, regardless the content. The bytes can
' then be handled by using Asc to convert the string into a numeric array. It's inefficient,
' but it works. When the file is written back to disk the array members are then converted
' back to characters and the whole thing is transferred as a string. That works fine as
' long as one doesn't try to handle it as a string. For instance, checking Len of the string
' returned from DecodeBase64 will only return the position of the first null.
' The vbCrLf option with encoding is to accomodate email, which by tradition 
' inserts a return every 76 characters. In other words, these functions can be used
' to create or decode attachments in email. They could also be used to send any type
' of file in the form of text pasted into an email. If the recipient has the decode script
' they can just select and copy the email content, paste it into Notepad, save it as a
' TXT file, then drop it onto the script to convert that text into the original JPG, EXE, or 
' any other file type.

Dim FSO, TS, sIn, sOut, Arg, IfEncode, OFil, LSize, LRet

Arg = WScript.Arguments(0)

LRet = MsgBox("Click yes to encode file or no to decode.", 36)
  If LRet = 6 Then 
      IfEncode = True
  Else
      IfEncode = False
  End If    

Set FSO = CreateObject("Scripting.FileSystemObject")
Set OFil = FSO.GetFile(Arg)
LSize = OFil.Size
Set OFil = Nothing
Set TS = FSO.OpenTextFile(Arg)
sIn = TS.Read(LSize)
Set TS = Nothing

If IfEncode = True Then
    sOut = ConvertToBase64(sIn, True)
     Set TS = FSO.CreateTextFile(Arg & "-64", True)
         TS.Write sOut
         TS.Close
      Set TS = Nothing 
Else
    sOut = DecodeBase64(sIn)
     Set TS = FSO.CreateTextFile(Arg & "-de64", True)
         TS.Write sOut
         TS.Close
      Set TS = Nothing 
End If

Set FSO = Nothing

MsgBox "Done."
'------------------------------------------------------
Function ConvertToBase64(sBytes, AddReturns)
  Dim B2(), B76(), ABytes(), ANums
  Dim i1, i2, i3, LenA, NumReturns, sRet
     On Error Resume Next
      ANums = Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 43, 47)

     LenA = Len(sBytes)
       '-- convert each string character to ASCII value.
     ReDim ABytes(LenA - 1)
       For i1 = 1 to LenA
           ABytes(i1 - 1) = Asc(Mid(sBytes, i1, 1))
       Next  
      '-- generate base 64 equivalent in array B2.
  ReDim Preserve ABytes(((LenA - 1) \ 3) * 3 + 2) 
  ReDim Preserve B2((UBound(ABytes) \ 3) * 4 + 3) 
     i2 = 0
        For i1 = 0 To (UBound(ABytes) - 1) Step 3
            B2(i2) = ANums(ABytes(i1) \ 4)
              i2 = i2 + 1
            B2(i2) = ANums((ABytes(i1 + 1) \ 16) Or (ABytes(i1) And 3) * 16)
              i2 = i2 + 1
            B2(i2) = ANums((ABytes(i1 + 2) \ 64) Or (ABytes(i1 + 1) And 15) * 4)
              i2 = i2 + 1
            B2(i2) = ANums(ABytes(i1 + 2) And 63)
              i2 = i2 + 1
        Next 
            For i1 = 1 To i1 - LenA
               B2(UBound(B2) - i1 + 1) = 61 ' add = signs at end if necessary.
            Next 

      '-- Most email programs use a maximum of 76 characters per line when encoding
      '-- binary files as base 64. This next function achieves that by generating another
      '--- array big enough for the added vbCrLfs, then copying the base 64 array over.

   If (AddReturns = True) And (LenA > 76) Then
        NumReturns = ((UBound(B2) + 1) \ 76)
        LenA = (UBound(B2) + (NumReturns * 2)) '--make B76 B2 plus 2 spots for each vbcrlf.
         ReDim B76(LenA)
          i2 = 0
          i3 = 0
              For i1 = 0 To UBound(B2)
                   B76(i2) = B2(i1)
                    i2 = i2 + 1
                    i3 = i3 + 1
                       If (i3 = 76) And (i2 < (LenA - 2)) Then   '--extra check. make sure there are still
                          B76(i2) = 13                 '-- 2 spots left for return if at end.
                          B76(i2 + 1) = 10
                          i2 = i2 + 2
                          i3 = 0
                       End If
              Next
        For i1 = 0 to UBound(B76)
            B76(i1) = Chr(B76(i1))
        Next        
          sRet = Join(B76, "")
   Else
        For i1 = 0 to UBound(B2)
            B2(i1) = Chr(B2(i1))
        Next  
          sRet = Join(B2, "")
   End If
       ConvertToBase64 = sRet
End Function

Function DecodeBase64(Str64)
  Dim B1(), B2()
  Dim i1, i2, i3, LLen, UNum, s2, sRet, ANums
  Dim A255(255)
    On Error Resume Next
        ANums = Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 43, 47)

    For i1 = 0 To 255
       A255(i1) = 64
    Next
    For i1 = 0 To 63
       A255(ANums(i1)) = i1
    Next
          s2 = Replace(Str64, vbCr, "")
          s2 = Replace(s2, vbLf, "")
          s2 = Replace(s2, " ", "")
          s2 = Trim(s2)
          LLen = Len(s2)
         ReDim B1(LLen - 1)
      For i1 = 1 to LLen
          B1(i1 - 1) = Asc(Mid(s2, i1, 1)) 
      Next      

  '--B1 is now in-string as array.
   ReDim B2((LLen \ 4) * 3 - 1)
        i2 = 0
     For i1 = 0 To UBound(B1) Step 4
        B2(i2) = (A255(B1(i1)) * 4) Or (A255(B1(i1 + 1)) \ 16)
           i2 = i2 + 1
        B2(i2) = (A255(B1(i1 + 1)) And 15) * 16 Or (A255(B1(i1 + 2)) \ 4)
           i2 = i2 + 1
        B2(i2) = (A255(B1(i1 + 2)) And 3) * 64 Or A255(B1(i1 + 3))
           i2 = i2 + 1
     Next
        If B1(LLen - 2) = 61 Then
           i2 = 2
        ElseIf B1(LLen - 1) = 61 Then
           i2 = 1
        Else
           i2 = 0
        End If
        UNum = UBound(B2) - i2
     ReDim Preserve B2(UNum)
       For i1 = 0 to UBound(B2)
         B2(i1) = Chr(B2(i1))
       Next   
        DecodeBase64 = Join(B2, "")
End Function
Hackoo
  • 18,337
  • 3
  • 40
  • 70
1

There might be an easier method using the Windows build-in CERTUTIL command:

  1. Encode the ICON (or other binary) file with CERTUTIL (CERTUTIL -encode icon.ico icon.b64)
  2. Add the Base64 code in the script including ' prefix (REM)
  3. Use the next code to remove the REM and decode the Base64 code into a binary:

    dim fso : set fso=CreateObject("scripting.FileSystemObject")
    dim wsh : set wsh=CreateObject("wscript.shell")
    
    '--- Extract ICO file...
    iconFile=fso.GetSpecialFolder(2) & "\icon"
    set f=fso.OpenTextFile(WScript.ScriptFullName)
    s=replace(f.ReadAll,"' ","")
    f.close
    set f=fso.OpenTextFile(iconFile & ".tmp",2,TRUE)
    f.writeline(s)
    f.close
    wsh.run "certutil -decode " & iconFile & ".tmp" & " " & iconFile & ".ico",0,true
    
    ' --- This is the output of the CERTUTIL encode command:
    ' -----BEGIN CERTIFICATE-----
    ' AAABAAYAEBAAAAAACABoBQAAZgAAACAgAAAAAAgAqAgAAM4FAAAwMAAAAAAIAKgO
    ' AAB2DgAAEBAAAAAAIABoBAAAHh0AACAgAAAAACAAqBAAAIYhAAAwMAAAAAAgAKgl
    ' ..
    ' ..
    ' AAAAHwAA/AAAAAA/AAD+AAAAAH8AAP+AAAAA/wAA/8AAAAP/AAD/4AAAB/8AAP/4
    ' AAAf/wAA//4AAH//AAD//8AD//8AAA==
    ' -----END CERTIFICATE-----
    
beaukey
  • 11
  • 1