[VB6] Encriptação de strings - RC4 e XOR

[Armadillo]

Como tive a necessidade de criar encriptação para a transferência de dados pela internet, através de uma aplicação em VB6, tive que implementar um algoritmo de encriptação. Dito isto, aqui estão os algoritmos RC4 e XOR, para VB6.

Ingredientes para o form:
2 OptionButton com os nomes "OptionRC4" e "OptionXOR"
2 botões com os nomes "Command1" e "Command2"
3 textoboxes com os nomes "TextKey", "TextIn" e "TextOut"

Agora vem o código do form

Option Explicit



Private Sub Command1_Click()
'encriptar
    If Me.OptionRC4 Then
        Me.TextOut = EncriptRC4(Me.TextIn, Me.TextKey)
    ElseIf Me.OptionXOR Then
        Me.TextOut = EncriptarXOR(Me.TextKey, Me.TextIn)
    End If
End Sub

Private Sub Command2_Click()
'Desemcriptar
    If Me.OptionRC4 Then
        Me.TextOut = DesencriptRC4(Me.TextIn, Me.TextKey)
    ElseIf Me.OptionXOR Then
        Me.TextOut = EncriptarXOR(Me.TextKey, Me.TextIn)
    End If

End Sub

Este ficheiro encripta e desincripta uma string com um algoritmo RC4.
Modulo com o nome RC4.bas.

Option Explicit


Dim S(0 To 255) As Integer
Dim K(0 To 255) As Integer
Dim i As Integer
Dim j As Integer
Dim T As Integer
Dim Buffer As Integer

Function EncriptRC4(Text As String, Chave As String) As String
Dim Seccao As Double
Dim SeccaoTexto As Integer
    Definir_SBox Chave
    EncriptRC4 = vbNullString
    i = 0
    j = 0
    
    For Seccao = 1 To Len(Text)
        SeccaoTexto = Asc(Mid(Text, Seccao, 1))
        i = (i + 1) Mod 256
        j = (j + S(i)) Mod 256
        Buffer = S(i)
        S(i) = S(j)
        S(j) = Buffer
        T = (S(i) + S(j)) Mod 256
        If Len(Hex(SeccaoTexto Xor S(T))) = 1 Then
            EncriptRC4 = EncriptRC4 & "0"
        End If
        EncriptRC4 = EncriptRC4 & Hex(SeccaoTexto Xor S(T))
    Next
End Function

Function DesencriptRC4(Text As String, Chave As String) As String
Dim Seccao As Double
Dim SeccaoTexto As Integer
    Definir_SBox Chave
    DesencriptRC4 = vbNullString
    i = 0
    j = 0
    For Seccao = 1 To Len(Text) Step 2
        SeccaoTexto = "&H" & (Mid(Text, Seccao, 2))
        i = (i + 1) Mod 256
        j = (j + S(i)) Mod 256
        Buffer = S(i)
        S(i) = S(j)
        S(j) = Buffer
        T = (S(i) + S(j)) Mod 256
        DesencriptRC4 = DesencriptRC4 & Chr(SeccaoTexto Xor S(T))
    Next
End Function

Private Function Definir_SBox(ByVal Chave As String)
    For i = 0 To 255
        S(i) = i
    Next
    For i = 0 To 255
        K(i) = Val("&H" & Mid(Chave, ((i * 2) Mod Len(Chave)) + 1, 1) & Mid(Chave, (((i * 2) + 1) Mod Len(Chave)) + 1, 1)) 
    Next
    j = 0
    For i = 0 To 255
        j = (j + S(i) + K(i)) Mod 256
        Buffer = S(i)
        S(i) = S(j)
        S(j) = Buffer
    Next
End Function

Este ficheiro encripta uma string com um algoritmo XOR.
Modulo com o nome XOR.bas.

Option Explicit

Public Function EncriptarXOR(Chave As String, DadosAEncript As String) As String
    Dim i As Long
    Dim DadosEncriptados As String
    Dim intXOrValor1 As Integer, intXOrValor2 As Integer

    For i = 1 To Len(DadosAEncript)

        intXOrValor1 = Asc(Mid$(DadosAEncript, i, 1))                   
        intXOrValor2 = Asc(Mid$(Chave, ((i Mod Len(Chave)) + 1), 1))    
        DadosEncriptados = DadosEncriptados + Chr(intXOrValor1 Xor intXOrValor2)
    
    Next i
    EncriptarXOR = DadosEncriptados
End Function

Nao tem validações, por isso, se puserem dados que não correspondem aos esperado, isto vai crashar
Gravem tudo e puff! Já 'tá!


Cumprimentos

Usem este código por vossa conta e risco.
Não me responsabilizo por qualquer problema que possa advir da utilização deste código