home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD5634592000.psc / modEncrypt.bas < prev    next >
Encoding:
BASIC Source File  |  2000-02-24  |  1.7 KB  |  59 lines

  1. Attribute VB_Name = "modEncrypt"
  2.  
  3. ' THIS WILL NEED TO BE MORE SECURE EVENTUALLY!
  4. '**********************************************************************************
  5. '  Encrypt by Igguk
  6. '
  7. '  Allows you to encrypt/decrypt strings containing any ASCII values from 0 to 255
  8. '  limited to a string length of 39 chars.
  9. '
  10. '  v1.0 created and completed by Igguk : 31 Jan 2000
  11. '**********************************************************************************
  12. Option Explicit
  13.  
  14. Public Function Encrypt(sText As String) As String
  15. ' Encryption of a string
  16. ' Parameters :
  17. '           sText : string to encrypt
  18. ' Return value :
  19. '           The encrypted string
  20.  
  21. Dim i As Integer
  22. Dim sChar As String
  23.  
  24.     Encrypt = ""
  25.     For i = 1 To Len(sText)
  26.         sChar = Mid(sText, i, 1)
  27.         sChar = Format(Asc(sChar) * i, "0000")
  28.         sChar = 9 - Mid(sChar, 4, 1) & 9 - Mid(sChar, 3, 1) & 9 - Mid(sChar, 2, 1) & 9 - Mid(sChar, 1, 1)
  29.         Encrypt = Encrypt & Chr(Mid(sChar, 3, 2)) & Chr(Mid(sChar, 1, 2))
  30.     Next
  31.     
  32. End Function
  33.  
  34. Public Function Decrypt(sText As String) As String
  35. ' Decryption of a string
  36. ' Parameters :
  37. '           sText : string to decrypt
  38. ' Return value :
  39. '           The decrypted string
  40.  
  41. Dim i As Integer
  42. Dim sChar As String
  43.  
  44.     Decrypt = ""
  45.     For i = 1 To Len(sText) Step 2
  46.         sChar = Mid(sText, i, 2)
  47.         sChar = Format(Asc(Mid(sChar, 2, 1)), "00") & Format(Asc(Mid(sChar, 1, 1)), "00")
  48.         sChar = 9 - Mid(sChar, 4, 1) & 9 - Mid(sChar, 3, 1) & 9 - Mid(sChar, 2, 1) & 9 - Mid(sChar, 1, 1)
  49.         If sChar / (1 + Int(i / 2)) < 256 Then
  50.             sChar = Chr(sChar / (1 + Int(i / 2)))
  51.         Else
  52.             sChar = ""
  53.         End If
  54.         Decrypt = Decrypt & sChar
  55.     Next
  56.     
  57. End Function
  58.  
  59.