Function Crypt(ByVal t$, ByVal Key$, ByVal Mode As Boolean) As String
 
  '(C) 2001 by Markus Rauch
 
  ' MR 01.09.2001 23:59
 
  'Verschlüsseln = True bzw. Entschlüsseln = False
 
  Dim i As Long
  Dim kp As Integer 'Key Position Integer sollte reichen
  Dim x$
  Dim xx As Byte 'bischen besser
  Dim c1 As Byte
  Dim c2 As Byte
 
  Crypt = ""
 
  If Len(t) = 0 Then Exit Function
  If Len(Key$) = 0 Then Key$ = Chr$(255) 'ohne Key$
 
  kp = 0 'Key Position
   
 If Mode = True Then
 
  'Verschlüsseln

  For i = 1 To Len(t)
   
   c1 = c1 + 1
   If c1 = 2 Then c1 = 0: c2 = c2 + 1
   If c2 = 4 Then c2 = 0
   xx = c1 + c2
   
   kp = kp + 1
   If kp > Len(Key$) Then kp = 1 'Key wieder von Anfang
     
   x$ = Hex$(xx Xor Asc(Mid$(t, i, 1)) Xor Asc(Mid(Key$, kp, 1)))
   If Len(x$) < 2 Then x$ = "0" & x$
   
   Crypt = Crypt & x$
  Next i
     
 Else

  'Entschlüsseln
   
  For i = 1 To Len(t) Step 2 'Step 2 weil ja als HEX gespeichert wurde
   
   c1 = c1 + 1
   If c1 = 2 Then c1 = 0: c2 = c2 + 1
   If c2 = 4 Then c2 = 0
   xx = c1 + c2
   
   kp = kp + 1
   If kp > Len(Key$) Then kp = 1 'Key wieder von Anfang
             
   Crypt = Crypt & Chr$(xx Xor Val("&H" & Mid$(t, i, 2)) Xor Asc(Mid(Key$, kp, 1)))
  Next i
     
 End If
 
End Function

Public Function EncryptS(t As String) As String
 
 ' MR 31.08.2001
 
 EncryptS = ""
 
 If Len(t) = 0 Then Exit Function
 
 Dim i As Long
 Dim x As String
 Dim a As Byte
 
 For i = 1 To Len(t)
  x = Mid$(t, i, 1)
  a = Asc(x)
  a = a Xor 255
  x = Chr$(a)
  Mid$(t, i, 1) = x
 Next
 
 EncryptS = t
 
End Function

Public Function DecryptS(t As String) As String
 
 ' MR 31.08.2001
 
 DecryptS = ""

 If Len(t) = 0 Then Exit Function

 Dim i As Long
 Dim x As String
 Dim a As Byte
 
 For i = 1 To Len(t)
  x = Mid$(t, i, 1)
  a = Asc(x)
  a = a Xor 255
  x = Chr$(a)
  Mid$(t, i, 1) = x
 Next
 
 DecryptS = t

End Function