请问谁有VB脚本写好了BASE64的加密算法

Question

在网上看到一些，但复制下来都不能用，有些函数还不完整，谁有能用的VB脚本给一个。谢谢

Answer 1

脚本这个词不适合VB吧应该是函数10分不想给。加到100就写一个:D

Answer 2

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 = re 
try + 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 
经典加密算法在VB中的实现（2）- MD5 
经典加密算法在VB中的实现（3）- RC4 经典加密算法在VB中的实现（4）- DES

Answer 3

Option   Explicit   
  Dim   charlist   As   String   
  Private   Function   Base64encode(ByVal   s   As   String)   As   String   
        Dim   ByteArray()   As   Byte   
        ByteArray   =   StrConv(s,   vbFromUnicode)   '将字串转为byte数组   
        Dim   tempstr   As   String   
        Dim   stemp   As   String   
        Dim   i   As   Long   
        Dim   j   As   Long,   k   As   Long   
        Dim   num1   As   Long,   num2   As   Long,   num3   As   Long,   num4   As   Long   
        i   =   UBound(ByteArray)   
        i   =   (i   +   1)   Mod   3   
        Select   Case   i   
        Case   0   
                  If   s   =   vbNullString   Then   
                          Base64encode   =   ""   
                          Exit   Function   
                  End   If   
                  For   j   =   0   To   UBound(ByteArray)   Step   3   
                          num1   =   ByteArray(j)   \   2   ^   2   '右移2位，即取前6位   
                          num2   =   (ByteArray(j)   And   3)   *   2   ^   4   +   ByteArray(j   +   1)   \   2   ^   4   
                          num3   =   (ByteArray(j   +   1)   And   15)   *   2   ^   2   +   ByteArray(j   +   2)   \   2   ^   6   
                          num4   =   ByteArray(j   +   2)   And   63   
                          stemp   =   Mid(charlist,   num1   +   1,   1)   &   Mid(charlist,   num2   +   1,   1)   &   Mid(charlist,   num3   +   1,   1)   &   Mid(charlist,   num4   +   1,   1)   
                          tempstr   =   tempstr   +   stemp   
                  Next   
        Case   1   
                  For   j   =   0   To   UBound(ByteArray)   -   1   Step   3   
                          num1   =   ByteArray(j)   \   2   ^   2   '右移2位，即取前6位   
                          num2   =   (ByteArray(j)   And   3)   *   2   ^   4   +   ByteArray(j   +   1)   \   2   ^   4   
                          num3   =   (ByteArray(j   +   1)   And   15)   *   2   ^   2   +   ByteArray(j   +   2)   \   2   ^   6   
                          num4   =   ByteArray(j   +   2)   And   63   
                          stemp   =   Mid(charlist,   num1   +   1,   1)   &   Mid(charlist,   num2   +   1,   1)   &   Mid(charlist,   num3   +   1,   1)   &   Mid(charlist,   num4   +   1,   1)   
                          tempstr   =   tempstr   +   stemp   
                  Next   
                  '处理数组的最后1个元素   
                  k   =   UBound(ByteArray)   
                  num1   =   ByteArray(k)   \   2   ^   2   
                  num2   =   (ByteArray(k)   And   3)   *   2   ^   4   
                  stemp   =   Mid(charlist,   num1   +   1,   1)   &   Mid(charlist,   num2   +   1,   1)   &   "=="   
                  tempstr   =   tempstr   +   stemp   
        Case   2   
                  For   j   =   0   To   UBound(ByteArray)   -   2   Step   3   
                          num1   =   ByteArray(j)   \   2   ^   2   '右移2位，即取前6位   
                          num2   =   (ByteArray(j)   And   3)   *   2   ^   4   +   ByteArray(j   +   1)   \   2   ^   4   
                          num3   =   (ByteArray(j   +   1)   And   15)   *   2   ^   2   +   ByteArray(j   +   2)   \   2   ^   6   
                          num4   =   ByteArray(j   +   2)   And   63   
                          stemp   =   Mid(charlist,   num1   +   1,   1)   &   Mid(charlist,   num2   +   1,   1)   &   Mid(charlist,   num3   +   1,   1)   &   Mid(charlist,   num4   +   1,   1)   
                          tempstr   =   tempstr   +   stemp   
                  Next   
                  '处理数组的最后2个元素   
                  k   =   UBound(ByteArray)   
                  num1   =   ByteArray(k   -   1)   \   2   ^   2   '右移2位，即取前6位   
                  num2   =   (ByteArray(k   -   1)   And   3)   *   2   ^   4   +   ByteArray(k)   \   2   ^   4   
                  num3   =   (ByteArray(k)   And   15)   *   2   ^   2   
                  stemp   =   Mid(charlist,   num1   +   1,   1)   &   Mid(charlist,   num2   +   1,   1)   &   Mid(charlist,   num3   +   1,   1)   &   "="   
                  tempstr   =   tempstr   +   stemp   
        End   Select   
          
        Base64encode   =   tempstr   
  End   Function   
    
  Private   Sub   Command1_Click()   
    
          Debug.Print   Base64encode("中")   
    
  End   Sub   
    
    
  Private   Sub   Form_Load()   
          charlist   =   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"   
  End   Sub   

Answer 4

去看 KiteGirl（小仙妹） 的BLOGblog.csdn.net/kitegirl

Answer 5

daisy8675(莫依 沉迷) ( ) 信誉：136    Blog   加为好友  2007-6-20 15:22:28  得分: 0  
 
 
   
脚本这个词不适合VB吧应该是函数10分不想给。加到100就写一个:D//mMM啥时候也这么势利了:D

Answer 6

LZ找LS这个MM一定米错滴~~:D和她耗上^O^