[Cramel] Librería MemDLL

Importar "Cramel.cml"

Estruct LIB_INFO,_
        Base,_ ' Dirección base de la librería en memoria.
        NumLibs,_ ' Número de librerías que esta importa.
        Librerías[]:Entero,_ ' Identificadores de las librerias importadas.
        @NT:IMAGE_NT_HEADERS,_ ' Cabecera PE.
        Inicializado:Booleano ' Establece si fue inicializado.

Prototipo LibEntryPoint(Instancia,Razón:Entero,Opcional Reservado:Entero):Entero

Proc FIELD_OFFSET(Estructura,Miembro:Entero):Entero
    Resultado = (Miembro - Estructura)
FinProc

Proc IMAGE_FIRST_SECTION(Referencia NT:IMAGE_NT_HEADERS):Entero
    Resultado = NT@ + (FIELD_OFFSET(NT@,NT.OptionalHeader@) + NT.FileHeader.SizeOfOptionalHeader)
FinProc

Proc GET_HEADER_DICTIONARY(Mem:Entero,Indice:Byte):Entero
    Var @NT:IMAGE_NT_HEADERS
    NT@ = GET_NT_HEADERS(Mem)
    Resultado = NT.OptionalHeader.DataDirectory[Indice]@
FinProc

Proc GET_DOS_HEADER(Mem:Entero):Entero
    Resultado = Mem
FinProc

Proc GET_NT_HEADERS(Mem:Entero):Entero
    Var @DOS_HEADER:IMAGE_DOS_HEADER
    DOS_HEADER@ = GET_DOS_HEADER(Mem)
    Resultado = Mem + DOS_HEADER.e_lfanew
FinProc

Proc IMAGE_ORDINAL(Ordinal:Entero):Word
    Resultado = (Ordinal And &FFFF)
FinProc

Proc IMAGE_SNAP_BY_ORDINAL(Ordinal:Entero):Booleano
    Resultado = (Ordinal And IMAGE_ORDINAL_FLAG32)
FinProc

Proc GET_SECTION_PROTECTION(Characteristics:Entero):Entero
    Var Flag:Byte
    Si Characteristics And IMAGE_SCN_MEM_EXECUTE Entonces
        Flag = Flag + 1 ' Flag = 0 o 1
    FinSi
    Si Characteristics And IMAGE_SCN_MEM_READ Entonces
        Flag = Flag + 2 ' Flag = 1 o 2 o 3
    FinSi
    Si Characteristics And IMAGE_SCN_MEM_WRITE Entonces
        Flag = Flag + 3 ' Flag = 3 o 4 o 5 o 6
    FinSi
    Seleccionar Flag
        Caso 0 ' Nada :0
        Caso 1 ' Ejecutable
            Resultado = PAGE_EXECUTE
        Caso 2 ' Solo lectura
            Resultado = PAGE_READONLY
        Caso 3 ' Lectura y ejecutable
            Resultado = PAGE_EXECUTE_READ
        Caso 4 ' Ejecutable y editable
            Resultado = PAGE_EXECUTE_WRITECOPY
        Caso 5 ' Lectura y editable
            Resultado = PAGE_READWRITE
        Caso 6 ' Ejecutable, lectura y editable.
            Resultado = PAGE_EXECUTE_READWRITE
    FinSeleccionar
FinProc

