Function CryptText(SrcString, Pass)
  On Error Resume Next
  Dim TmpInt, I, J
  Dim TmpArray()
  ReDim TmpArray(Len(Pass))
  'Ascii Codes des Passwortes in ein Array Speichern
  For I = 1 To Len(Pass)
    TmpArray(I) = Asc(Mid(Pass, I, 1))
  Next
  'Verschlüsselungs-Prozedur
  'Jeden Buchstaben einzeln verschlüsseln
  For I = 1 To Len(SrcString)
    'Für jeden Passwortbuchstaben einmal verschlüsseln
    'Buchstaben in Ascii-Wert umwandeln
    TmpInt = Asc(Mid(SrcString, I, 1)) 
    For J = 1 To Len(Pass)
      'und mit Xor binär umwandeln
      TmpInt = TmpInt Xor TmpArray(J)
      'zur Sicherheit nocheimal binär umwandeln (Xor)
      TmpInt = TmpInt Xor J
    Next
    'Das Null-Zeichen kann in einer TextBox
    'nicht angezeigt werden
    If TmpInt > 0 Then
      'Binär-Wert wieder in Ascii-Zeichen umwandeln
      VerEntschluesseln = VerEntschluesseln & Chr(TmpInt)
    Else
      'sonst Null-Zeichen-Konstante einfügen
      VerEntschluesseln = VerEntschluesseln & "%$0$%"
    End If
  Next
  Inputbox "Hier der verschlüsselte Text:","Verschlüsselter" & _
    "Text",verentschluesseln
End Function

Set ausgabe = FS.CreateTextFile("C:\crypted.txt", True, True)
  ausgabe.WriteLine CryptText("Text", "Passwort")
ausgabe.close()