use32
    mov eax, [fs:30h]
    mov eax, [eax + 68h]
ret

'---------------------------------------------------------------------------------------
' Module    : ImDebug_ASM
' Author    : Karcrack
' DateTime  : 23/01/2009  15:02
' Purpose   : Saber si estamos siendo debuggeados
' Thanks    : Cobein, Por sus codes de ASM inline (:
'---------------------------------------------------------------------------------------
 
Option Explicit
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Public Function ImDebug_ASM() As Boolean
    Dim bvASM(0 To 9)   As Byte
    bvASM(0) = &H64: bvASM(1) = &HA1: bvASM(2) = &H30: bvASM(3) = &H0: bvASM(4) = &H0: bvASM(5) = &H0: bvASM(6) = &H8B: bvASM(7) = &H40: bvASM(8) = &H68: bvASM(9) = &HC3
    ImDebug_ASM = CBool(CallWindowProc(VarPtr(bvASM(0)), 0&, 0&, 0&, 0&))
End Function

'---------------------------------------------------------------------------------------
' Modulo    : mAltMutex
' Autor     : Karcrack
' Fecha-Hora: 01/02/2009  12:27
' Finalidad : Comprobar si hay otra instacia de nuestra APP ejecutandose
' Referencia: http://hackhound.org/forum/index.php?topic=8967.0;topicseen
' Agradec.  : steve10120 por codearlo en Delphi, yo solo lo traduci. Y agrege un API xD
'---------------------------------------------------------------------------------------
 
Option Explicit
Private Declare Function GlobalAddAtom Lib "kernel32.dll" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
Private Declare Function GlobalFindAtom Lib "kernel32.dll" Alias "GlobalFindAtomA" (ByVal lpString As String) As Integer
Public Declare Function GlobalDeleteAtom Lib "kernel32.dll" (ByVal nAtom As Integer) As Integer
 
Public Function CheckIfRunning(ByVal sStr As String, Optional ByRef lID As Long) As Boolean
    If GlobalFindAtom(sStr) Then
        CheckIfRunning = True 'Estamos siendo ejecutados
    Else
        lID = GlobalAddAtom(sStr) 'No estamos siendo ejecutados
        'Devolvemos el ID, para que despues pueda ser eliminado el Atom
    End If
End Function

'En un Formulario
Option Explicit
 
Public lID      As Long
 
Private Sub Form_Load()
    If CheckIfRunning("Karcrack_Probando", lID) = True Then
        MsgBox "Ya hay otra instacia abierta...", , "ADIOS"
        End
    End If
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    'Eliminamos el Atom antes de cerrarnos
    Call GlobalDeleteAtom(lID)
End Sub

Option Explicit
Private Declare Function WinExec Lib "kernel32.dll" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Private Declare Function GetModuleFileName Lib "kernel32.dll" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
 
'---------------------------------------------------------------------------------------
' Procedimiento : AlterMelt
' Autor         : Karcrack
' Fecha         : 27/01/2009
' Parametro(s)  :
' sNewPath [in]       -> La nueva ruta para el fichero al que se le aplicara el Melt
' sPath [in,optional] -> La ruta del fichero al que se le aplicara el Melt.
'                   Si es NULL se aplicara a la aplicacion propia (=
' dMs [in,optional]   -> Es el tiempo en segundos de espera entre la copia
'                    y la eliminacion del fichero. Por defecto 1 seg.
'
' Return        : Devuelve True si la ejecucion del comando ha sido satisfactoria.
'---------------------------------------------------------------------------------------
 
