在VBScript中是否可以存储.ico文件?

3

我有一个VBScript脚本,可以使用.ico文件创建桌面快捷方式,并将其作为其图标,但如果可能的话,我希望能够将脚本所需的所有内容存储在其中。


我可以想到几种方法。如果您使用了 WSF,您可以将二进制数据嵌入到 CDATA 部分中的 Base64 中。或者您可以使用常规的 VBS 文件,并在脚本后面嵌入Base64作为注释。在任何情况下,您只需要读取Base64并将其转换为二进制,然后将其写入 ICO 文件即可。 - Bond
谢谢您的快速回复。您知道我可以在哪里找到您提到的第二个选项的示例吗?我尝试过在Google上搜索,但目前只找到了将Base64数据转换为文本字符串的方法。 - Crattik
3个回答

3

在VBScript中,将二进制数据转换为Base64的方法比@Hackoo找到的代码更加简单(也更快)。您可以利用Microsoft对Base64的实现,使用MSXML2.DOMDocument类。以下是一个脚本,它将二进制文件c:\test.jpg转换为Base64。生成的Base64编码字符串保存在文本文件中(c:\out.txt)。它使用一个ADO流将文件读入二进制数组,然后将该数组传递给使用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

那么,回到你最初的问题,如何在VBScript文件中嵌入一个二进制(ICO)文件?你可以在任何地方添加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~

1
这个HTA可以教你如何将exe或com文件压缩在vbscript中。例如,我嵌入了WGET.EXE以下载一个PNG文件= estabanner5.png,只是为了测试。 [HTA] Encapsulate a zipped exe file in a VBScript 我在网上找到了这个名为Basic Base64- Encode- Decode.vbs的Vbscript。你只需要将文件拖到脚本上并点击YES进行编码。点击NO以解码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

1

使用Windows内置的CERTUTIL命令可能有更简单的方法:

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

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接