home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rdblib / crypt.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  1.5 KB  |  43 lines
  1.  
  2. Function crypt (Action As String, Key As String, Src As String) As String
  3. Dim Count As Integer, KeyPos As Integer, KeyLen As Integer, SrcAsc As Integer, Dest As String, Offset As Integer, TmpSrcAsc
  4. KeyLen = Len(Key)
  5.  
  6. If Action = "E" Then
  7.     Randomize
  8.     Offset = (Rnd * 10000 Mod 255) + 1
  9.     Dest = Hex$(Offset)
  10.  
  11.     For SrcPos = 1 To Len(Src)
  12.         SrcAsc = (Asc(Mid$(Src, SrcPos, 1)) + Offset) Mod 255
  13.         If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
  14.         'Fill Dest$ with HEX representation of Encrypted field
  15.         'Hex used to keep nasties such as eof or lf from mangling stream
  16.         'Use format$ to make Hex$ return " 0" instead of "0" when the same
  17.         'values are Xor'ed together (Null) - keeps placeholder for decrypt
  18.         SrcAsc = SrcAsc Xor Asc(Mid$(Key, KeyPos, 1))
  19.         Dest = Dest + Format$(Hex$(SrcAsc), "@@")
  20.         Offset = SrcAsc
  21.  
  22.     Next
  23.  
  24. ElseIf Action = "D" Then
  25.     Offset = Val("&H" + Left$(Src, 2))
  26.     For SrcPos = 3 To Len(Src) Step 2
  27.         SrcAsc = Val("&H" + Trim(Mid$(Src, SrcPos, 2)))
  28.         If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
  29.         TmpSrcAsc = SrcAsc Xor Asc(Mid$(Key, KeyPos, 1))
  30.         If TmpSrcAsc <= Offset Then
  31.             TmpSrcAsc = 255 + TmpSrcAsc - Offset
  32.         Else
  33.             TmpSrcAsc = TmpSrcAsc - Offset
  34.         End If
  35.         Dest = Dest + Chr(TmpSrcAsc)
  36.         Offset = SrcAsc
  37.     Next
  38.  
  39. End If
  40. crypt = Dest
  41. End Function
  42.  
  43.