tools.ps.windows: Implement ps. for Windows!

db4
Doug Coleman 2013-04-26 21:14:32 -07:00
parent c95c0fcc98
commit 90c7c3fc81
1 changed files with 74 additions and 2 deletions

View File

@ -1,4 +1,76 @@
USING: system tools.ps ;
USING: accessors alien alien.c-types alien.data alien.syntax
arrays byte-arrays classes.struct destructors fry io
io.encodings.string io.encodings.utf16n kernel literals locals
math nested-comments sequences strings system tools.ps
windows.errors windows.handles windows.kernel32 windows.ntdll
windows.types ;
IN: tools.ps.windows
M: windows ps ( -- assoc ) { } ;
: do-snapshot ( snapshot-type -- handle )
0 CreateToolhelp32Snapshot dup win32-error=0/f ;
: default-process-entry ( -- obj )
PROCESSENTRY32 <struct> PROCESSENTRY32 heap-size >>dwSize ;
: first-process ( handle -- PROCESSENTRY32 )
default-process-entry
[ Process32First win32-error=0/f ] keep ;
: next-process ( handle -- PROCESSENTRY32/f )
default-process-entry [ Process32Next ] keep swap
FALSE = [ drop f ] when ;
: open-process-read ( dwProcessId -- HANDLE )
[
flags{ PROCESS_QUERY_INFORMATION PROCESS_VM_READ }
FALSE
] dip OpenProcess ;
: query-information-process ( HANDLE -- PROCESS_BASIC_INFORMATION )
0
PROCESS_BASIC_INFORMATION <struct> [
dup byte-length
f
NtQueryInformationProcess drop
] keep ;
:: read-process-memory ( HANDLE alien offset len -- byte-array )
HANDLE
offset alien <displaced-alien>
len <byte-array> dup :> ba
len
f
ReadProcessMemory win32-error=0/f
ba ;
:: read-args ( handle -- string/f )
handle <win32-handle> &dispose drop
handle query-information-process :> process-basic-information
handle process-basic-information PebBaseAddress>>
[
0x10 PVOID heap-size read-process-memory
PVOID deref :> args-offset
args-offset ALIEN: 0 = [
f
] [
handle args-offset 0x40 UNICODE_STRING heap-size read-process-memory
[ handle ] dip
UNICODE_STRING deref [ Buffer>> 0 ] [ Length>> ] bi read-process-memory
utf16n decode
] if
] [ drop f ] if* ;
: process-list ( -- assoc )
[
TH32CS_SNAPALL do-snapshot
[ <win32-handle> &dispose drop ]
[ first-process ]
[ '[ drop _ next-process ] follow ] tri
[
[ th32ProcessID>> ]
[ th32ProcessID>> open-process-read dup [ read-args ] when ]
[ szExeFile>> [ 0 = ] trim-tail >string or ] tri 2array
] map
] with-destructors ;
M: windows ps ( -- assoc ) process-list ;