分享
 
 
 

RSA加密算法在VB中的实现

王朝vb·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

-忘了摘自何处

' RSA加密算法在VB中的实现

Public key(1 To 3) As Long

Private Const base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrst

uvwxyz0123456789+/"

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

Private 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

Private Function Mult(ByVal x As Long, ByVal p As Long, ByVal m As Lon

g) 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

Private 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

Private 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 Len(DecryptedText) Step 3

c1 = Asc(Mid$(DecryptedText, n, 1))

c2 = Asc(Mid$(DecryptedText, n + 1, 1) + Chr$(0))

c3 = Asc(Mid$(DecryptedText, n + 2, 1) + Chr$(0))

w1 = Int(c1 / 4)

w2 = (c1 And 3) * 16 + Int(c2 / 16)

If Len(DecryptedText) >= n + 1 Then w3 = (c2 And 15) * 4 + Int(c

3 / 64) Else w3 = -1

If Len(DecryptedText) >= 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

Private 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 + Chr$(((w1 * 4 + Int(w2 / 16)) An

d 255))

If w3 >= 0 Then retry = retry + Chr$(((w2 * 16 + Int(w3 / 4)) An

d 255))

If w4 >= 0 Then retry = retry + Chr$(((w3 * 64 + w4) And 255))

Next

Base64_Decode = retry

End Function

Private 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 A

s 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 A

s 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

' To Be Continue...

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有