求base 64加密算法要求有代码!一定给分!

解决方案 »

  1.   

    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