Antis

Iniciado por ANTRAX, Abril 04, 2012, 11:33:14 AM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

Abril 04, 2012, 11:33:14 AM Ultima modificación: Abril 21, 2013, 01:00:43 PM por Expermicid
Les dejo un code de Fakedo0r:

Código: delphi
//******************************************************************************
//Unit        : ANTIS
//Autor       : Fakedo0r .:[PD-TEAM]:.
//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 = ('VMWARE','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 IsVirtualPCPresent = True then
    ExitProcess(0);
end;

end.


Saludos!