home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD5615592000.psc / MIME_Coding.bas < prev    next >
Encoding:
BASIC Source File  |  1999-09-03  |  1.8 KB  |  55 lines

  1. Attribute VB_Name = "MIME_Coding"
  2. Private Const base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  3.  
  4. Public Function base64_encode(DecryptedText As String) As String
  5. Dim c1, c2, c3 As Integer
  6. Dim w1 As Integer
  7. Dim w2 As Integer
  8. Dim w3 As Integer
  9. Dim w4 As Integer
  10. Dim n As Integer
  11. Dim retry As String
  12.    For n = 1 To Len(DecryptedText) Step 3
  13.       c1 = Asc(Mid$(DecryptedText, n, 1))
  14.       c2 = Asc(Mid$(DecryptedText, n + 1, 1) + Chr$(0))
  15.       c3 = Asc(Mid$(DecryptedText, n + 2, 1) + Chr$(0))
  16.       w1 = Int(c1 / 4)
  17.       w2 = (c1 And 3) * 16 + Int(c2 / 16)
  18.       If Len(DecryptedText) >= n + 1 Then w3 = (c2 And 15) * 4 + Int(c3 / 64) Else w3 = -1
  19.       If Len(DecryptedText) >= n + 2 Then w4 = c3 And 63 Else w4 = -1
  20.       retry = retry + mimeencode(w1) + mimeencode(w2) + mimeencode(w3) + mimeencode(w4)
  21.    Next
  22.    base64_encode = retry
  23. End Function
  24.  
  25. Public Function base64_decode(a As String) As String
  26. Dim w1 As Integer
  27. Dim w2 As Integer
  28. Dim w3 As Integer
  29. Dim w4 As Integer
  30. Dim n As Integer
  31. Dim retry As String
  32.  
  33.    For n = 1 To Len(a) Step 4
  34.       w1 = mimedecode(Mid$(a, n, 1))
  35.       w2 = mimedecode(Mid$(a, n + 1, 1))
  36.       w3 = mimedecode(Mid$(a, n + 2, 1))
  37.       w4 = mimedecode(Mid$(a, n + 3, 1))
  38.       If w2 >= 0 Then retry = retry + Chr$(((w1 * 4 + Int(w2 / 16)) And 255))
  39.       If w3 >= 0 Then retry = retry + Chr$(((w2 * 16 + Int(w3 / 4)) And 255))
  40.       If w4 >= 0 Then retry = retry + Chr$(((w3 * 64 + w4) And 255))
  41.    Next
  42.    base64_decode = retry
  43. End Function
  44.  
  45. Private Function mimeencode(w As Integer) As String
  46.    If w >= 0 Then mimeencode = Mid$(base64, w + 1, 1) Else mimeencode = ""
  47. End Function
  48.  
  49. Private Function mimedecode(a As String) As Integer
  50.    If Len(a) = 0 Then mimedecode = -1: Exit Function
  51.    mimedecode = InStr(base64, a) - 1
  52. End Function
  53.  
  54.  
  55.