Можно ли сохранить файл .ico в vbscript?

Существует более простой (и гораздо более быстрый) способ преобразования двоичных данных в Base64 в VBScript, чем использование кода, найденного @Hackoo. Вы можете воспользоваться реализацией Microsoft Base64, используя класс MSXML2.DOMDocument. Вот скрипт, который берет двоичный файл c:\test.jpg и преобразует его в Base64. Результирующая строка в кодировке Base64 сохраняется в текстовом файле (c:\out.txt). Он использует ADO Stream для чтения файла в двоичный массив, а затем передает его подпрограмме, которая использует DOMDocument для преобразования этих двоичных данных в текст в кодировке Base64.

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

Таким образом, вы можете использовать этот сценарий для преобразования любого двоичного файла в его строковое представление в кодировке Base64. Например, это значок Stack Overflow, сохраненный в виде растрового изображения 12x15:

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

Чтобы декодировать строку в кодировке Base64, нам просто нужно выполнить шаги в обратном порядке. Сначала мы декодируем текст обратно в исходную двоичную форму. Затем мы записываем эти двоичные данные в файл.

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

Итак, вернемся к исходному вопросу: как встроить двоичный файл (ICO) в файл VBScript? Вы можете просто добавить где-нибудь строку Base64. Поставьте его в конце, в начале, где-нибудь посередине. Но его, конечно, нужно будет закомментировать, так как это недопустимый VBScript. И вы можете добавить начальный и конечный разделитель, чтобы знать, где он начинается и заканчивается. Например:

' 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~

Этот HTA покажет вам, как встроить файл exe или com, заархивированный в vbscript.

Например, я встроил WGET.EXE для загрузки PNG-файла = estabanner5.png просто для теста.

[HTA] Инкапсулировать сжатый исполняемый файл в VBScript

И я нашел этот Vbscript в сети под названием Basic Base64-Encode-Decode.vbs. Вы просто перетаскиваете файл на скрипт и нажимаете YES для кодирования. И нажмите НЕТ, чтобы декодировать строку Base64.

'-- 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

Может быть более простой способ с использованием встроенной команды Windows CERTUTIL:

1. Закодируйте файл ICON (или другой двоичный файл) с помощью CERTUTIL (CERTUTIL -encode icon.ico icon.b64)
2. Добавьте код Base64 в скрипт, включая префикс ' (REM)

3. Используйте следующий код, чтобы удалить REM и декодировать код Base64 в двоичный файл:

   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-----