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