' Copia las secciones del archivo en memoria.
Proc CopiarSecciones(Referencia Res:LIB_INFO,Referencia NT:IMAGE_NT_HEADERS,LibPtr:Entero)
    Var i:Entero
    Var @SECHeader:IMAGE_SECTION_HEADER
    Var Tamaño:Entero
    Var Des:Entero
    SECHeader@ = IMAGE_FIRST_SECTION(Res.NT)
    Contar i a (Res.NT.FileHeader.NumberOfSections - 1)
        Si SECHeader.SizeOfRawData = 0 Entonces
            Tamaño = NT.OptionalHeader.SectionAlignment
            Si Tamaño Entonces
                Des = VirtualAlloc(Res.Base + SECHeader.VirtualAddress,Tamaño,MEM_COMMIT,PAGE_READWRITE)
                SECHeader.Misc.PhysicalAddress = Des
                memset(Des,0,Tamaño)
            FinSi
        SiNo
            Des = VirtualAlloc(Res.Base + SECHeader.VirtualAddress,SECHeader.SizeOfRawData,MEM_COMMIT,PAGE_READWRITE)
            memcpy(Des,LibPtr + SECHeader.PointerToRawData,SECHeader.SizeOfRawData)
            SECHeader.Misc.PhysicalAddress = Des
        FinSi
        SECHeader@ = SECHeader@@ + &IMAGE_SECTION_HEADER
    Seguir
FinProc

' Importamos las librerias requeridas por el archivo en memoria y registramos los procedimientos.
Proc RegImportaciones(Referencia Res:LIB_INFO):Booleano
    Var @Directorio:IMAGE_DATA_DIRECTORY
    Var @ImportDesc:IMAGE_IMPORT_DESCRIPTOR
    Var ResLoad:Entero
    Var @OrFirstThunk:Entero
    Var @ProcRef:Entero
    Var @ImgImport:IMAGE_IMPORT_BY_NAME
    Directorio@ = GET_HEADER_DICTIONARY(Res.Base,IMAGE_DIRECTORY_ENTRY_IMPORT)
    Si Directorio.Size Entonces
        ImportDesc@ = Res.Base + Directorio.VirtualAddress
        Mientras ImportDesc.Name
            ResLoad = LoadLibrary(CadDePtr(Res.Base + ImportDesc.Name))
            Si ImportDesc.OriginalFirstThunk Entonces
                OrFirstThunk@ = Res.Base + ImportDesc.OriginalFirstThunk
            SiNo
                OrFirstThunk@ = Res.Base + ImportDesc.FirstThunk
            FinSi
            ProcRef@ = Res.Base + ImportDesc.FirstThunk
            Mientras OrFirstThunk
                Si IMAGE_SNAP_BY_ORDINAL(OrFirstThunk) Entonces
                    ProcRef = GetProcAddress(ResLoad,EntCad(IMAGE_ORDINAL(OrFirstThunk)))
                SiNo
                    ImgImport@ = Res.Base + OrFirstThunk
                    ProcRef = GetProcAddress(ResLoad,CadDePtr(ImgImport.Name[0]@))
                FinSi
                Si ProcRef = 0 Entonces Salir Mientras
                OrFirstThunk@ = OrFirstThunk@@ + &Entero
                ProcRef@ = ProcRef@@ + &Entero
            FinMientras
            ImportDesc@ = ImportDesc@@ + &IMAGE_IMPORT_DESCRIPTOR
            ' Almacenamos el identificador de la libreria cargada para ser liberada mas tarde.
            ReDim Preservar Res.Librerías,Res.NumLibs + 1
            Res.Librerías[Res.NumLibs] = ResLoad
            Res.NumLibs = Res.NumLibs + 1
        FinMientras
    FinSi
FinProc

' Liberamos las librerias importadas.
Proc LibImportaciones(Referencia Res:LIB_INFO):Booleano
    Var i:Entero
    Contar i a Res.NumLibs - 1
        Si Res.Librerías[i] <> INVALID_HANDLE_VALUE Entonces FreeLibrary(Res.Librerías[i])
    Seguir
FinProc

