Dica [SRC] Anti maquinas virtuais

[luiz9]

//Unit : ANTIS.
//Fecha : 04.04.2012
//Creditos : Cobein
//Descripcion : Detecta [VirtualPC / VMWare / VirtualBox]
// Detecta [Sandboxie / ThreatExpert / Anubis / CWSandbox / JoeBox]
//Uso : Anti_End;
//************************************************** ****************************
unit ANTIS;
//************************************************** ****************************
//DECLARACION DE CLASES
//************************************************** ****************************
interface
uses
Windows, ShlObj, Messages, SysUtils;
//************************************************** ****************************
//DECLARACION DE FUNCIONES / PROCEDIMIENTOS
//************************************************** ****************************
function InStr(iStart: Integer; sSource: String; sSourceToFind: String): Integer;
function TrimA(sCadena: String): String;
function IsVirtualPCPresent: Bool;
function IsInSandbox: Bool;
function Anti_End: Bool;
//************************************************** ****************************
//FUNCIONES / PROCEDIMIENTOS
//************************************************** ****************************
implementation
//************************************************** ****************************
//<--- MAQUINAS VIRTUALES [VirtualPC / VMWare / VirtualBox] --->
//************************************************** ****************************
function IsVirtualPCPresent: Bool;
const
sArrVM :array[0..2] of string = ('VIRTUAL','VMWARE','VBOX');
var
hlKey :HKEY;
sBuffer :String;
i :Integer;
iRegType :Integer;
iDataSize :Integer;
begin
IsVirtualPCPresent := False;
iRegType := 1;

if RegOpenKeyEx($80000002, Pchar('SYSTEM\ControlSet001\Services\Disk\Enum'), 0, $20019, hlKey) = 0 then
if RegQueryValueEx(hlKey, '0', 0, @iRegType, nil, @iDataSize) = 0 then
SetLength(sBuffer, iDataSize);
RegQueryValueEx(hlKey, '0', 0, @iRegType, PByte(PChar(sBuffer)), @iDataSize);

for I := 0 to 2 do
if InStr(1, TrimA(sBuffer), sArrVM[i]) > 0 then
IsVirtualPCPresent := True;


RegCloseKey(hlKey);
end;
//************************************************** ****************************
//<--- SANDBOX [Sandboxie / ThreatExpert / Anubis / CWSandbox / JoeBox] --->
//************************************************** ****************************
function IsInSandbox: Bool;
const
sArrSB :array[0..2] of string = ('76487-337-8429955-22614',
'76487-644-3177037-23510',
'55274-640-2673064-23950');
sArrDll :array[0..1] of string = ('sbiedll.dll', 'dbghelp.dll');
var
hlKey :HKEY;
sBuffer :String;
i :Integer;
hDll :Integer;
iRegType :Integer;
iDataSize :Integer;
hSnapShot :Integer;
begin
IsInSandbox := False;
iRegType := 1;

hDll := LoadLibrary(PChar(sArrDll[0]));

if hDll <> 0 then
IsInSandbox := True;

FreeLibrary(hDll);

hDll := LoadLibrary(PChar(sArrDll[1]));

if hDll <> 0 then
IsInSandbox := True;

FreeLibrary(hDll);

if RegOpenKeyEx($80000002, Pchar('Software\Microsoft\Windows\CurrentVersion') , 0, $20019, hlKey) = 0 then
if RegQueryValueEx(hlKey, 'ProductId', 0, @iRegType, nil, @iDataSize) = 0 then
SetLength(sBuffer, iDataSize);
RegQueryValueEx(hlKey, 'ProductId', 0, @iRegType, PByte(PChar(sBuffer)), @iDataSize);

for I := 0 to 2 do
if InStr(1, TrimA(sBuffer), sArrSB[i]) > 0 then
IsInSandbox := True;

RegCloseKey(hlKey);
end;
//************************************************** ****************************
//<--- BUSCA CADENA DENTRO DE OTRA CADENA --->
//************************************************** ****************************
function InStr(iStart: Integer; sSource: String; sSourceToFind: String): integer;
begin
Result := Pos(sSourceToFind, Copy(sSource, iStart, Length(sSource) - (iStart - 1)));
end;
//************************************************** ****************************
//<--- ELIMINA LOS ESPACIOS DE UNA CADENA --->
//************************************************** ****************************
function TrimA(sCadena: String): String;
begin
Result := '';

if sCadena = '' then Exit;

while sCadena[1] = ' ' do
begin
Delete(sCadena, 1, 1);
if sCadena='' then Exit;
end;

while sCadena[Length(sCadena)] = ' ' do
begin
Delete(sCadena,Length(sCadena),1);
if sCadena = '' then Exit;
end;

Result := sCadena;
end;
//************************************************** ****************************
//<--- CIERRA EL EJECUTABLE EN CASO DE TRUE --->
//************************************************** ****************************
function Anti_End: Bool;
begin
Anti_End := False;

if IsVirtualPCPresent = True or IsInSandbox = True then
ExitProcess(0);
end;

end.