home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / ProjectX1_562922192002.psc / ModulesCode / modCodeX7.bas < prev    next >
Encoding:
BASIC Source File  |  1997-02-19  |  2.3 KB  |  79 lines
  1. Attribute VB_Name = "modCodeX7"
  2. '-----------------------------------
  3. '-    Encode/Decode
  4. '-
  5. '- It will encode/decode a text
  6. '-  Warning: Don't put encoded text in textbox
  7. '-     The text will be corrupted
  8. '-   Put it in a string like Dim EncT as string
  9. '-
  10. '-     By T-Virus Creations
  11. '- http://www.tvirusonline.be
  12. '- email: tvirus4ever@yahoo.co.uk
  13. '-
  14. '-----------------------------------
  15. Public Function TvEncode(Data As String, Password As String) As String
  16. Dim X As String
  17. Dim Y As String
  18. Dim t As String
  19. Dim p As Long
  20. Dim i As Long
  21. Dim q As Long
  22. If CheckTextOnly(Password) = False Then Exit Function
  23. q = 1
  24. For i = 1 To Len(Data)
  25. X = Mid$(Data, i, 1)
  26. Y = ChrW(AscW(X) + AscW(Mid$(Password, q, 1)))
  27. t = t + Y
  28. q = q + 1
  29. If q - 1 = Len(Password) Then
  30. q = 1
  31. End If
  32. Next
  33. TvEncode = t
  34. End Function
  35.  
  36. Public Function TvDecode(Data As String, Password As String) As String
  37. Dim X As String
  38. Dim Y As String
  39. Dim t As String
  40. Dim p As Long
  41. Dim i As Long
  42. Dim q As Long
  43. If CheckTextOnly(Password) = False Then Exit Function
  44. q = 1
  45. For i = 1 To Len(Data)
  46. X = Mid$(Data, i, 1)
  47. Y = ChrW(AscW(X) - AscW(Mid$(Password, q, 1)))
  48. t = t + Y
  49. q = q + 1
  50. If q - 1 = Len(Password) Then
  51. q = 1
  52. End If
  53.  
  54. Next
  55. TvDecode = t
  56. End Function
  57.  
  58.  
  59. Function CheckTextOnly(Data As String) As Boolean
  60. Dim X As String
  61. Dim i As Long
  62. CheckTextOnly = True
  63. Dim t(0 To 9) As String
  64.  
  65. t(0) = Replace(Data, "0", "", 1, Len(Data), vbBinaryCompare)
  66. t(1) = Replace(Data, "1", "", 1, Len(Data), vbBinaryCompare)
  67. t(2) = Replace(Data, "2", "", 1, Len(Data), vbBinaryCompare)
  68. t(3) = Replace(Data, "3", "", 1, Len(Data), vbBinaryCompare)
  69. t(4) = Replace(Data, "4", "", 1, Len(Data), vbBinaryCompare)
  70. t(5) = Replace(Data, "5", "", 1, Len(Data), vbBinaryCompare)
  71. t(6) = Replace(Data, "6", "", 1, Len(Data), vbBinaryCompare)
  72. t(7) = Replace(Data, "7", "", 1, Len(Data), vbBinaryCompare)
  73. t(8) = Replace(Data, "8", "", 1, Len(Data), vbBinaryCompare)
  74. t(9) = Replace(Data, "9", "", 1, Len(Data), vbBinaryCompare)
  75. If Len(t(0)) <> Len(Data) Or Len(t(1)) <> Len(Data) Or Len(t(2)) <> Len(Data) Or Len(t(3)) <> Len(Data) Or Len(t(4)) <> Len(Data) Or Len(t(5)) <> Len(Data) Or Len(t(6)) <> Len(Data) Or Len(t(7)) <> Len(Data) Or Len(t(8)) <> Len(Data) Or Len(t(9)) <> Len(Data) Then
  76. CheckTextOnly = False
  77. End If
  78. End Function
  79.