' Limpiamos de memoria las secciones y protegemos las que corresponden.
Proc LimpiarSecciones(Referencia Res:LIB_INFO)
    Var @SECHeader:IMAGE_SECTION_HEADER
    Var i:Entero
    Var Protección:Entero
    Var Tamaño:Entero
    SECHeader@ = IMAGE_FIRST_SECTION(Res.NT)
    Contar i a (Res.NT.FileHeader.NumberOfSections - 1)
        Si SECHeader.Characteristics And IMAGE_SCN_MEM_DISCARDABLE Entonces
            ' La sección es descartable, liberamos la memoria y retrocedemos a otra sección.
            VirtualFree(SECHeader.Misc.PhysicalAddress,SECHeader.SizeOfRawData,MEM_DECOMMIT)
            SECHeader@ = SECHeader@@ - &IMAGE_SECTION_HEADER
        SiNo
            Protección = GET_SECTION_PROTECTION(SECHeader.Characteristics)
            Si SECHeader.Characteristics And IMAGE_SCN_MEM_NOT_CACHED Entonces Protección = Protección + PAGE_NOCACHE
            Tamaño = SECHeader.SizeOfRawData
            Si Tamaño Entonces
                Si SECHeader.Characteristics And IMAGE_SCN_CNT_INITIALIZED_DATA Entonces
                    Tamaño = Res.NT.OptionalHeader.SizeOfInitializedData
                OSi SECHeader.Characteristics And IMAGE_SCN_CNT_UNINITIALIZED_DATA Entonces
                    Tamaño = Res.NT.OptionalHeader.SizeOfUnitializedData
                FinSi
                Si Tamaño Entonces VirtualProtect(SECHeader.Misc.PhysicalAddress,SECHeader.SizeOfRawData,Protección)
            FinSi
        FinSi
        SECHeader@ = SECHeader@@ + &IMAGE_SECTION_HEADER
    Seguir
FinProc

' Ajustamos las referencias de memoria.
Proc RelocaciónBase(Referencia Res:LIB_INFO)
    Var @Directorio:IMAGE_DATA_DIRECTORY
    Var @Reloc:IMAGE_BASE_RELOCATION
    Var @Des:Entero
    Var @RelocInfo:Word
    Var @Pos:Word
    Var i:Entero
    Var Tipo:Word
    Directorio@ = GET_HEADER_DICTIONARY(Res.Base,IMAGE_DIRECTORY_ENTRY_BASERELOC)
    Si Directorio.Size Entonces
        Reloc@ = Res.Base + Directorio.VirtualAddress
        Mientras Reloc.VirtualAddress
            RelocInfo@ = Reloc@@ + IMAGE_SIZEOF_BASE_RELOCATION
            i = 0
            ' DIOS! COMO ME COSTO HACER ANDAR ESTE CÓDIGO!!
            ' PUT* Delphi, Put* C.
            Contar i a ((Reloc.SizeOfBlock - IMAGE_SIZEOF_BASE_RELOCATION) / 2) - 1
                Des@ = Res.Base + Reloc.VirtualAddress
                Si (RelocInfo Shr &C) = IMAGE_REL_BASED_HIGHLOW Entonces
                    Des@ = Des@@ + (RelocInfo And &FFF)
                    Des = LOWORD(Des) + Res.Base
                FinSi
                RelocInfo@ = RelocInfo@@ + &Word
            Seguir
            Reloc@ = Reloc@@ + Reloc.SizeOfBlock
        FinMientras
    FinSi
FinProc

' Invocamos el punto de entrada.
Proc InvocarPuntoDeEntrada(Referencia Res:LIB_INFO,Bandera:Entero):Booleano
    Var @EntryPoint:LibEntryPoint
    Si Res.NT.OptionalHeader.AddressOfEntryPoint Entonces
        EntryPoint@ = Res.Base + Res.NT.OptionalHeader.AddressOfEntryPoint
        Resultado = EntryPoint(Res.Base,Bandera,0)
        Res.Inicializado = Resultado
    FinSi
FinProc

