Un algoritmo de encriptación

Esto es un algoritmo de encriptación que hice hace algún tiempo.
Como podreis comprobar, no hay algoritmo para desencriptar, la
razón de esto es que el algoritmo es exactamente el mismo tanto
para encriptar como para desencriptar. Soporta clave y el 'output'
es en formato Unicode.

Funciona por bytes, pero se puede adaptar facilmente a cadenas
y es bastante rápido. El código es Visual Basic 6.

' -----------------------------------
' Inicio de código
' -----------------------------------

Public Sub algoritmo(ByteArray() As Byte, Optional key As String)

Dim offset As Long
Dim bytelen As Long
Dim Handler As String

' la variable handler empieza
' siempre siendo cero

Handler = 0

' Si no se ha definido una clave
' la definimos como "password"

If key = "" Then key = "password"

' Bytearray y longitud

bytelen = UBound(ByteArray) + 1

' Comienzo del propio algoritmo

For offset = 0 To (bytelen - 1)

' Creamos el handler

If Handler <= 10 Then Handler = Handler + offset
If Handler > 10 And Handler <= 25 Then Handler = Handler + 1
If Handler > 25 Then Handler = Right(Handler, 1) + Right(offset, 1)

' Hacemos XOR según clave y handler

ByteArray(offset) = ByteArray(offset) Xor Int(Handler Mod Len(key) + Asc(key))

Next

End Sub

' Aplicamos el algoritmo a archivos

Public Sub doFile(SourceFile As String, DestFile As String, Optional key As String)

Dim Filenr As Integer
Dim ByteArray() As Byte

' leemos el archivo origen

Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr

' encriptamos

Call algoritmo(ByteArray(), key)

' escribimos el archivo destino

Filenr = FreeFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr

End Sub

' -----------------------------------
' Fin de código
' -----------------------------------