Base64加密解密VB源码

小歆13年前软件源码13778
base64加密模块
用法:Base64Encode(‘加密字符')


Option Explicit
Public Function Base64Encode(InStr1 As String) As String
Dim mInByte(3) As Byte, mOutByte(4) As Byte
Dim myByte As Byte
Dim I As Integer, LenArray As Integer, j As Integer
Dim myBArray() As Byte
Dim OutStr1 As String
myBArray() = StrConv(InStr1, vbFromUnicode)
LenArray = UBound(myBArray) + 1
For I = 0 To LenArray Step 3
If LenArray - I = 0 Then
Exit For
End If
If LenArray - I = 2 Then
mInByte(0) = myBArray(I)
mInByte(1) = myBArray(I + 1)
Base64EncodeByte mInByte, mOutByte, 2
ElseIf LenArray - I = 1 Then
mInByte(0) = myBArray(I)
Base64EncodeByte mInByte, mOutByte, 1
Else
mInByte(0) = myBArray(I)
mInByte(1) = myBArray(I + 1)
mInByte(2) = myBArray(I + 2)
Base64EncodeByte mInByte, mOutByte, 3
End If
For j = 0 To 3
OutStr1 = OutStr1 & Chr(mOutByte(j))
Next j
Next I
Base64Encode = OutStr1
End Function
Private Sub Base64EncodeByte(mInByte() As Byte, mOutByte() As Byte, Num As Integer)
Dim tByte As Byte
Dim I As Integer
If Num = 1 Then
mInByte(1) = 0
mInByte(2) = 0
ElseIf Num = 2 Then
mInByte(2) = 0
End If
tByte = mInByte(0) And &HFC
mOutByte(0) = tByte / 4
tByte = ((mInByte(0) And &H3) * 16) + (mInByte(1) And &HF0) / 16
mOutByte(1) = tByte
tByte = ((mInByte(1) And &HF) * 4) + ((mInByte(2) And &HC0) / 64)
mOutByte(2) = tByte
tByte = (mInByte(2) And &H3F)
mOutByte(3) = tByte
For I = 0 To 3
If mOutByte(I) >= 0 And mOutByte(I) <= 25 Then
mOutByte(I) = mOutByte(I) + Asc("A")
ElseIf mOutByte(I) >= 26 And mOutByte(I) <= 51 Then
mOutByte(I) = mOutByte(I) - 26 + Asc("a")
ElseIf mOutByte(I) >= 52 And mOutByte(I) <= 61 Then
mOutByte(I) = mOutByte(I) - 52 + Asc("0")
ElseIf mOutByte(I) = 62 Then
mOutByte(I) = Asc("+")
Else
mOutByte(I) = Asc("/")
End If
Next I
If Num = 1 Then
mOutByte(2) = Asc("=")
mOutByte(3) = Asc("=")
ElseIf Num = 2 Then
mOutByte(3) = Asc("=")
End If
End Sub
Public Function Base64Decode(InStr1 As String) As String
Dim mInByte(4) As Byte, mOutByte(3) As Byte
Dim I As Integer, LenArray As Integer, j As Integer
Dim myBArray() As Byte
Dim OutStr1 As String
Dim tmpArray() As Byte
myBArray() = StrConv(InStr1, vbFromUnicode)
LenArray = UBound(myBArray)
ReDim tmpArray(((LenArray + 1) / 4) * 3)
j = 0
For I = 0 To LenArray Step 4
If LenArray - I = 0 Then
Exit For
Else
mInByte(0) = myBArray(I)
mInByte(1) = myBArray(I + 1)
mInByte(2) = myBArray(I + 2)
mInByte(3) = myBArray(I + 3)
Base64DecodeByte mInByte, mOutByte, 4
End If
tmpArray(j * 3) = mOutByte(0)
tmpArray(j * 3 + 1) = mOutByte(1)
tmpArray(j * 3 + 2) = mOutByte(2)
j = j + 1
Next I
Base64Decode = BinaryToString(tmpArray)
End Function
Private Sub Base64DecodeByte(mInByte() As Byte, mOutByte() As Byte, ByteNum As Integer)
Dim tByte As Byte
Dim I As Integer
ByteNum = 0
For I = 0 To 3
If mInByte(I) >= Asc("A") And mInByte(I) <= Asc("Z") Then
mInByte(I) = mInByte(I) - Asc("A")
ElseIf mInByte(I) >= Asc("a") And mInByte(I) <= Asc("z") Then
mInByte(I) = mInByte(I) - Asc("a") + 26
ElseIf mInByte(I) >= Asc("0") And mInByte(I) <= Asc("9") Then
mInByte(I) = mInByte(I) - Asc("0") + 52
ElseIf mInByte(I) = Asc("+") Then
mInByte(I) = 62
ElseIf mInByte(I) = Asc("/") Then
mInByte(I) = 63
Else '"="
ByteNum = ByteNum + 1
mInByte(I) = 0
End If
Next I
tByte = (mInByte(0) And &H3F) * 4 + (mInByte(1) And &H30) / 16
mOutByte(0) = tByte
tByte = (mInByte(1) And &HF) * 16 + (mInByte(2) And &H3C) / 4
mOutByte(1) = tByte
tByte = (mInByte(2) And &H3) * 64 + (mInByte(3) And &H3F)
mOutByte(2) = tByte
End Sub
Private Function BinaryToString(ByVal BinaryStr As Variant) As String
Dim lnglen As Long
Dim tmpBin As Variant
Dim strC As String
Dim skipflag As Long
Dim I As Long
skipflag = 0
strC = ""
If Not IsNull(BinaryStr) Then
lnglen = LenB(BinaryStr)
For I = 1 To lnglen
If skipflag = 0 Then
tmpBin = MidB(BinaryStr, I, 1)
If AscB(tmpBin) > 127 Then
strC = strC & Chr(AscW(MidB(BinaryStr, I + 1, 1) & tmpBin))
skipflag = 1
Else
strC = strC & Chr(AscB(tmpBin))
End If
Else
skipflag = 0
End If
Next
End If
BinaryToString = strC
End Function
Private Function StringToBinary(ByVal VarString As String) As Variant
Dim strBin As Variant
Dim varchar As Variant
Dim varasc As Long
Dim varlow, varhigh
Dim I As Long
strBin = ""
For I = 1 To Len(VarString)
varchar = Mid(VarString, I, 1)
varasc = Asc(varchar)
If varasc < 0 Then
varasc = varasc + 65535
End If
If varasc > 255 Then
varlow = Left(Hex(Asc(varchar)), 2)
varhigh = Right(Hex(Asc(varchar)), 2)
strBin = strBin & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
Else
strBin = strBin & ChrB(AscB(varchar))
End If
Next
StringToBinary = strBin
End Function

 
base64解密模块
用法:DecodeBase64String("解密字符")

Next
DecodeBase64Byte = Output
End Function

'将一个字节数组进行Base64编码,并返回字符串
Public Function EncodeBase64Byte(sValue() As Byte) As String
Dim lCtr As Long
Dim lPtr As Long
Dim lLen As Long
Dim sEncoded As String
Dim Bits8(1 To 3) As Byte
Dim Bits6(1 To 4) As Byte
Dim I As Integer
InitBase
For lCtr = 1 To UBound(sValue) + 1 Step 3
For I = 1 To 3
If lCtr + I - 2 <= UBound(sValue) Then
Bits8(I) = sValue(lCtr + I - 2)
lLen = 3
Else
Bits8(I) = 0
lLen = lLen - 1
End If
Next
Bits6(1) = (Bits8(1) And &HFC) \ 4
Bits6(2) = (Bits8(1) And &H3) * &H10 + (Bits8(2) And &HF0) \ &H10
Bits6(3) = (Bits8(2) And &HF) * 4 + (Bits8(3) And &HC0) \ &H40
Bits6(4) = Bits8(3) And &H3F
For lPtr = 1 To lLen + 1
sEncoded = sEncoded & psBase64Chr(Bits6(lPtr))
Next
Next
Select Case lLen + 1
Case 2: sEncoded = sEncoded & "=="
Case 3: sEncoded = sEncoded & "="
Case 4:
End Select
EncodeBase64Byte = sEncoded
End Function
Public Function EncodeBase64String(str2Encode As String) As String
Dim sValue() As Byte
sValue = StrConv(str2Encode, vbFromUnicode)
EncodeBase64String = EncodeBase64Byte(sValue)
End Function
Private Sub InitBase()
Dim iPtr As Integer
For iPtr = 0 To 63
psBase64Chr(iPtr) = Mid$(BASE64CHR, iPtr + 1, 1)
Next
End Sub







相关文章

防止错误插入电池的新方法

防止错误插入电池的新方法

只要是电池供电的系统,就一直存在这个问题: 您错误装入电池,将正负极装反,产生反向极性事件。系统暂时出现故障或永久损坏。 设计为适合其装配的系统的定制电池有助于最大程度减少不正确插...

VC6.0-a.jpg

VC++6.0(windows7兼容版)下载【中/英】

Visual C++ 6.0 windows7兼容版 VC6.0安装版,完美支持Win7和Win XP系统,亲测可用,在Windows7 64位和 Wind...

★主板维修精华★

1. BIOS作用:BIOS是开机初始化,检测系统安装设备类型,数量等。 2. RESET的产生过程:PG→(门电路,南桥)→RESET复位(ISA槽B2脚,P...

小歆工作室旗下网盘开启公测!!!

小歆工作室旗下网盘开启公测!!!

小歆免费网络硬盘 小歆工作室旗下 二零一三年的冬天,小歆工作室又有新产品上线了 —— 小歆网盘...

[微软官方]USB2.0提速补丁(x86x64) 官方版

[微软官方]USB2.0提速补丁(x86x64) 官方版

免费为USB2.0设备提速补丁USB2.0提速补丁(x86x64) 官方版 USB2.0提速补丁是一款HotFix热修复补丁,并没有作为常规补丁随系统自动更新,所以我们可以自己来手动下载安装。...

Android开发宝典之 Android程序员入门

Android开发宝典之 Android程序员入门

简介 Android作为一个系统,是一个运行在Linux2.6核心上的JAVA基础的操作系统。系统是非常轻量型的而且全特性。本文介绍了Android开发的基本知识,很实用。 目录...

评论列表

爱好者
2021-01-05 16:51:04

DecodeBase64String("解密字符")这块代码能否放完整,多谢

发表评论    

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。