Sub hgf() Sub CustomEncode() Dim inputString As String inputString="*******" Dim encodedString As String encodedString= CustomEncode(inputString) MsgBox "自定义编码结果为: " & vbCrLf & encodedString End Sub
Function CustomEncode(inputString As String) As String Dim charSet As String charSet="*******************" Dim byteArray() As Byte byteArray= StrConv(inputString, vbFromUnicode) Dim encodedString As String encodedString="" Dim i As Integer Dim n As Long Fori=1 To LenB(byteArray) Step 3 n = 0 n = (n Or(ByteToInt(MidB(byteArray, i, 1)) << 16)) If i + 1 <= LenB(byteArray) Then n= (n Or(ByteToInt(MidB(byteArray, i + 1, 1)) << 8)) End If If i + 2 <= LenB(byteArray) Then n= (n Or ByteToInt(MidB(byteArray, i + 2, 1))) End If
encodedString= encodedString & Mid(charSet, (n >> 18) + 1, 1) encodedString = encodedString & Mid(charSet, ((n >> 12) And &H3F) + 1, 1) If (i + 1) <= LenB(byteArray) Then encodedString= encodedString & Mid(charSet, ((n >> 6) And &H3F) + 1, 1) Else encodedString= encodedString & "=" End If If(i + 2) <= LenB(byteArray) Then encodedString= encodedString & Mid(charSet, (n And &H3F) + 1, 1) Else encodedString= encodedString & "=" End If Next i CustomEncode= encodedString End Function
Function ByteToInt(byteVal As Byte) As Long ByteToInt= CLng(byteVal) End Function End Function "5uESz7on4R8eyC//"
defcustom_decode(encoded_str, char_set): char_map = {char: index for index, char inenumerate(char_set)} decoded_bytes = bytearray() i = 0 while i < len(encoded_str): chunk = encoded_str[i:i+4] num = 0 pad = chunk.count("=") chunk = chunk.rstrip("=") for c in chunk: num = (num << 6) + char_map[c] if pad < 3: decoded_bytes.append((num >> 16) & 0xFF) if pad < 2: decoded_bytes.append((num >> 8) & 0xFF) if pad < 1: decoded_bytes.append(num & 0xFF) i += 4