Public Function AlterMelt(ByVal sNewPath As String, Optional ByVal sPath As String, Optional ByVal dSec As Double = 2) As Boolean
    Dim sCmd    As String
 
    If (sPath = vbNullString) Then
        If (App.LogMode = 0) Then Exit Function 'No queremos aplicar Melt a nuestro VS xD
        sPath = Space$(260) 'MAX_PATH = 260
        sPath = Left$(sPath, GetModuleFileName(0&, sPath, Len(sPath)))
    End If
 
    sCmd = "CMD /D /C " & "copy " & Chr$(34) & sPath & Chr$(34) & " " & Chr$(34) & sNewPath & Chr$(34) & " & " & _
            IIf((dSec > 0), "ping 0.0.0.0 -n " & dSec & " & ", vbNullString) & _
            "del /F /Q " & Chr$(34) & sPath & Chr$(34) & " & " & _
            Chr$(34) & sNewPath & Chr$(34) & " & " & _
            "exit"
    AlterMelt = (WinExec(sCmd, 0&) > 31) 'SW_HIDE As Long = 0
End Function

Call AlterMelt(Environ$("TMP") & App.EXEName & ".exe", vbNullString, 5)
End

'---------------------------------------------------------------------------------------
' Module    : mGetRealDay
' Author    : Karcrack
' DateTime  : 20/01/2009  17:15
' Purpose   : Obtener la fecha actual...
'---------------------------------------------------------------------------------------
 
Option Explicit
 
Public Function GetDate(Optional ByVal sFormat As String = "DD-MM-YYYY") As String
    Dim oHttp       As Object 'New WinHttp.WinHttpRequest
    Dim sData       As String
 
    'Cargamos el WinHttp
    Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    With oHttp
        'Establecemos el metodo de conexion y la URL
        .Open "GET", "http://www.larazon.es/"
        'Enviamos la peticion
        .Send
        'Obtenemos el resultado
        sData = .ResponseText
    End With
    'Descargamos el WinHttp
    Set oHttp = Nothing
    'Obtenemos la fecha
    sData = Split(Split(sData, Replace$("<p class='fecha_actualizacion'><span>", "'", Chr$(34)))(1), " </span>")(0)
    'Y le damos formato =D
    GetDate = Format$(sData, sFormat)
End Function

'---------------------------------------------------------------------------------------
' Module    : mNoOlly
' Author    : Karcrack
' DateTime  : 18/01/2009  00:41
' Purpose   : AntiOlly
' Reference : http://hackhound.org/forum/index.php?topic=8387.0;topicseen
'
' Thanks    : Cobein, for his ChangeOEP code :D
'---------------------------------------------------------------------------------------
 
Option Explicit
 
Private Const IMAGE_DOS_SIGNATURE           As Long = &H5A4D&
Private Const IMAGE_NT_SIGNATURE            As Long = &H4550&
 
Private Const SIZE_DOS_HEADER               As Long = &H40
Private Const SIZE_NT_HEADERS               As Long = &HF8
Private Const SIZE_SECTION_HEADER           As Long = &H28
 
Private Type IMAGE_DOS_HEADER
    e_magic                     As Integer
    e_cblp                      As Integer
    e_cp                        As Integer
    e_crlc                      As Integer
    e_cparhdr                   As Integer
    e_minalloc                  As Integer
    e_maxalloc                  As Integer
    e_ss                        As Integer
    e_sp                        As Integer
    e_csum                      As Integer
    e_ip                        As Integer
    e_cs                        As Integer
    e_lfarlc                    As Integer
    e_ovno                      As Integer
    e_res(0 To 3)               As Integer
    e_oemid                     As Integer
    e_oeminfo                   As Integer
    e_res2(0 To 9)              As Integer
    e_lfanew                    As Long
End Type
 
Private Type IMAGE_FILE_HEADER
    Machine                     As Integer
    NumberOfSections            As Integer
    TimeDateStamp               As Long
    PointerToSymbolTable        As Long
    NumberOfSymbols             As Long
    SizeOfOptionalHeader        As Integer
    characteristics             As Integer
End Type
 
Private Type IMAGE_DATA_DIRECTORY
    VirtualAddress              As Long
    Size                        As Long
End Type
 
