API Declare:
Private Declare Function NtSetInformationThread Lib "NTDLL" (ByVal hThread As Integer, ByVal ThreadInformationClass As Integer, ByVal ThreadInformation As Integer, ByVal ThreadInformationLength As Integer) As Integer Private Declare Function NtWriteVirtualMemory Lib "NTDLL" (ByVal ProcessHandle As Long, ByVal BaseAddress As Long, ByVal pBuffer As Long, ByVal NumberOfBytesToWrite As Long, ByRef NumberOfBytesWritten As Long) As Long Private Declare Function CallWindowProcA Lib "USER32" (ByVal address As Any, Optional ByVal Param1 As Long, Optional ByVal Param2 As Long, Optional ByVal Param3 As Long, Optional ByVal Param4 As Long) As Long
Public Function DetectDebugger() As Boolean Dim pPeb As Long Dim pHeap As Long Dim pLdr As Long Dim pModule As Long Dim pBuff As Long Dim IsBeingDebugged As Boolean Dim l As Long Dim i As Long Dim lCheck As Long Dim b(6) As Byte Dim GlobalFlag As Long Dim sFile As String b(0) = &H64 'MOV b(1) = &HA1 'EAX b(2) = &H18 '[FS:0x18] b(3) = &H0 b(4) = &H0 b(5) = &H0 b(6) = &HC3 'RET Call NtSetInformationThread(-2, &H11, 0, 0) NtWriteVirtualMemory -1, VarPtr(pPeb), CallWindowProcA(VarPtr(b(0))) + &H30, 4, 0 NtWriteVirtualMemory -1, VarPtr(pLdr), pPeb + &HC&, 4, 0 NtWriteVirtualMemory -1, VarPtr(pModule), pLdr + &HC&, 4, 0 NtWriteVirtualMemory -1, VarPtr(lCheck), pModule, 4, 0 NtWriteVirtualMemory -1, VarPtr(IsBeingDebugged), pPeb + 2, 1, 0 If IsBeingDebugged Then DetectDebugger = True NtWriteVirtualMemory -1, VarPtr(pHeap), pPeb + &H20, 4, 0 NtWriteVirtualMemory -1, VarPtr(l), pHeap + &H10, 4, 0 If l <> 0 Then DetectDebugger = True NtWriteVirtualMemory -1, VarPtr(GlobalFlag), pPeb + &H68, 1, 0 If GlobalFlag <> 0 Then DetectDebugger = True Do sFile = vbNullString i = 0 NtWriteVirtualMemory -1, VarPtr(pModule), pModule + 4, 4, 0 NtWriteVirtualMemory -1, VarPtr(pBuff), pModule + 40, 4, 0 NtWriteVirtualMemory -1, VarPtr(l), pBuff, 1, 0 If l <> 0 Then Do While l <> 0 sFile = sFile & Chr$(l) i = i + 1 NtWriteVirtualMemory -1, VarPtr(l), pBuff + i * 2, 1, 0 Loop If (Right(UCase(sFile), 11) = "SBIEDLL.DLL") Or (Right(UCase(sFile), 11) = "DBGHELP.DLL") Then DetectDebugger = True End If If pModule = lCheck Then Exit Do Loop End Function