On 3/13/2025 12:37 PM, Alan K. wrote:
If you want the script I can post it, but if you want to use it
for a large mass of text you'd probably need to break it up into
chunks.
I wouldn't mind seeing that piece of code. Thanks.
As you may know, Base64 doesn't always end evenly, so there may
sometimes be equal signs at the end to round it off. For that reason,
if one wanted to decode blocks then they need to be a multiple of 4.
Here's a version that uses FileSystemObject. What's not showing is the
process of having FSO read in the text of a file. The Str64 parameter
is the base64 string. Watch out for wordwrap.:
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
This next one uses ADO, which is more efficient but is famously
funky about reading in text. It's recommended to read in chunks
of max size 128 KB. This one is the entire script, for encoding
or decoding. So, for example, if you have a photo stored in an
email, as long as you get that text cleanly, you can recreate the
image file. The FSO version handles carriage returns. I don't remember
about the ADO version. I expect it handles them internally.
Dim ADO, XML, s1, A1, Arg, IfEncode, oNode, sFil
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 XML = CreateObject("Msxml2.DOMDocument")
Set ADO = CreateObject("ADODB.Stream")
If IfEncode = True Then
With ADO
.Open
.Type = 1 'Binary
.LoadFromFile Arg
A1 = .Read
.Close
End With
Set oNode = XML.CreateElement("El")
oNode.DataType = "bin.base64"
oNode.NodeTypedValue = A1
s1 = oNode.Text
Set oNode = Nothing
With ADO
.Open
.Type = 2 'text
.Charset = "windows-1252"
.WriteText s1
sFil = Arg & "-64.txt"
.SaveToFile sFil, 2 'overwrite existing.
.Close
End With
Else
With ADO
.Open
.Type = 2 'text
.Charset = "windows-1252"
.LoadFromFile Arg
Dim iA, A2()
iA = 0
ReDim A2(100)
Do
s1 = .ReadText(128000)
If Len(s1) > 0 Then
A2(iA) = s1
Else
Exit Do
End If
iA = iA + 1
If iA mod 100 = 0 Then ReDim Preserve A2(iA + 100)
Loop
.Close
End With
s1 = Join(A2, "")
Set oNode = XML.CreateElement("El")
oNode.DataType = "bin.base64"
oNode.Text = s1
A1 = oNode.NodeTypedValue
Set oNode = Nothing
With ADO
.Open
.Type = 1 'binary
.Write A1
sFil = Arg & "-64.dat"
.SaveToFile sFil, 2 'overwrite existing.
.Close
End With
End If
MsgBox "Done. Saved as " & vbCrLf & sFil
Set ADO = Nothing
Set XML = Nothing
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)