Base64加密解密VB源码

小歆13年前软件源码12224
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







相关文章

VB键盘代码真值表

VB键盘代码常量 值 (0x...

VB(十六进制)颜色代码与RGB互转工具V2.0(附屏幕取色工具)06.jpg

【VB源码】十六进制颜色代码与RGB互转工具

VB(十六进制)颜色代码与RGB互转工具     功能介绍:     1.《VB(十六进制)颜色代码与RGB互转工具》是由《VB颜色代...

MD5加密算法VB源码

今天在在网页的源代码中找到了MD5加密算法的代码,呵呵,搬过来VB用了~~ 直接调用就可以了  Private Const BITS_TO_A_BYTE = 8 P...

小歆专用挂机锁V1.0正式版00.jpg

[小歆][专用挂机锁][V1.0][正式版][2012.10.28]

本软件已升级至1.5,http://www.xxgzs.org/forum.php?mod=viewthread&tid=86    **************...

VB 调用摄像头拍照,并保存图片...

VB 调用摄像头拍照 1、首先创建一个标准EXE工程 2、在窗体代码中加入如下必需的API及一个拍照的自定义函数 Private...

ゆえばおしょうyい.jpg

【VB源码】余额宝收益值查询工具

名称:(支付宝)余额宝收益值查询工具V1.0 作者:小歆 说明:通过调用官网的“万份收益值”来计算“收益资金”,程序很简单,大牛勿喷! 源码下载: 余额宝查询...

评论列表

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

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

发表评论    

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