求 BASE64 编码的 VBS 脚本。 - 中国DOS联盟论坛

想找一个编码任何文件为BASE64的VBS脚本，且拖一个文件到此脚本自动生成BASE64编码的文本文件，找到这个不知管不管用，希望VBS脚本的高手帮忙修改并完善一下，使之能够支持拖放文件的功能及能编码成功。谢谢！


' Decodes a base-64 encoded string (BSTR type).
' 1999 - 2004 Antonin Foller, http://www.motobit.com
' 1.01 - solves problem with Access And 'Compare Database' (InStr)
Function Base64Decode(ByVal base64String)
  'rfc1521
  '1999 Antonin Foller, Motobit Software, http://Motobit.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim dataLength, sOut, groupBegin
  
  'remove white spaces, If any
  base64String = Replace(base64String, vbCrLf, "")
  base64String = Replace(base64String, vbTab, "")
  base64String = Replace(base64String, " ", "")
  
  'The source must consists from groups with Len of 4 chars
  dataLength = Len(base64String)
  If dataLength Mod 4 <> 0 Then
    Err.Raise 1, "Base64Decode", "Bad Base64 string."
    Exit Function
  End If

  
  ' Now decode each group:
  For groupBegin = 1 To dataLength Step 4
    Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
    ' Each data group encodes up To 3 actual bytes.
    numDataBytes = 3
    nGroup = 0

    For CharCounter = 0 To 3
      ' Convert each character into 6 bits of data, And add it To
      ' an integer For temporary storage.  If a character is a '=', there
      ' is one fewer data byte.  (There can only be a maximum of 2 '=' In
      ' the whole string.)

      thisChar = Mid(base64String, groupBegin + CharCounter, 1)

      If thisChar = "=" Then
        numDataBytes = numDataBytes - 1
        thisData = 0
      Else
        thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
      End If
      If thisData = -1 Then
        Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
        Exit Function
      End If

      nGroup = 64 * nGroup + thisData
    Next
    
    'Hex splits the long To 6 groups with 4 bits
    nGroup = Hex(nGroup)
    
    'Add leading zeros
    nGroup = String(6 - Len(nGroup), "0") & nGroup
    
    'Convert the 3 byte hex integer (6 chars) To 3 characters
    pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 5, 2)))
    
    'add numDataBytes characters To out string
    sOut = sOut & Left(pOut, numDataBytes)
  Next

  Base64Decode = sOut
End Function

第1楼　chishingchan	发表于 2008-06-25 12:17
银牌会员　发帖 538　积分 1,284
[求助] 求 BASE64 编码的 VBS 脚本。想找一个编码任何文件为BASE64的VBS脚本，且拖一个文件到此脚本自动生成BASE64编码的文本文件，找到这个不知管不管用，希望VBS脚本的高手帮忙修改并完善一下，使之能够支持拖放文件的功能及能编码成功。谢谢！ ' Decodes a base-64 encoded string (BSTR type). ' 1999 - 2004 Antonin Foller, http://www.motobit.com ' 1.01 - solves problem with Access And 'Compare Database' (InStr) Function Base64Decode(ByVal base64String) 'rfc1521 '1999 Antonin Foller, Motobit Software, http://Motobit.cz Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim dataLength, sOut, groupBegin 'remove white spaces, If any base64String = Replace(base64String, vbCrLf, "") base64String = Replace(base64String, vbTab, "") base64String = Replace(base64String, " ", "") 'The source must consists from groups with Len of 4 chars dataLength = Len(base64String) If dataLength Mod 4 <> 0 Then Err.Raise 1, "Base64Decode", "Bad Base64 string." Exit Function End If ' Now decode each group: For groupBegin = 1 To dataLength Step 4 Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut ' Each data group encodes up To 3 actual bytes. numDataBytes = 3 nGroup = 0 For CharCounter = 0 To 3 ' Convert each character into 6 bits of data, And add it To ' an integer For temporary storage. If a character is a '=', there ' is one fewer data byte. (There can only be a maximum of 2 '=' In ' the whole string.) thisChar = Mid(base64String, groupBegin + CharCounter, 1) If thisChar = "=" Then numDataBytes = numDataBytes - 1 thisData = 0 Else thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1 End If If thisData = -1 Then Err.Raise 2, "Base64Decode", "Bad character In Base64 string." Exit Function End If nGroup = 64 * nGroup + thisData Next 'Hex splits the long To 6 groups with 4 bits nGroup = Hex(nGroup) 'Add leading zeros nGroup = String(6 - Len(nGroup), "0") & nGroup 'Convert the 3 byte hex integer (6 chars) To 3 characters pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _ Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _ Chr(CByte("&H" & Mid(nGroup, 5, 2))) 'add numDataBytes characters To out string sOut = sOut & Left(pOut, numDataBytes) Next Base64Decode = sOut End Function

第2楼　chishingchan	发表于 2008-06-25 14:59
银牌会员　发帖 538　积分 1,284
这里有篇是关于使用BASE64编码的VBS脚本，用它转换及生成文件是没错。 http://hi.baidu.com/zzzevazzz/blog/item/75b8b50a118b6c1e94ca6b36.html 但！！！此BASE64不是通用型，即使用以下 VBS 脚本是恢复出错的。 filename="BASE64编码字符串" Set xml_dom = CreateObject("MSXML2.DOMDocument") Set ado_stream = CreateObject("ADODB.Stream") Set pic = xml_dom.createElement("pic") pic.dataType = "bin.base64" pic.nodeTypedvalue = rExp(filename) ado_stream.Type = 1 ado_stream.Open ado_stream.Write pic.nodeTypedvalue ado_stream.SaveToFile "filename.exe",2 ado_stream.Close Set ado_stream = Nothing Function rExp(inpStr) Dim oRe, Matches, match Set oRe = New RegExp oRe.Pattern = "\{(+)\}" oRe.Global = True Set Matches = oRe.Execute(inpStr) For each match in matches character = Mid(Match.SubMatches(0),1,1) chrnumber = Int(Mid(Match.SubMatches(0),2)) inpStr = Replace(inpStr,Match.Value,String(chrnumber,character)) Next rExp = inpStr End Function [ Last edited by chishingchan on 2008-6-25 at 08:21 PM ]