－忘了摘自何處
' 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...
