Necesito codificar una cadena de 100 KB + como base64 en VBA. ¿Hay funciones integradas u objetos COM disponibles que lo hagan, ya que un enfoque de VBA puro es complejo o no se adapta bien a estos volúmenes (consulte los enlaces de dbb y marxidad)?¿Cómo base64 codifica una cadena de manera eficiente utilizando Excel VBA?
26
A
Respuesta
40
Puede utilizar la funcionalidad de codificación Base64 MSXML como se describe en www.nonhostile.com/howto-encode-decode-base64-vb6.asp:
Function EncodeBase64(text As String) As String
Dim arrData() As Byte
arrData = StrConv(text, vbFromUnicode)
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.Text
Set objNode = Nothing
Set objXML = Nothing
End Function
+0
Muy útil ya que a menudo se usa MSXML2 para realizar la solicitud real para la que están destinados estos datos. –
21
Este código funciona muy rápido. Viene de here
Option Explicit
Private Const clOneMask = 16515072 '000000 111111 111111 111111
Private Const clTwoMask = 258048 '111111 000000 111111 111111
Private Const clThreeMask = 4032 '111111 111111 000000 111111
Private Const clFourMask = 63 '111111 111111 111111 000000
Private Const clHighMask = 16711680 '11111111 00000000 00000000
Private Const clMidMask = 65280 '00000000 11111111 00000000
Private Const clLowMask = 255 '00000000 00000000 11111111
Private Const cl2Exp18 = 262144 '2 to the 18th power
Private Const cl2Exp12 = 4096 '2 to the 12th
Private Const cl2Exp6 = 64 '2 to the 6th
Private Const cl2Exp8 = 256 '2 to the 8th
Private Const cl2Exp16 = 65536 '2 to the 16th
Public Function Encode64(sString As String) As String
Dim bTrans(63) As Byte, lPowers8(255) As Long, lPowers16(255) As Long, bOut() As Byte, bIn() As Byte
Dim lChar As Long, lTrip As Long, iPad As Integer, lLen As Long, lTemp As Long, lPos As Long, lOutSize As Long
For lTemp = 0 To 63 'Fill the translation table.
Select Case lTemp
Case 0 To 25
bTrans(lTemp) = 65 + lTemp 'A - Z
Case 26 To 51
bTrans(lTemp) = 71 + lTemp 'a - z
Case 52 To 61
bTrans(lTemp) = lTemp - 4 '1 - 0
Case 62
bTrans(lTemp) = 43 'Chr(43) = "+"
Case 63
bTrans(lTemp) = 47 'Chr(47) = "/"
End Select
Next lTemp
For lTemp = 0 To 255 'Fill the 2^8 and 2^16 lookup tables.
lPowers8(lTemp) = lTemp * cl2Exp8
lPowers16(lTemp) = lTemp * cl2Exp16
Next lTemp
iPad = Len(sString) Mod 3 'See if the length is divisible by 3
If iPad Then 'If not, figure out the end pad and resize the input.
iPad = 3 - iPad
sString = sString & String(iPad, Chr(0))
End If
bIn = StrConv(sString, vbFromUnicode) 'Load the input string.
lLen = ((UBound(bIn) + 1) \ 3) * 4 'Length of resulting string.
lTemp = lLen \ 72 'Added space for vbCrLfs.
lOutSize = ((lTemp * 2) + lLen) - 1 'Calculate the size of the output buffer.
ReDim bOut(lOutSize) 'Make the output buffer.
lLen = 0 'Reusing this one, so reset it.
For lChar = LBound(bIn) To UBound(bIn) Step 3
lTrip = lPowers16(bIn(lChar)) + lPowers8(bIn(lChar + 1)) + bIn(lChar + 2) 'Combine the 3 bytes
lTemp = lTrip And clOneMask 'Mask for the first 6 bits
bOut(lPos) = bTrans(lTemp \ cl2Exp18) 'Shift it down to the low 6 bits and get the value
lTemp = lTrip And clTwoMask 'Mask for the second set.
bOut(lPos + 1) = bTrans(lTemp \ cl2Exp12) 'Shift it down and translate.
lTemp = lTrip And clThreeMask 'Mask for the third set.
bOut(lPos + 2) = bTrans(lTemp \ cl2Exp6) 'Shift it down and translate.
bOut(lPos + 3) = bTrans(lTrip And clFourMask) 'Mask for the low set.
If lLen = 68 Then 'Ready for a newline
bOut(lPos + 4) = 13 'Chr(13) = vbCr
bOut(lPos + 5) = 10 'Chr(10) = vbLf
lLen = 0 'Reset the counter
lPos = lPos + 6
Else
lLen = lLen + 4
lPos = lPos + 4
End If
Next lChar
If bOut(lOutSize) = 10 Then lOutSize = lOutSize - 2 'Shift the padding chars down if it ends with CrLf.
If iPad = 1 Then 'Add the padding chars if any.
bOut(lOutSize) = 61 'Chr(61) = "="
ElseIf iPad = 2 Then
bOut(lOutSize) = 61
bOut(lOutSize - 1) = 61
End If
Encode64 = StrConv(bOut, vbUnicode) 'Convert back to a string and return it.
End Function
Public Function Decode64(sString As String) As String
Dim bOut() As Byte, bIn() As Byte, bTrans(255) As Byte, lPowers6(63) As Long, lPowers12(63) As Long
Dim lPowers18(63) As Long, lQuad As Long, iPad As Integer, lChar As Long, lPos As Long, sOut As String
Dim lTemp As Long
sString = Replace(sString, vbCr, vbNullString) 'Get rid of the vbCrLfs. These could be in...
sString = Replace(sString, vbLf, vbNullString) 'either order.
lTemp = Len(sString) Mod 4 'Test for valid input.
If lTemp Then
Call Err.Raise(vbObjectError, "MyDecode", "Input string is not valid Base64.")
End If
If InStrRev(sString, "==") Then 'InStrRev is faster when you know it's at the end.
iPad = 2 'Note: These translate to 0, so you can leave them...
ElseIf InStrRev(sString, "=") Then 'in the string and just resize the output.
iPad = 1
End If
For lTemp = 0 To 255 'Fill the translation table.
Select Case lTemp
Case 65 To 90
bTrans(lTemp) = lTemp - 65 'A - Z
Case 97 To 122
bTrans(lTemp) = lTemp - 71 'a - z
Case 48 To 57
bTrans(lTemp) = lTemp + 4 '1 - 0
Case 43
bTrans(lTemp) = 62 'Chr(43) = "+"
Case 47
bTrans(lTemp) = 63 'Chr(47) = "/"
End Select
Next lTemp
For lTemp = 0 To 63 'Fill the 2^6, 2^12, and 2^18 lookup tables.
lPowers6(lTemp) = lTemp * cl2Exp6
lPowers12(lTemp) = lTemp * cl2Exp12
lPowers18(lTemp) = lTemp * cl2Exp18
Next lTemp
bIn = StrConv(sString, vbFromUnicode) 'Load the input byte array.
ReDim bOut((((UBound(bIn) + 1) \ 4) * 3) - 1) 'Prepare the output buffer.
For lChar = 0 To UBound(bIn) Step 4
lQuad = lPowers18(bTrans(bIn(lChar))) + lPowers12(bTrans(bIn(lChar + 1))) + _
lPowers6(bTrans(bIn(lChar + 2))) + bTrans(bIn(lChar + 3)) 'Rebuild the bits.
lTemp = lQuad And clHighMask 'Mask for the first byte
bOut(lPos) = lTemp \ cl2Exp16 'Shift it down
lTemp = lQuad And clMidMask 'Mask for the second byte
bOut(lPos + 1) = lTemp \ cl2Exp8 'Shift it down
bOut(lPos + 2) = lQuad And clLowMask 'Mask for the third byte
lPos = lPos + 3
Next lChar
sOut = StrConv(bOut, vbUnicode) 'Convert back to a string.
If iPad Then sOut = Left$(sOut, Len(sOut) - iPad) 'Chop off any extra bytes.
Decode64 = sOut
End Function
Cuestiones relacionadas
- 1. Carcasa inferior eficiente en Excel VBA
- 2. cómo dividir una cadena con múltiples delimeters en vba excel?
- 3. base64 codifica el archivo de audio y lo envía como una Cadena, luego decodifica la Cadena
- 4. Filtrar tabla dinámica de Excel utilizando VBA
- 5. manera más eficiente de extraer una cadena
- 6. Base64 ¿Codifica un PDF en C#?
- 7. ¿Cómo puedo URL codificar una cadena en Excel VBA?
- 8. ¿Cómo convierto un entero en una cadena en Excel VBA?
- 9. Excel vba - cadena de conversión al número
- 10. Cómo Base64 codifica un objeto Java usando org.apache.commons.codec.binary.base64?
- 11. Cómo proteger el libro de Excel utilizando VBA?
- 12. ¿Por qué base64 codifica una clave de autorización API?
- 13. declarando una cadena Unicode en vba en excel
- 14. Subcadena de Excel VBA
- 15. Codifica una cadena de Ruby en una cadena JSON
- 16. cómo convertir una imagen en cadena base64
- 17. VBA de Excel: hacer que parte de la cadena negrita
- 18. Crear una tabla SQL de Excel VBA
- 19. matriz en Excel VBA
- 20. OnClick en Excel VBA
- 21. ¿Cómo decodifico una cadena codificada en base64?
- 22. ¿Cómo cambiar el nombre de una tabla de acceso utilizando VBA desde Excel?
- 23. cómo saber si una cadena es base64 o no
- 24. Node.js base64 codifica una imagen descargada para su uso en URI de datos
- 25. Excel VBA Regex Match Position
- 26. Excel VBA - salida de bucle
- 27. ¿Cómo generar XML desde una macro de Excel VBA?
- 28. Excel VBA - xlDown
- 29. Excel VBA Colón
- 30. ¿Cómo convertir una imagen en una cadena de Base64?
me ha gustado dbb código y tengo un ejemplo más completo publicado aquí: http://stackoverflow.com/questions/496751/base64-encode-string-in-vbscript/3029969#3029969 – rodnower
¿Hay alguna solución para esta codificación de una cadena Unicode? – Bora