Юнит для детекта виртуальных машин: Code: unit AntiUnit; // Information ~ // This unit is officially made by SaTaX // You can contact me at [email protected] // August 2009 - > Thanks for some Opensc.ws Snippets (like the Assembler codes ^^. // Please leave credits here if you use this unit. // Thank You. // Credits: SaTaX ~ Opensc.Ws ! interface Uses Windows,TlHelp32,SysUtils,Classes; function processExists(exeFileName: string): Boolean; function IsUsername(username: string): Boolean; function ModuleCheck(comp: string) :Boolean; function DebuggerPresent : boolean; function InVMware: Boolean; function IsInVPC: boolean; assembler; Function CheckAnti: Boolean; implementation function processExists(exeFileName: string): Boolean; var ContinueLoop: BOOL; FSnapshotHandle: THandle; FProcessEntry32: TProcessEntry32; begin FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); FProcessEntry32.dwSize := SizeOf(FProcessEntry32); ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); Result := False; while Integer(ContinueLoop) <> 0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then begin Result := True; end; ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); end; CloseHandle(FSnapshotHandle); end; function IsUsername(username: string): Boolean; var szUserName : PChar; dwUserNameSize : DWORD; begin szUserName := AllocMem(MAX_PATH); dwUserNameSize := MAX_PATH; GetUserName(szUserName,dwUserNameSize); Result := false; If szUserName = username Then begin Result := true; end; end; function ModuleCheck(comp: string) :Boolean; var i:integer; begin result:=false; for i:= 0 to 3 do begin if (GetModuleHandle(PChar(comp))<>0) then result:=true; end; end; function DebuggerPresent : boolean; type TDebugProc = function : boolean; stdcall; var Kernel32: HMODULE; DebugProc: TDebugProc; begin Result := False; Kernel32 := GetModuleHandle('kernel32'); if Kernel32<>0 then begin @DebugProc := GetProcAddress(Kernel32, 'IsDebuggerPresent'); if Assigned(DebugProc) then Result := DebugProc end; end; function InVMware: Boolean; asm XOR EAX, EAX PUSH OFFSET @@Handler PUSH DWORD PTR FS:[EAX] MOV DWORD PTR FS:[EAX], ESP MOV EAX, 564D5868h MOV EBX, 3c6cf712h MOV ECX, 0Ah MOV DX, 5658h IN EAX, DX MOV EAX, True JMP @@NotHandle @@Handler: MOV EAX, [ESP+$C] MOV TContext(EAX).EIP, OFFSET @@Handled XOR EAX, EAX RET @@Handled: XOR EAX, EAX @@NotHandle: XOR EBX, EBX POP DWORD PTR FS:[EBX] ADD ESP, 4 end; function IsInVPC: boolean; assembler; asm push ebp mov ecx, offset @@exception_handler mov ebp, esp push ebx push ecx push dword ptr fs:[0] mov dword ptr fs:[0], esp mov ebx, 0 mov eax, 1 db 00Fh, 03Fh, 007h, 00Bh mov eax, dword ptr ss:[esp] mov dword ptr fs:[0], eax add esp, 8 test ebx, ebx setz al lea esp, dword ptr ss:[ebp-4] mov ebx, dword ptr ss:[esp] mov ebp, dword ptr ss:[esp+4] add esp, 8 jmp @@ret @@exception_handler: mov ecx, [esp+0Ch] mov dword ptr [ecx+0A4h], -1 add dword ptr [ecx+0B8h], 4 xor eax, eax ret @@ret: end; Function CheckAnti: Boolean; Var Path:String; begin result:=false; Path := ExtractFilePath(ParamStr(0)); if (processexists('joeboxcontrol.exe')) //JoeBox or (processexists('joeboxserver.exe')) //Joebox 2 or (processexists('wireshark.exe')) // WireShark or (processexists('regmon.exe')) //Regmon or (processexists('filemon.exe')) //FileMon or (processexists('procmon.exe')) //ProcMon or (processexists('VBoxService.exe')) //Vbox or (modulecheck('SbieDll.dll')) //Sandboxie or (modulecheck('api_log.dll')) //SunBelt or (modulecheck('dir_watch.dll')) //Sulbelt's Sandbox or (IsUsername('username')) //ThreadExpert or (IsUsername('USER')) //Sandbox or (IsUsername('user')) //Sandbox 2 or (IsUsername('currentuser')) //Normal or (Pos('c:\insidetm',Path)<> 0) //Anubis or (DirEctoryExists('C:\analysis')) // Sunbelt 3 or (DeBuggerPresent=true) //Debuggers or (InVmWare=True) //VmWare or (IsInVPC=True) then result:=true end; end. Юзаем так: Code: If CheckAnti=true then ExitProcess(0); А вот юнит для детекта отладчиков: Code: unit AntiDbg; { very simple AntiDebug Unit for Delphi can detect most debuggers: OllyDBG,Immunity Debugger,WinDbg,W32DAsm,IDA,.... SoftICE,Syser,TRW,TWX Tested on Win9x-Me-2k-XP-2k3-Vista Coded by: Magic_h2001 [email protected] http://magic.shabgard.org just for fun ;) } interface uses Windows,SysUtils,TlHelp32; function IsDBG:Boolean; implementation var Found:Boolean=False; hSnapmod: THANDLE; ModInfo: MODULEENTRY32; hSnap: THANDLE; ProcessInfo: PROCESSENTRY32; ProcID:DWORD; Tm1,Tm2:Int64; function IsDebuggerPresent():BOOL; stdcall;external 'kernel32.dll' name 'IsDebuggerPresent'; function GetSys:string; var Gsys : array[0..MAX_PATH] of Char; begin GetSystemDirectory(Gsys,MAX_PATH); Result:=Gsys; if length(Result)>0 then if Result[length(Result)]<>'\' then Result:=Result+'\'; end; function UpCaseStr(S:string):String; var i:integer; begin Result:=s; if s='' then exit; for i:=1 to length(s) do Result[i]:=upcase(Result[i]); end; function RDTSC: Int64; assembler; asm DB 0fh ,031h end; function IsRing0DBG(S:string): boolean; var hFile: Thandle; begin Result := False; hFile := CreateFileA(Pchar(S), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0); if( hFile <> INVALID_HANDLE_VALUE ) then begin CloseHandle(hFile); Result := TRUE; end; end; function IsDBG:Boolean; var i: Integer; begin Tm1:=RDTSC; for i:=0 to 255 do OutputDebugStringA('kernel32.dll'); Tm2:=RDTSC-Tm1; if Tm2<9999 then Found:=True; if Tm2>299999999 then Found:=True; hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); ProcessInfo.dwSize:=sizeof(PROCESSENTRY32); Process32First(hSnap,ProcessInfo); repeat if Pos('OLLYDBG',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True; if Pos('DBG',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True; if Pos('DEBUG',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True; if Pos('IDAG',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True; if Pos('W32DSM',UpCaseStr(ProcessInfo.szExeFile))<>0 then Found:=True; ProcID:=ProcessInfo.th32ProcessID; hSnapMod:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcID); ModInfo.dwSize:=sizeof(MODULEENTRY32); Module32First(hSnapMod,ModInfo); repeat if Pos('DBGHELP',UpCaseStr(ModInfo.szExePath))<>0 then Found:=True; if Pos('OLLYDBG',UpCaseStr(ModInfo.szExePath))<>0 then Found:=True; if Pos('W32DSM',UpCaseStr(ModInfo.szExePath))<>0 then Found:=True; until (not Module32Next(hSnapMod,ModInfo)); CloseHandle(hSnapMod); until (not Process32Next(hSnap,ProcessInfo)); CloseHandle(hSnap); if FileExists(GetSys+'drivers\sice.sys') then Found:=True; if FileExists(GetSys+'drivers\ntice.sys') then Found:=True; if FileExists(GetSys+'drivers\syser.sys') then Found:=True; if FileExists(GetSys+'drivers\winice.sys') then Found:=True; if FileExists(GetSys+'drivers\sice.vxd') then Found:=True; if FileExists(GetSys+'drivers\winice.vxd') then Found:=True; if FileExists(GetSys+'winice.vxd') then Found:=True; if FileExists(GetSys+'vmm32\winice.vxd') then Found:=True; if FileExists(GetSys+'sice.vxd') then Found:=True; if FileExists(GetSys+'vmm32\sice.vxd') then Found:=True; if IsDebuggerPresent then Found:=True; if IsRing0DBG('\\.\SICE') then Found:=True; if IsRing0DBG('\\.\SIWVID') then Found:=True; if IsRing0DBG('\\.\NTICE') then Found:=True; if IsRing0DBG('\\.\TRW') then Found:=True; if IsRing0DBG('\\.\TWX') then Found:=True; if IsRing0DBG('\\.\ICEEXT') then Found:=True; Result:=Found; end; end. Юзаем так: Code: if IsDBG then ExitProcess(0) В принципе вместо ExitProcess можно написать и другие функции, я лишь привел пример.