Proc MemLoadLibrary(LibPtr:Entero):LIB_INFO

    Var @PEHeader:IMAGE_NT_HEADERS
    Var @DOSHeader:IMAGE_DOS_HEADER
    Var Headers:Entero
    Var Reubicar:Booleano
    Var LibBase:Entero
    
    DOSHeader@ = GET_DOS_HEADER(LibPtr)
    PEHeader@ = GET_NT_HEADERS(LibPtr)
    
    Var Base:Entero
    
    Base = VirtualAlloc(PEHeader.OptionalHeader.ImageBase,PEHeader.OptionalHeader.SizeOfImage,MEM_RESERVE + MEM_COMMIT,PAGE_READWRITE)
    
    Si Base = 0 Entonces
        Base = VirtualAlloc(0,PEHeader.OptionalHeader.SizeOfImage,MEM_RESERVE + MEM_COMMIT,PAGE_READWRITE)
        Si Base = 0 Entonces Salir
        Reubicar = Verdadero
        LibBase = PEHeader.OptionalHeader.ImageBase
    FinSi
    
    ' Comprometemos la memoria para las cabeceras, esto se hacce re-invocando VirtualAlloc.
    
    Headers = VirtualAlloc(Base,PEHeader.OptionalHeader.SizeOfHeaders,MEM_COMMIT,PAGE_READWRITE)
    
    memcpy(Headers,LibPtr,DOSHeader.e_lfanew + PEHeader.OptionalHeader.SizeOfHeaders)
    
    Resultado.Base = Base
    Resultado.NT@ = PEHeader@@
    Resultado.NT.OptionalHeader.ImageBase = Base
    
    CopiarSecciones(Resultado,PEHeader,LibPtr)
    
    Si Reubicar Entonces RelocaciónBase(Resultado)
    
    RegImportaciones(Resultado)
    
    LimpiarSecciones(Resultado)
    
    InvocarPuntoDeEntrada(Resultado,DLL_PROCESS_ATTACH)
    
    'VirtualFree(Base,0,MEM_RELEASE)
    
FinProc

Proc MemGetProcAddress(Referencia Modulo:LIB_INFO,Nombre:Cadena,Opcional Sensitivo:Booleano):Entero
    Var @Directorio:IMAGE_DATA_DIRECTORY
    Var @Export:IMAGE_EXPORT_DIRECTORY
    Var @NomRef:Entero
    Var @Ord:Word
    Var i:Entero
    Var iOrd:Entero
    Var @PtrProc:Entero
    iOrd = -1
    Directorio@ = GET_HEADER_DICTIONARY(Modulo.Base,IMAGE_DIRECTORY_ENTRY_EXPORT)
    Si Directorio.Size Entonces
        Export@ = Modulo.Base + Directorio.VirtualAddress
        Si (Export.NumberOfNames = 0) o (Export.NumberOfFunctions = 0) Entonces Salir
        NomRef@ = Modulo.Base + Export.AddressOfNames
        Ord@ = Modulo.Base + Export.AddressOfNameOrdinals
        Contar i a Export.NumberOfNames - 1
            Si Sensitivo Entonces
                Si strcmp(CadDePtr(Modulo.Base + NomRef),Nombre) = 0 Entonces
                    iOrd = Ord
                    Salir Contar
                FinSi
            SiNo
                Si strcmpi(CadDePtr(Modulo.Base + NomRef),Nombre) = 0 Entonces
                    iOrd = Ord
                    Salir Contar
                FinSi
            FinSi
            NomRef = NomRef + &Entero
            Ord = Ord + &Word
        Seguir
        Si iOrd = -1 Entonces Salir
        Si iOrd > Export.NumberOfFunctions - 1 Entonces Salir
        PtrProc@ = (Modulo.Base + (Export.AddressOfFunctions + (iOrd * 4)))
        Resultado = Modulo.Base + PtrProc
    FinSi
FinProc

Proc MemFreeLibrary(Referencia Res:LIB_INFO)
    Var i:Entero
    Si Res.Inicializado Entonces
        InvocarPuntoDeEntrada(Res,DLL_PROCESS_DETACH)
        Res.Inicializado = Falso
        LibImportaciones(Res)
        Si Res.Base Entonces
            VirtualFree(Res.Base,0,MEM_RELEASE)
            Si Res.NT@@ Entonces Res.NT@ = 0
            Res.Base = 0
            ReDim Res.Librerías,0
            Res.NumLibs = 0
        FinSi
    FinSi
FinProc