1. Este site usa cookies. Ao continuar a usar este site está a concordar com o nosso uso de cookies. Saber Mais.

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

Discussão em 'Programação' iniciada por Armadillo, 22 de Maio de 2008. (Respostas: 0; Visualizações: 3072)

Estado do Tópico:
Fechado a novas mensagens.
  1. Armadillo

    Armadillo Folding Member

    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
    Código:
    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.
    Código:
    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.
    Código:
    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:007:
    Gravem tudo e puff! Já 'tá! :D


    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
     
Estado do Tópico:
Fechado a novas mensagens.

Partilhar esta Página