home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD176803292001.psc / cipher.cls < prev    next >
Encoding:
Visual Basic class definition  |  2001-02-08  |  3.3 KB  |  129 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Cipher"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. Private mStrKey As String
  16. Private mStrText As String
  17. Public EncText As String
  18.  
  19. '~~~.KeyString
  20. 'A string (key) used in encryption and decryption
  21. Public Property Let KeyString(strKey As String)
  22.     mStrKey = strKey
  23.     Initialize
  24. End Property
  25.  
  26. 'Write text to be encrypted or decrypted
  27. Public Property Let Text(strText As String)
  28.     mStrText = strText
  29. End Property
  30.  
  31. 'Read text that was encrypted or decrypted
  32. Public Property Get Text() As String
  33.     Text = mStrText
  34. End Property
  35.  
  36. 'Exclusive-or method to encrypt or decrypt
  37. Public Sub DoXor()
  38. On Error Resume Next
  39.     Dim lngC As Long
  40.     Dim intB As Long
  41.     Dim lngN As Long
  42.     For lngN = 1 To Len(mStrText)
  43.         lngC = Asc(Mid(mStrText, lngN, 1))
  44.         intB = Int(Rnd * 256)
  45.         Mid(mStrText, lngN, 1) = Chr(lngC Xor intB)
  46.     Next lngN
  47.  
  48. End Sub
  49.  
  50. 'Convert any string to a printable, displayable string
  51. Public Sub Stretch()
  52. On Error Resume Next
  53.     Dim lngC As Long
  54.     Dim lngN As Long
  55.     Dim lngJ As Long
  56.     Dim lngK As Long
  57.     Dim lngA As Long
  58.     Dim strB As String
  59.     lngA = Len(mStrText)
  60.     strB = Space(lngA + (lngA + 2) \ 3)
  61.     For lngN = 1 To lngA
  62.         lngC = Asc(Mid(mStrText, lngN, 1))
  63.         lngJ = lngJ + 1
  64.         Mid(strB, lngJ, 1) = Chr((lngC And 63) + 59)
  65.         Select Case lngN Mod 3
  66.         Case 1
  67.             lngK = lngK Or ((lngC \ 64) * 16)
  68.         Case 2
  69.             lngK = lngK Or ((lngC \ 64) * 4)
  70.         Case 0
  71.             lngK = lngK Or (lngC \ 64)
  72.             lngJ = lngJ + 1
  73.             Mid(strB, lngJ, 1) = Chr(lngK + 59)
  74.             lngK = 0
  75.         End Select
  76.     Next lngN
  77.     If lngA Mod 3 Then
  78.         lngJ = lngJ + 1
  79.         Mid(strB, lngJ, 1) = Chr(lngK + 59)
  80.     End If
  81.     mStrText = strB
  82. End Sub
  83.  
  84. '~~~.Shrink
  85. 'Inverse of the Stretch method;
  86. 'result can contain any of the 256-byte values
  87. Public Sub Shrink()
  88. On Error Resume Next
  89.     Dim lngC As Long
  90.     Dim lngD As Long
  91.     Dim lngE As Long
  92.     Dim lngA As Long
  93.     Dim lngB As Long
  94.     Dim lngN As Long
  95.     Dim lngJ As Long
  96.     Dim lngK As Long
  97.     Dim strB As String
  98.     lngA = Len(mStrText)
  99.     lngB = lngA - 1 - (lngA - 1) \ 4
  100.     strB = Space(lngB)
  101.     For lngN = 1 To lngB
  102.         lngJ = lngJ + 1
  103.         lngC = Asc(Mid(mStrText, lngJ, 1)) - 59
  104.         Select Case lngN Mod 3
  105.         Case 1
  106.             lngK = lngK + 4
  107.             If lngK > lngA Then lngK = lngA
  108.             lngE = Asc(Mid(mStrText, lngK, 1)) - 59
  109.             lngD = ((lngE \ 16) And 3) * 64
  110.         Case 2
  111.             lngD = ((lngE \ 4) And 3) * 64
  112.         Case 0
  113.             lngD = (lngE And 3) * 64
  114.             lngJ = lngJ + 1
  115.         End Select
  116.         Mid(strB, lngN, 1) = Chr(lngC Or lngD)
  117.     Next lngN
  118.     mStrText = strB
  119. End Sub
  120.  
  121. 'Initializes random numbers using the key string
  122. Private Sub Initialize()
  123.     Dim lngN As Long
  124.     Randomize Rnd(-1)
  125.     For lngN = 1 To Len(mStrKey)
  126.         Randomize Rnd(-Rnd * Asc(Mid(mStrKey, lngN, 1)))
  127.     Next lngN
  128. End Sub
  129.