код не проверенный и чисто иллюстративный

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
import Foreign
import Data.List
import qualified Data.Text as T
import Data.Text.Foreign
import Data.Word
data Entry = Offset Int | DeRef
peekAt :: Storable a => [Entry] -> Ptr b -> IO a
peekAt [] p = peek $ castPtr p
peekAt (Offset n : path) p = peekAt path (p `plusPtr` n)
peekAt (DeRef : path) p = peek (castPtr p) >>= peekAt path
sizeT = sizeOf (undefined :: IntPtr)
{- typedef struct _LSA_UNICODE_STRING {
USHORT Length;
USHORT MaximumLength;
PWSTR Buffer;
} UNICODE_STRING; -}
newtype UnicodeString = UnicodeString String deriving (Eq, Ord, Show)
instance Storable UnicodeString where
sizeOf _ = 4 + sizeT
alignment _ = 4 -- ??
peek p = do
length <- (peek $ castPtr p) :: IO Word16
str <- peekAt [Offset 4] p
text <- fromPtr str (fromEnum $ length `div` 2)
return $ UnicodeString $ T.unpack text
poke _ _ = error "Not implemented"
{- typedef struct _LIST_ENTRY {
struct _LIST_ENTRY *Flink;
struct _LIST_ENTRY *Blink;
} LIST_ENTRY; -}
data ListEntry a = ListEntry {
backLink :: Ptr a
, forwardLink :: Ptr a
}
instance Storable (ListEntry a) where
sizeOf _ = 2 * sizeT
alignment _ = 4 -- ??
peek p = do
back <- peek $ castPtr p
forward <- peek $ castPtr (p `plusPtr` sizeT)
return $ ListEntry back forward
poke _ _ = error "Not implemented"
readNext :: (Storable a) => ListEntry a -> IO (Maybe a)
readNext entry =
let p = forwardLink entry in
if p == nullPtr then return Nothing
else peek p >>= return . Just
readDList :: (Storable a) => ListEntry a -> (a -> ListEntry a) -> IO [a]
readDList head extract = do
entry <- readNext head
case entry of
Just x -> readDList (extract x) extract >>= return . (x:)
Nothing -> return []
{- typedef struct _LDR_DATA_TABLE_ENTRY {
BYTE Reserved1[2];
LIST_ENTRY InMemoryOrderLinks;
PVOID Reserved2[2];
PVOID DllBase;
PVOID EntryPoint;
PVOID Reserved3;
UNICODE_STRING FullDllName;
BYTE Reserved4[8];
PVOID Reserved5[3];
union {
ULONG CheckSum;
PVOID Reserved6;
};
ULONG TimeDateStamp;
} LDR_DATA_TABLE_ENTRY; -}
data LdrTableEntry = LdrTableEntry {
listEntry :: ListEntry LdrTableEntry
, fullDllName :: UnicodeString
, dllBase :: IntPtr
}
instance Storable LdrTableEntry where
sizeOf _ = 66 -- лень считать с sizeT было
alignment _ = 4 -- ??
peek p = do
entry <- peekAt [Offset 2] p
base <- peekAt [Offset 18] p
name <- peekAt [Offset 30] p
return $ LdrTableEntry entry name base
getModuleHandle :: String -> IO (Maybe IntPtr)
getModuleHandle modName = do
pPEB <- getPEBPtrByForeignMagic -- дёргаем единственную внешнюю функцию на Си
head <- peekAt [Offset $ 4 + 2 * sizeT, DeRef, Offset $ 8 + 3 * sizeT] pPEB
list <- readDList head listEntry
let x = find (\x -> fullDllName x == UnicodeString modName) list >>= return . dllBase
return x