编码代码是在原来别人写的一段代码改的 '加密进输入的字节,所以就可以加密二制文件等,返回的是一Ba64的字符串 Function B64E(inData() As Byte) As String On Error Resume Next Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim UB As Long, lB As Long '数组的上限和下限 Dim sOut, cOut, i Dim nGroup As Long Dim pOut, sGroup UB = UBound(inData) Dim Second As Byte Dim Thrid As Byte lB = LBound(inData) If Err.Number <> 0 Then B64E = "" Exit Function End If For i = lB To UB Step 3 If i + 1 > UB Then Second = 0 Thrid = 0 ElseIf i + 2 > UB Then Second = inData(i + 1) Thrid = 0 Else Second = inData(i + 1) Thrid = inData(i + 2) End If nGroup = &H10000 * inData(i) + &H100 * Second + Thrid sGroup = Oct(nGroup) sGroup = String(8 - Len(sGroup), "0") + sGroup pOut = Mid(Base64, CLng("&o" + Mid(sGroup, 1, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 3, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 5, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 7, 2)) + 1, 1) sOut = sOut + pOut If (i + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf nGroup = 0 Next i Select Case (UB - lB + 1) Mod 3 Case 1 sOut = Left(sOut, Len(sOut) - 2) + "==" Case 2 sOut = Left(sOut, Len(sOut) - 1) + "=" End Select B64E = sOut End Function '返回的也是一字节数组 Public Function B64U(ByVal inData As String, OutData() As Byte) As Boolean On Error GoTo Errhandle Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim UB As Long, lB As Long '数组的上限和下限 Dim sOut, cOut, i Dim nGroup As Long Dim pOut, sGroup inData = Replace(inData, vbCrLf, "") ReDim OutData(0 To (Int(Len(inData) / 4) + 1) * 3 - 1) As Byte For i = 1 To (Len(inData) - Len(inData) Mod 4) Step 4 nGroup = &O1000000 * (InStr(Base64, Mid(inData, i, 1)) - 1) + &O10000 * (InStr(Base64, Mid(inData, i + 1, 1)) - 1) + _ &O100 * (IIf(InStr(Base64, Mid(inData, i + 2, 1)) = 0, 1, InStr(Base64, Mid(inData, i + 2, 1))) - 1) _ + (IIf(InStr(Base64, Mid(inData, i + 3, 1)) = 0, 1, InStr(Base64, Mid(inData, i + 3, 1))) - 1) sGroup = Trim(Hex(nGroup)) '转成16位的 sGroup = String(6 - Len(sGroup), "0") & sGroup '如果不够六位用0去补 OutData(Int(i / 4) * 3) = Val("&H" & Mid(sGroup, 1, 2)) OutData(Int(i / 4) * 3 + 1) = Val("&H" & Mid(sGroup, 3, 2)) OutData(Int(i / 4) * 3 + 2) = Val("&H" & Mid(sGroup, 5, 2)) Next i Select Case Len(inData) - Len(Replace(inData, "=", "")) Case 1 ReDim Preserve OutData(0 To (Int(Len(inData) / 4) + 1) * 3 - 2) As Byte Case 2 ReDim Preserve OutData(0 To (Int(Len(inData) / 4) + 1) * 3 - 3) As Byte End Select B64U = True Exit Function Errhandle: B64U = False End Function '这段代码可以加密二进制数据,像图片文件等都没有问题, 调用方法: Private Sub Command1_Click() Dim arrstr() As Byte arrstr = StrConv(Text1.Text, vbFromUnicode) Text2.Text = B64E(arrstr) End Sub Private Sub Command2_Click() Dim OutData() As Byte If B64U(Text2.Text, OutData) = True Then Text1.Text = CStr(OutData) End If End Sub

|