This function will encrypt/decrypt a string up to 30 characters. It will only encrypt uppercase letters A-Z, numbers 0-9 and the following symbols: [ ] * space ' #. The minimum length of the string must be 8 characters. It's very redundant code but it does its intended function and it's easy to understand what is going on in the code. This code could be built on by adding lowercase letters a-z and other symbols.

Also, after encrypting the text, it will scramble the first 4 characters & the last 4 characters.

vb Code:
  1. Public Function subEncrypt(textToEncrypt As String)

  2.  
  3. 'sub to encrypt letters

  4.  
  5. Dim a(1 To 30) As String, encryptedText As String, scrambledText As String

  6. Dim textLength As Integer, x As Integer, y As Integer

  7. Dim tmp1 As String, tmp2 As String, tmp3 As String, tmp4 As String, tmp5 As String, tmp6 As String, tmp7 As String, tmp8 As String

  8.  
  9. 'assign textlength length of texttoencrypt

  10. textLength = Len(textToEncrypt)

  11.  
  12. 'for/next to go through each letter in texttoencrypt

  13. For x = 1 To textLength

  14.     a(x) = Mid(textToEncrypt, x, 1)

  15.  
  16.     Select Case a(x)

  17.         Case Is = "A"

  18.             a(x) = "-"

  19.         Case Is = "B"

  20.             a(x) = ")"

  21.         Case Is = "C"

  22.             a(x) = "?"

  23.         Case Is = "D"

  24.             a(x) = "#"

  25.         Case Is = "E"

  26.             a(x) = "<"

  27.         Case Is = "F"

  28.             a(x) = "6"

  29.         Case Is = "G"

  30.             a(x) = "b"

  31.         Case Is = "H"

  32.             a(x) = "Z"

  33.         Case Is = "I"

  34.             a(x) = "="

  35.         Case Is = "J"

  36.             a(x) = "8"

  37.         Case Is = "K"

  38.             a(x) = "p"

  39.         Case Is = "L"

  40.             a(x) = "a"

  41.         Case Is = "M"

  42.             a(x) = "9"

  43.         Case Is = "N"

  44.             a(x) = ">"

  45.         Case Is = "O"

  46.             a(x) = "}"

  47.         Case Is = "P"

  48.             a(x) = "2"

  49.         Case Is = "Q"

  50.             a(x) = "4"

  51.         Case Is = "R"

  52.             a(x) = "1"

  53.         Case Is = "S"

  54.             a(x) = "v"

  55.         Case Is = "T"

  56.             a(x) = "."

  57.         Case Is = "U"

  58.             a(x) = "3"

  59.         Case Is = "V"

  60.             a(x) = "l"

  61.         Case Is = "W"

  62.             a(x) = "B"

  63.         Case Is = "X"

  64.             a(x) = "\"

  65.         Case Is = "Y"

  66.             a(x) = "T"

  67.         Case Is = "Z"

  68.             a(x) = "h"

  69.         Case Is = "0"

  70.             a(x) = "e"

  71.         Case Is = "1"

  72.             a(x) = ";"

  73.         Case Is = "2"

  74.             a(x) = "k"

  75.         Case Is = "3"

  76.             a(x) = "!"

  77.         Case Is = "4"

  78.             a(x) = "$"

  79.         Case Is = "5"

  80.             a(x) = "@"

  81.         Case Is = "6"

  82.             a(x) = "/"

  83.         Case Is = "7"

  84.             a(x) = "+"

  85.         Case Is = "8"

  86.             a(x) = "G"

  87.         Case Is = "9"

  88.             a(x) = ":"

  89.         Case Is = "["

  90.             a(x) = "%"

  91.         Case Is = "]"

  92.             a(x) = "("

  93.         Case Is = "*"

  94.             a(x) = "^"

  95.         Case Is = " "

  96.             a(x) = "_"

  97.         Case Is = "'"

  98.             a(x) = "S"

  99.         Case Is = "#"

  100.             a(x) = "x"

  101.     End Select

  102.     

  103.     'put encrypted letters into encryptedtext

  104.     encryptedText = encryptedText & a(x)

  105. Next x

  106.  
  107. 'assign first 4 letters & last 4 letters

  108. tmp1 = a(1)

  109. tmp2 = a(2)

  110. tmp3 = a(3)

  111. tmp4 = a(4)

  112. tmp5 = a(textLength - 1)

  113. tmp6 = a(textLength - 2)

  114. tmp7 = a(textLength - 3)

  115. tmp8 = a(textLength)

  116.  
  117. 'scramble (switch) letters

  118. a(1) = tmp3

  119. a(2) = tmp6

  120. a(3) = tmp1

  121. a(4) = tmp8

  122. a(textLength - 1) = tmp7

  123. a(textLength - 2) = tmp2

  124. a(textLength - 3) = tmp5

  125. a(textLength) = tmp4

  126.  
  127. 'put scrambled letters back into text

  128. For y = 1 To textLength

  129.     scrambledText = scrambledText & a(y)

  130. Next y

  131.  
  132. 'make sure function returns final encrypted & scrambled text

  133. subEncrypt = scrambledText

  134.  
  135. End Function

  136.  
  137. '/////////////////////////

  138.  
  139. Public Function subDecrypt(textToDecrypt As String)

  140.  
  141. 'sub to decrypt text file

  142.  
  143. Dim a(1 To 30) As String, decryptedText As String, unscrambledText As String

  144. Dim textLength As Integer, x As Integer, y As Integer

  145. Dim tmp1 As String, tmp2 As String, tmp3 As String, tmp4 As String, tmp5 As String, tmp6 As String, tmp7 As String, tmp8 As String

  146.  
  147. 'assign textlength length of texttodecrypt

  148. textLength = Len(textToDecrypt)

  149.  
  150. 'for/next to go through each letter in texttodecrypt

  151. For x = 1 To textLength

  152.     a(x) = Mid(textToDecrypt, x, 1)

  153.  
  154. 'decrypt letters

  155.     Select Case a(x)

  156.         Case Is = "-"

  157.             a(x) = "A"

  158.         Case Is = ")"

  159.             a(x) = "B"

  160.         Case Is = "?"

  161.             a(x) = "C"

  162.         Case Is = "#"

  163.             a(x) = "D"

  164.         Case Is = "<"

  165.             a(x) = "E"

  166.         Case Is = "6"

  167.             a(x) = "F"

  168.         Case Is = "b"

  169.             a(x) = "G"

  170.         Case Is = "Z"

  171.             a(x) = "H"

  172.         Case Is = "="

  173.             a(x) = "I"

  174.         Case Is = "8"

  175.             a(x) = "J"

  176.         Case Is = "p"

  177.             a(x) = "K"

  178.         Case Is = "a"

  179.             a(x) = "L"

  180.         Case Is = "9"

  181.             a(x) = "M"

  182.         Case Is = ">"

  183.             a(x) = "N"

  184.         Case Is = "}"

  185.             a(x) = "O"

  186.         Case Is = "2"

  187.             a(x) = "P"

  188.         Case Is = "4"

  189.             a(x) = "Q"

  190.         Case Is = "1"

  191.             a(x) = "R"

  192.         Case Is = "v"

  193.             a(x) = "S"

  194.         Case Is = "."

  195.             a(x) = "T"

  196.         Case Is = "3"

  197.             a(x) = "U"

  198.         Case Is = "l"

  199.             a(x) = "V"

  200.         Case Is = "B"

  201.             a(x) = "W"

  202.         Case Is = "\"

  203.             a(x) = "X"

  204.         Case Is = "T"

  205.             a(x) = "Y"

  206.         Case Is = "h"

  207.             a(x) = "Z"

  208.         Case Is = "e"

  209.             a(x) = "0"

  210.         Case Is = ";"

  211.             a(x) = "1"

  212.         Case Is = "k"

  213.             a(x) = "2"

  214.         Case Is = "!"

  215.             a(x) = "3"

  216.         Case Is = "$"

  217.             a(x) = "4"

  218.         Case Is = "@"

  219.             a(x) = "5"

  220.         Case Is = "/"

  221.             a(x) = "6"

  222.         Case Is = "+"

  223.             a(x) = "7"

  224.         Case Is = "G"

  225.             a(x) = "8"

  226.         Case Is = ":"

  227.             a(x) = "9"

  228.         Case Is = "%"

  229.             a(x) = "["

  230.         Case Is = "("

  231.             a(x) = "]"

  232.         Case Is = "^"

  233.             a(x) = "*"

  234.         Case Is = "_"

  235.             a(x) = " "

  236.         Case Is = "S"

  237.             a(x) = "'"

  238.         Case Is = "x"

  239.             a(x) = "#"

  240.     End Select

  241.  
  242.     'put decrypted letters in decryptedtext

  243.     decryptedText = decryptedText & a(x)

  244. Next x

  245.  
  246. 'assign first 4 letters & last 4 letters

  247. tmp1 = a(1)

  248. tmp2 = a(2)

  249. tmp3 = a(3)

  250. tmp4 = a(4)

  251. tmp5 = a(textLength - 1)

  252. tmp6 = a(textLength - 2)

  253. tmp7 = a(textLength - 3)

  254. tmp8 = a(textLength)

  255.  
  256. 'scramble (switch) letters

  257. a(1) = tmp3

  258. a(2) = tmp6

  259. a(3) = tmp1

  260. a(4) = tmp8

  261. a(textLength - 1) = tmp7

  262. a(textLength - 2) = tmp2

  263. a(textLength - 3) = tmp5

  264. a(textLength) = tmp4

  265.  
  266.  
  267. 'put unscrambled letters back into text

  268. For y = 1 To textLength

  269.     unscrambledText = unscrambledText & a(y)

  270. Next y

  271.  
  272. 'make sure function returns final decrypted & unscrambled text

  273. subDecrypt = unscrambledText

  274.  
  275. End Function

To encrypt/decrypt the text, call the function and give it the text. For example:

vb Code:
  1. Call subEncrypt("I WANT TO ENCRYPT THIS")