Indetectables

Código: Seleccionar todo

Private Sub cmdBuscar_Click()
With CD
        .DialogTitle = "Seleccione el archivo a encriptar!!"
        .Filter = "Aplicaciones EXE|*.exe*"
        .ShowOpen
        End With
        
        If Not CD.FileName = vbNullString Then
        txtarchivo.Text = CD.FileName
        MsgBox "Archivo cargado correctamente!", vbInformation, Me.Caption
        End If
        
End Sub

Private Sub cmdProteger_Click()
Dim Stub As String, Archivo As String

If txtarchivo.Text = vbNullString Then
MsgBox "Primero debe cargar un archivo para encriptar!", vbExclamation, Me.Caption
Exit Sub
Else

Open App.Path & "\Stub.exe" For Binary As #1
Stub = Space(LOF(1))
Get #1, , Stub
Close #1


With CD
        .DialogTitle = "Seleccione la ruta donde guardar el archivo encriptado!"
        .Filter = "Aplicaciones EXE|*.exe"
        .ShowSave
        End With
        
        If Not CD.FileName = vbNullString Then
        
        'Encriptacion RC4!!!!
        Archivo = RC4(Archivo, "pasku")
        
        Open CD.FileName For Binary As #1
        Put #1, , Stub & "##$$##" & Archivo & "##$$##"
        Close #1
        
        MsgBox "Archivo Encriptado Correctamente!!", vbInformation, Me.Caption
        End If
        'Programa terminado amo a por el stub.
        
End If
End Sub

Public Function RC4(ByVal Data As String, ByVal Password As String) As String
On Error Resume Next
Dim F(0 To 255) As Integer, X, Y As Long, Key() As Byte
Key() = StrConv(Password, vbFromUnicode)
For X = 0 To 255
    Y = (Y + F(X) + Key(X Mod Len(Password))) Mod 256
    F(X) = X
Next X
Key() = StrConv(Data, vbFromUnicode)
For X = 0 To Len(Data)
    Y = (Y + F(Y) + 1) Mod 256
    Key(X) = Key(X) Xor F(Temp + F((Y + F(Y)) Mod 254))
Next X
RC4 = StrConv(Key, vbUnicode)
End Function

Código: Seleccionar todo

Open txtarchivo.Text For Binary As #1
Archivo = Space(LOF(1))
Get #1, , Archivo
Close #1