从网上找的多数不支持中文的编码解码,做了一下修改,支持中文的解码,编码还没有完成。
Public key(1 To 3) As Long
Private Const base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Public Sub GenKey()
Dim d As Long, phi As Long, e As Long
Dim m As Long, x As Long, q As Long
Dim p As Long
Randomize
On Error GoTo top
top:
p = Rnd * 1000 \ 1
If IsPrime(p) = False Then GoTo top
Sel_q:
q = Rnd * 1000 \ 1
If IsPrime(q) = False Then GoTo Sel_q
n = p * q \ 1
phi = (p - 1) * (q - 1) \ 1
d = Rnd * n \ 1
If d = 0 Or n = 0 Or d = 1 Then GoTo top
e = Euler(phi, d)
If e = 0 Or e = 1 Then GoTo top
x = Mult(255, e, n)
If Not Mult(x, d, n) = 255 Then
DoEvents
GoTo top
ElseIf Mult(x, d, n) = 255 Then
key(1) = e
key(2) = d
key(3) = n
End If
End Sub
Public Function Euler(ByVal a As Long, ByVal b As Long) As Long
On Error GoTo error2
r1 = a: r = b
p1 = 0: p = 1
q1 = 2: q = 0
n = -1
Do Until r = 0
r2 = r1: r1 = r
p2 = p1: p1 = p
q2 = q1: q1 = q
n = n + 1
r = r2 Mod r1
c = r2 \ r1
p = (c * p1) + p2
q = (c * q1) + q2
Loop
s = (b * p1) - (a * q1)
If s > 0 Then
x = p1
Else
x = (0 - p1) + a
End If
Euler = x
Exit Function
error2:
Euler = 0
End Function
Public Function Mult(ByVal x As Long, ByVal p As Long, ByVal m As Long) As Long
y = 1
On Error GoTo error1
Do While p > 0
Do While (p / 2) = (p \ 2)
x = (x * x) Mod m
p = p / 2
Loop
y = (x * y) Mod m
p = p - 1
Loop
Mult = y
Exit Function
error1:
y = 0
End Function
Public Function IsPrime(lngNumber As Long) As Boolean
Dim lngCount As Long
Dim lngSqr As Long
Dim x As Long
lngSqr = Sqr(lngNumber) ' get the int square root
If lngNumber < 2 Then
IsPrime = False
Exit Function
End If
lngCount = 2
IsPrime = True
If lngNumber Mod lngCount = 0& Then
IsPrime = False
Exit Function
End If
lngCount = 3
For x& = lngCount To lngSqr Step 2
If lngNumber Mod x& = 0 Then
IsPrime = False
Exit Function
End If
Next
End Function
Public Function Base64_Encode(DecryptedText As String) As String
Dim c1, c2, c3 As Integer
Dim w1 As Integer
Dim w2 As Integer
Dim w3 As Integer
Dim w4 As Integer
Dim n As Integer
Dim retry As String
For n = 1 To LenB(StrConv(DecryptedText, vbFromUnicode)) Step 3
c1 = AscB(MidB$(DecryptedText, n, 1))
c2 = AscB(Mid$(DecryptedText, n + 1, 1) + ChrB$(0))
c3 = AscB(Mid$(DecryptedText, n + 2, 1) + ChrB$(0))
w1 = Int(c1 / 4)
w2 = (c1 And 3) * 16 + Int(c2 / 16)
If LenB(StrConv(DecryptedText, vbFromUnicode)) >= n + 1 Then w3 = (c2 And 15) * 4 + Int(c3 / 64) Else w3 = -1
If LenB(StrConv(DecryptedText, vbFromUnicode)) >= n + 2 Then w4 = c3 And 63 Else w4 = -1
retry = retry + mimeencode(w1) + mimeencode(w2) + mimeencode(w3) + mimeencode(w4)
Next
Base64_Encode = retry
End Function
Public Function Base64_Decode(a As String) As String
Dim w1 As Integer
Dim w2 As Integer
Dim w3 As Integer
Dim w4 As Integer
Dim n As Integer
Dim retry As String
For n = 1 To Len(a) Step 4
w1 = mimedecode(Mid$(a, n, 1))
w2 = mimedecode(Mid$(a, n + 1, 1))
w3 = mimedecode(Mid$(a, n + 2, 1))
w4 = mimedecode(Mid$(a, n + 3, 1))
If w2 >= 0 Then retry = retry + ChrB$(((w1 * 4 + Int(w2 / 16)) And 255))
If w3 >= 0 Then retry = retry + ChrB$(((w2 * 16 + Int(w3 / 4)) And 255))
If w4 >= 0 Then retry = retry + ChrB$(((w3 * 64 + w4) And 255))
Next
Base64_Decode = StrConv(retry, vbUnicode)
End Function
Public Function mimeencode(w As Integer) As String
If w >= 0 Then mimeencode = Mid$(base64, w + 1, 1) Else mimeencode = ""
End Function
Private Function mimedecode(a As String) As Integer
If Len(a) = 0 Then mimedecode = -1: Exit Function
mimedecode = InStr(base64, a) - 1
End Function
Public Function Encode(ByVal Inp As String, ByVal e As Long, ByVal n As Long) As String
Dim s As String
s = ""
m = Inp
If m = "" Then Exit Function
s = Mult(CLng(Asc(Mid(m, 1, 1))), e, n)
For i = 2 To Len(m)
s = s & "+" & Mult(CLng(Asc(Mid(m, i, 1))), e, n)
Next i
Encode = Base64_Encode(s)
End Function
Public Function Decode(ByVal Inp As String, ByVal d As Long, ByVal n As Long) As String
St = ""
ind = Base64_Decode(Inp)
For i = 1 To Len(ind)
nxt = InStr(i, ind, "+")
If Not nxt = 0 Then
tok = Val(Mid(ind, i, nxt))
Else
tok = Val(Mid(ind, i))
End If
St = St + Chr(Mult(CLng(tok), d, n))
If Not nxt = 0 Then
i = nxt
Else
i = Len(ind)
End If
Next i
Decode = St
End Function
分享到:
相关推荐
1. 发现错误并改错。给出一个实现插入排序的程序,文件名为InsertionSort.java,该文件中有代码错误,请单步调试,发现错误,... 必须自己编写代码来实现BASE64编码和解码函数。可以为该类添加其他数据成员和函数成员。
1. 发现错误并改错。给出一个实现插入排序的程序,文件名为InsertionSort.java,该文件中有代码错误,请单步调试,发现错误,... 必须自己编写代码来实现BASE64编码和解码函数。可以为该类添加其他数据成员和函数成员。
然而,一个映射可能是由一个URL和许多Servlet实例组成,例如:一个分布式的Servlet引擎可能运行在不止一个的服务器中,这样的话,每一个服务器中都可能有一个Servlet实例,以平衡进程的载入。作为一个Servlet的...
1、先创建一个 base.js 的文件 2、在文件中执行以下代码 console.log(" .... ... "); [removed](" ... ... "); window.alert("这是在外部脚本文件中的内容"); 3、在 html 文档中,引入 base.js 文件 ...
14.6.2 Base-64字符串编码和解码 14.7 安全字符串 第15章 枚举类型和位标志 15.1 枚举类型 15.2 位标志 15.3 向枚举类型添加方法 第16章 数组 16.1 初始化数组元素 16.2 数组转型 16.3 所有数组都隐式派生...
14.6.2 Base-64字符串编码和解码 14.7 安全字符串 第15章 枚举类型和位标志 15.1 枚举类型 15.2 位标志 15.3 向枚举类型添加方法 第16章 数组 16.1 初始化数组元素 16.2 数组转型 16.3 所有数组都隐式派生...
14.6.2 Base-64字符串编码和解码 14.7 安全字符串 第15章 枚举类型和位标志 15.1 枚举类型 15.2 位标志 15.3 向枚举类型添加方法 第16章 数组 16.1 初始化数组元素 16.2 数组转型 16.3 所有数组都隐式派生...
14.6.2 Base-64字符串编码和解码 14.7 安全字符串 第15章 枚举类型和位标志 15.1 枚举类型 15.2 位标志 15.3 向枚举类型添加方法 第16章 数组 16.1 初始化数组元素 16.2 数组转型 16.3 所有数组都隐式派生...
实例014 使当前项目依赖另一个项目 21 1.3 界面设计器 22 实例015 安装界面设计器 22 实例016 设计Windows系统的运行对话框 界面 23 实例017 设计计算器程序界面 26 实例018 设计关于进销存管理系统的界面 27 第2章 ...