二级VBBase64编码类代码
来源:优易学  2011-10-10 9:48:32   【优易学:中国教育考试门户网】   资料下载   IT书店


  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
  Public Function Base64_Encode()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 LenB(StrConv(DecryptedText, vbFromUnicode)) Step 3
  c1 = AscB(MidB$(DecryptedText, n, 1))
  c2 = AscB(Mid$(DecryptedText, n + 1, 1) + ChrB$(0))
  c3 = AscB(Mid$(DecryptedText, n + 2, 1) + ChrB$(0))
  w1 = Int(c1 / 4)
  w2 = (c1 And 3) * 16 + Int(c2 / 16)
  If LenB(StrConv(DecryptedText, vbFromUnicode)) >= n + 1 Then w3 = (c2 And 15) * 4 + Int(c3 / 64) Else w3 = -1
  If LenB(StrConv(DecryptedText, vbFromUnicode)) >= 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
  Public Function Base64_Decode()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 + ChrB$(((w1 * 4 + Int(w2 / 16)) And 255))
  If w3 >= 0 Then retry = retry + ChrB$(((w2 * 16 + Int(w3 / 4)) And 255))
  If w4 >= 0 Then retry = retry + ChrB$(((w3 * 64 + w4) And 255))
  Next
  Base64_Decode = StrConv(retry, vbUnicode)
  End Function

  Public Function mimeencode()Function mimeencode(w As Integer) As String
  If w >= 0 Then mimeencode = Mid$(base64, w + 1, 1) Else mimeencode = ""
  End Function
  Private Function mimedecode()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()Function Encode(ByVal Inp As String, ByVal e As Long, ByVal n As 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()Function Decode(ByVal Inp As String, ByVal d As Long, ByVal n As 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

上一页  [1] [2] 

责任编辑:小草

文章搜索:
 相关文章
热点资讯
资讯快报
热门课程培训