basis/tools/ps/windows/windows.factor

   1 USING: accessors alien alien.c-types alien.data alien.syntax
   2 arrays byte-arrays classes.struct destructors fry io
   3 io.encodings.string io.encodings.utf16n kernel literals locals
   4 math nested-comments sequences strings system tools.ps
   5 windows.errors windows.handles windows.kernel32 windows.ntdll
   6 windows.types ;
   7 IN: tools.ps.windows
   8
   9 : do-snapshot ( snapshot-type -- handle )
  10     0 CreateToolhelp32Snapshot dup win32-error=0/f ;
  11
  12 : default-process-entry ( -- obj )
  13     PROCESSENTRY32 <struct> PROCESSENTRY32 heap-size >>dwSize ;
  14
  15 : first-process ( handle -- PROCESSENTRY32 )
  16     default-process-entry
  17     [ Process32First win32-error=0/f ] keep ;
  18
  19 : next-process ( handle -- PROCESSENTRY32/f )
  20     default-process-entry [ Process32Next ] keep swap
  21     FALSE = [ drop f ] when ;
  22
  23 : open-process-read ( dwProcessId -- HANDLE )
  24     [
  25         flags{ PROCESS_QUERY_INFORMATION PROCESS_VM_READ }
  26         FALSE
  27     ] dip OpenProcess ;
  28
  29 : query-information-process ( HANDLE -- PROCESS_BASIC_INFORMATION )
  30     0
  31     PROCESS_BASIC_INFORMATION <struct> [
  32         dup byte-length
  33         f
  34         NtQueryInformationProcess drop
  35     ] keep ;
  36
  37 :: read-process-memory ( HANDLE alien offset len -- byte-array )
  38     HANDLE
  39     offset alien <displaced-alien>
  40     len <byte-array> dup :> ba
  41     len
  42     f
  43     ReadProcessMemory win32-error=0/f
  44     ba ;
  45
  46 :: read-args ( handle -- string/f )
  47     handle <win32-handle> &dispose drop
  48     handle query-information-process :> process-basic-information
  49     handle process-basic-information PebBaseAddress>>
  50     [
  51         0x10 PVOID heap-size read-process-memory
  52         PVOID deref :> args-offset
  53         args-offset ALIEN: 0 = [
  54             f
  55         ] [
  56             handle args-offset 0x40 UNICODE_STRING heap-size read-process-memory
  57             [ handle ] dip
  58             UNICODE_STRING deref [ Buffer>> 0 ] [ Length>> ] bi read-process-memory
  59             utf16n decode
  60         ] if
  61     ] [ drop f ] if* ;
  62
  63 : process-list ( -- assoc )
  64     [
  65         TH32CS_SNAPALL do-snapshot
  66         [ <win32-handle> &dispose drop ]
  67         [ first-process ]
  68         [ '[ drop _ next-process ] follow ] tri
  69         [
  70             [ th32ProcessID>> ]
  71             [ th32ProcessID>> open-process-read dup [ read-args ] when ]
  72             [ szExeFile>> [ 0 = ] trim-tail >string or ] tri 2array
  73         ] map
  74     ] with-destructors ;
  75
  76 M: windows ps ( -- assoc ) process-list ;