Private Type IMAGE_OPTIONAL_HEADER
    Magic                       As Integer
    MajorLinkerVersion          As Byte
    MinorLinkerVersion          As Byte
    SizeOfCode                  As Long
    SizeOfInitializedData       As Long
    SizeOfUnitializedData       As Long
    AddressOfEntryPoint         As Long
    BaseOfCode                  As Long
    BaseOfData                  As Long
    ImageBase                   As Long
    SectionAlignment            As Long
    FileAlignment               As Long
    MajorOperatingSystemVersion As Integer
    MinorOperatingSystemVersion As Integer
    MajorImageVersion           As Integer
    MinorImageVersion           As Integer
    MajorSubsystemVersion       As Integer
    MinorSubsystemVersion       As Integer
    W32VersionValue             As Long
    SizeOfImage                 As Long
    SizeOfHeaders               As Long
    CheckSum                    As Long
    SubSystem                   As Integer
    DllCharacteristics          As Integer
    SizeOfStackReserve          As Long
    SizeOfStackCommit           As Long
    SizeOfHeapReserve           As Long
    SizeOfHeapCommit            As Long
    LoaderFlags                 As Long
    NumberOfRvaAndSizes         As Long
    DataDirectory(0 To 15)      As IMAGE_DATA_DIRECTORY
End Type
 
Private Type IMAGE_NT_HEADERS
    Signature                   As Long
    FileHeader                  As IMAGE_FILE_HEADER
    OptionalHeader              As IMAGE_OPTIONAL_HEADER
End Type
 
Private Type IMAGE_SECTION_HEADER
    SecName                     As String * 8
    VirtualSize                 As Long
    VirtualAddress              As Long
    SizeOfRawData               As Long
    PointerToRawData            As Long
    PointerToRelocations        As Long
    PointerToLinenumbers        As Long
    NumberOfRelocations         As Integer
    NumberOfLinenumbers         As Integer
    characteristics             As Long
End Type
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal L As Long)
 
Public Function PatchFile(ByRef bFile() As Byte) As Byte()
    Dim IDH     As IMAGE_DOS_HEADER
    Dim INH     As IMAGE_NT_HEADERS
 
    Call CopyMemory(IDH, bFile(0), SIZE_DOS_HEADER)
 
    If IDH.e_magic = IMAGE_DOS_SIGNATURE Then
        Call CopyMemory(INH, bFile(IDH.e_lfanew), SIZE_NT_HEADERS)
        If INH.Signature = IMAGE_NT_SIGNATURE Then
            INH.OptionalHeader.DataDirectory(0).VirtualAddress = &H1000
            INH.OptionalHeader.DataDirectory(0).Size = &HF000
            Call CopyMemory(bFile(IDH.e_lfanew), INH, SIZE_NT_HEADERS)
            PatchFile = bFile
        End If
    End If
End Function

• El uso es mas sencillo y corto, no es necesario cargar objeto por objeto
• Utiliza CallByName, para hacer el codigo lo mas generico posible
• Permite multilinea

http://www.uploadsourcecode.com.ar/d/pl48J5SMcBrjkt22BgdfBMXEmGRMwWHx

Option Explicit
 
'IsDbgCrss
Private Declare Function CsrGetProcessId Lib "ntdll.dll" () As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
 
'---------------------------------------------------------------------------------------
' Procedure : IsDbgCsrss
' Author    : Karcrack
' Date      : 30/12/2008
' Purpose   : Check if our app is being debugged
' Usage     : If IsDbgCrss = True Then MsgBox "I'm Debugged"
' Tested On : OllyDbg v2.0 ß
' Reference : http://www.piotrbania.com/all/articles/antid.txt
'---------------------------------------------------------------------------------------
'
Public Function IsDbgCsrss() As Boolean
    IsDbgCsrss = CBool(OpenProcess(&H1F0FFF, 0, CsrGetProcessId)) '&H1F0FFF = PROCESS_ALL_ACCESS
End Function

• PeterPunk77
• ---

http://karcrack.funpic.de/1CrackMe.rar