module System.Win32.Process where
import Control.Exception ( bracket )
import Control.Monad ( liftM5 )
import Foreign ( Ptr, peekByteOff, allocaBytes, pokeByteOff
, plusPtr )
import System.Win32.File ( closeHandle )
import System.Win32.Types
iNFINITE :: DWORD
iNFINITE = 4294967295
foreign import stdcall unsafe "windows.h Sleep"
sleep :: DWORD -> IO ()
type ProcessId = DWORD
type ProcessHandle = HANDLE
type ProcessAccessRights = DWORD
pROCESS_ALL_ACCESS :: ProcessAccessRights
pROCESS_ALL_ACCESS = 2035711
pROCESS_CREATE_PROCESS :: ProcessAccessRights
pROCESS_CREATE_PROCESS = 128
pROCESS_CREATE_THREAD :: ProcessAccessRights
pROCESS_CREATE_THREAD = 2
pROCESS_DUP_HANDLE :: ProcessAccessRights
pROCESS_DUP_HANDLE = 64
pROCESS_QUERY_INFORMATION :: ProcessAccessRights
pROCESS_QUERY_INFORMATION = 1024
pROCESS_SET_QUOTA :: ProcessAccessRights
pROCESS_SET_QUOTA = 256
pROCESS_SET_INFORMATION :: ProcessAccessRights
pROCESS_SET_INFORMATION = 512
pROCESS_TERMINATE :: ProcessAccessRights
pROCESS_TERMINATE = 1
pROCESS_VM_OPERATION :: ProcessAccessRights
pROCESS_VM_OPERATION = 8
pROCESS_VM_READ :: ProcessAccessRights
pROCESS_VM_READ = 16
pROCESS_VM_WRITE :: ProcessAccessRights
pROCESS_VM_WRITE = 32
sYNCHORNIZE :: ProcessAccessRights
sYNCHORNIZE = 1048576
foreign import stdcall unsafe "windows.h OpenProcess"
c_OpenProcess :: ProcessAccessRights -> BOOL -> ProcessId -> IO ProcessHandle
openProcess :: ProcessAccessRights -> BOOL -> ProcessId -> IO ProcessHandle
openProcess r inh i = failIfNull "OpenProcess" $ c_OpenProcess r inh i
type Th32SnapHandle = HANDLE
type Th32SnapFlags = DWORD
type ProcessEntry32 = (ProcessId, Int, ProcessId, LONG, String)
tH32CS_SNAPALL :: Th32SnapFlags
tH32CS_SNAPALL = 15
tH32CS_SNAPHEAPLIST :: Th32SnapFlags
tH32CS_SNAPHEAPLIST = 1
tH32CS_SNAPMODULE :: Th32SnapFlags
tH32CS_SNAPMODULE = 8
tH32CS_SNAPPROCESS :: Th32SnapFlags
tH32CS_SNAPPROCESS = 2
tH32CS_SNAPTHREAD :: Th32SnapFlags
tH32CS_SNAPTHREAD = 4
foreign import stdcall unsafe "tlhelp32.h CreateToolhelp32Snapshot"
c_CreateToolhelp32Snapshot :: Th32SnapFlags -> ProcessId -> IO Th32SnapHandle
foreign import stdcall unsafe "tlhelp32.h Process32FirstW"
c_Process32First :: Th32SnapHandle -> Ptr ProcessEntry32 -> IO BOOL
foreign import stdcall unsafe "tlhelp32.h Process32NextW"
c_Process32Next :: Th32SnapHandle -> Ptr ProcessEntry32 -> IO BOOL
createToolhelp32Snapshot :: Th32SnapFlags -> Maybe ProcessId -> IO Th32SnapHandle
createToolhelp32Snapshot f p
= failIfNull "CreateToolhelp32Snapshot" $ c_CreateToolhelp32Snapshot
f (maybe 0 id p)
withTh32Snap :: Th32SnapFlags -> Maybe ProcessId -> (Th32SnapHandle -> IO a) -> IO a
withTh32Snap f p = bracket (createToolhelp32Snapshot f p) (closeHandle)
peekProcessEntry32 :: Ptr ProcessEntry32 -> IO ProcessEntry32
peekProcessEntry32 buf = liftM5 (,,,,)
(((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf)
(((\hsc_ptr -> peekByteOff hsc_ptr 20)) buf)
(((\hsc_ptr -> peekByteOff hsc_ptr 24)) buf)
(((\hsc_ptr -> peekByteOff hsc_ptr 28)) buf)
(peekTString $ ((\hsc_ptr -> hsc_ptr `plusPtr` 36)) buf)
th32SnapEnumProcesses :: Th32SnapHandle -> IO [ProcessEntry32]
th32SnapEnumProcesses h = allocaBytes ((556)) $ \pe -> do
putStrLn "1"
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) pe (((556))::DWORD)
putStrLn "2"
ok <- c_Process32First h pe
putStrLn "3"
readAndNext ok pe []
where
readAndNext ok pe res
| not ok = do
err <- getLastError
print err
if err==(18)
then return $ reverse res
else failWith "th32SnapEnumProcesses: Process32First/Process32Next" err
| otherwise = do
putStrLn "reading"
entry <- peekProcessEntry32 pe
ok' <- c_Process32Next h pe
readAndNext ok' pe (entry:res)