1#if __GLASGOW_HASKELL__ >= 709 2{-# LANGUAGE Safe #-} 3#elif __GLASGOW_HASKELL__ >= 701 4{-# LANGUAGE Trustworthy #-} 5#endif 6----------------------------------------------------------------------------- 7-- | 8-- Module : System.Win32.Process 9-- Copyright : (c) Alastair Reid, 1997-2003 10-- License : BSD-style (see the file libraries/base/LICENSE) 11-- 12-- Maintainer : Esa Ilari Vuokko <ei@vuokko.info> 13-- Stability : provisional 14-- Portability : portable 15-- 16-- A collection of FFI declarations for interfacing with Win32. 17-- 18----------------------------------------------------------------------------- 19 20module System.Win32.Process where 21import Control.Exception ( bracket ) 22import Control.Monad ( liftM5 ) 23import Foreign ( Ptr, peekByteOff, allocaBytes, pokeByteOff 24 , plusPtr ) 25import Foreign.C.Types ( CUInt(..) ) 26import System.Win32.File ( closeHandle ) 27import System.Win32.Types 28 29##include "windows_cconv.h" 30 31#include <windows.h> 32#include <tlhelp32.h> 33 34-- constant to wait for a very long time. 35iNFINITE :: DWORD 36iNFINITE = #{const INFINITE} 37 38foreign import WINDOWS_CCONV unsafe "windows.h Sleep" 39 sleep :: DWORD -> IO () 40 41 42type ProcessId = DWORD 43type ProcessHandle = HANDLE 44type ProcessAccessRights = DWORD 45#{enum ProcessAccessRights, 46 , pROCESS_ALL_ACCESS = PROCESS_ALL_ACCESS 47 , pROCESS_CREATE_PROCESS = PROCESS_CREATE_PROCESS 48 , pROCESS_CREATE_THREAD = PROCESS_CREATE_THREAD 49 , pROCESS_DUP_HANDLE = PROCESS_DUP_HANDLE 50 , pROCESS_QUERY_INFORMATION = PROCESS_QUERY_INFORMATION 51 , pROCESS_SET_QUOTA = PROCESS_SET_QUOTA 52 , pROCESS_SET_INFORMATION = PROCESS_SET_INFORMATION 53 , pROCESS_TERMINATE = PROCESS_TERMINATE 54 , pROCESS_VM_OPERATION = PROCESS_VM_OPERATION 55 , pROCESS_VM_READ = PROCESS_VM_READ 56 , pROCESS_VM_WRITE = PROCESS_VM_WRITE 57 , sYNCHORNIZE = SYNCHRONIZE 58 } 59 60foreign import WINDOWS_CCONV unsafe "windows.h OpenProcess" 61 c_OpenProcess :: ProcessAccessRights -> BOOL -> ProcessId -> IO ProcessHandle 62 63 64openProcess :: ProcessAccessRights -> BOOL -> ProcessId -> IO ProcessHandle 65openProcess r inh i = failIfNull "OpenProcess" $ c_OpenProcess r inh i 66 67foreign import WINDOWS_CCONV unsafe "windows.h GetProcessId" 68 c_GetProcessId :: ProcessHandle -> IO ProcessId 69 70getProcessId :: ProcessHandle -> IO ProcessId 71getProcessId h = failIfZero "GetProcessId" $ c_GetProcessId h 72 73foreign import WINDOWS_CCONV unsafe "windows.h GetCurrentProcess" 74 c_GetCurrentProcess :: IO ProcessHandle 75 76foreign import WINDOWS_CCONV unsafe "windows.h GetCurrentProcessId" 77 c_GetCurrentProcessId :: IO ProcessId 78 79getCurrentProcessId :: IO ProcessId 80getCurrentProcessId = c_GetCurrentProcessId 81 82getCurrentProcess :: IO ProcessHandle 83getCurrentProcess = c_GetCurrentProcess 84 85foreign import WINDOWS_CCONV unsafe "windows.h TerminateProcess" 86 c_TerminateProcess :: ProcessHandle -> CUInt -> IO Bool 87 88terminateProcessById :: ProcessId -> IO () 89terminateProcessById p = bracket 90 (openProcess pROCESS_TERMINATE False p) 91 closeHandle 92 (\h -> failIfFalse_ "TerminateProcess" $ c_TerminateProcess h 1) 93 94type Th32SnapHandle = HANDLE 95type Th32SnapFlags = DWORD 96-- | ProcessId, number of threads, parent ProcessId, process base priority, path of executable file 97type ProcessEntry32 = (ProcessId, Int, ProcessId, LONG, String) 98 99#{enum Th32SnapFlags, 100 , tH32CS_SNAPALL = TH32CS_SNAPALL 101 , tH32CS_SNAPHEAPLIST = TH32CS_SNAPHEAPLIST 102 , tH32CS_SNAPMODULE = TH32CS_SNAPMODULE 103 , tH32CS_SNAPPROCESS = TH32CS_SNAPPROCESS 104 , tH32CS_SNAPTHREAD = TH32CS_SNAPTHREAD 105 } 106{- 107 , tH32CS_SNAPGETALLMODS = TH32CS_GETALLMODS 108 , tH32CS_SNAPNOHEAPS = TH32CS_SNAPNOHEAPS 109-} 110 111foreign import WINDOWS_CCONV unsafe "tlhelp32.h CreateToolhelp32Snapshot" 112 c_CreateToolhelp32Snapshot :: Th32SnapFlags -> ProcessId -> IO Th32SnapHandle 113 114foreign import WINDOWS_CCONV unsafe "tlhelp32.h Process32FirstW" 115 c_Process32First :: Th32SnapHandle -> Ptr ProcessEntry32 -> IO BOOL 116 117foreign import WINDOWS_CCONV unsafe "tlhelp32.h Process32NextW" 118 c_Process32Next :: Th32SnapHandle -> Ptr ProcessEntry32 -> IO BOOL 119 120-- | Create a snapshot of specified resources. Call closeHandle to close snapshot. 121createToolhelp32Snapshot :: Th32SnapFlags -> Maybe ProcessId -> IO Th32SnapHandle 122createToolhelp32Snapshot f p 123 = failIfNull "CreateToolhelp32Snapshot" $ c_CreateToolhelp32Snapshot 124 f (maybe 0 id p) 125 126withTh32Snap :: Th32SnapFlags -> Maybe ProcessId -> (Th32SnapHandle -> IO a) -> IO a 127withTh32Snap f p = bracket (createToolhelp32Snapshot f p) (closeHandle) 128 129 130peekProcessEntry32 :: Ptr ProcessEntry32 -> IO ProcessEntry32 131peekProcessEntry32 buf = liftM5 (,,,,) 132 ((#peek PROCESSENTRY32W, th32ProcessID) buf) 133 ((#peek PROCESSENTRY32W, cntThreads) buf) 134 ((#peek PROCESSENTRY32W, th32ParentProcessID) buf) 135 ((#peek PROCESSENTRY32W, pcPriClassBase) buf) 136 (peekTString $ (#ptr PROCESSENTRY32W, szExeFile) buf) 137 138-- | Enumerate processes using Process32First and Process32Next 139th32SnapEnumProcesses :: Th32SnapHandle -> IO [ProcessEntry32] 140th32SnapEnumProcesses h = allocaBytes (#size PROCESSENTRY32W) $ \pe -> do 141 (#poke PROCESSENTRY32W, dwSize) pe ((#size PROCESSENTRY32W)::DWORD) 142 ok <- c_Process32First h pe 143 readAndNext ok pe [] 144 where 145 readAndNext ok pe res 146 | not ok = do 147 err <- getLastError 148 if err == (#const ERROR_NO_MORE_FILES) 149 then return $ reverse res 150 else failWith "th32SnapEnumProcesses: Process32First/Process32Next" err 151 | otherwise = do 152 entry <- peekProcessEntry32 pe 153 ok' <- c_Process32Next h pe 154 readAndNext ok' pe (entry:res) 155