extra/hardware-info/windows/nt/nt.factor

   1 USING: alien alien.c-types alien.strings
   2 kernel libc math namespaces hardware-info.backend
   3 windows windows.advapi32 windows.kernel32 system ;
   4 IN: hardware-info.windows.nt
   5
   6 : system-info ( -- SYSTEM_INFO )
   7     "SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ;
   8
   9 M: winnt cpus ( -- n )
  10     system-info SYSTEM_INFO-dwNumberOfProcessors ;
  11
  12 : memory-status ( -- MEMORYSTATUSEX )
  13     "MEMORYSTATUSEX" <c-object>
  14     "MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength
  15     [ GlobalMemoryStatusEx ] keep swap zero? [ win32-error ] when ;
  16
  17 M: winnt memory-load ( -- n )
  18     memory-status MEMORYSTATUSEX-dwMemoryLoad ;
  19
  20 M: winnt physical-mem ( -- n )
  21     memory-status MEMORYSTATUSEX-ullTotalPhys ;
  22
  23 M: winnt available-mem ( -- n )
  24     memory-status MEMORYSTATUSEX-ullAvailPhys ;
  25
  26 M: winnt total-page-file ( -- n )
  27     memory-status MEMORYSTATUSEX-ullTotalPageFile ;
  28
  29 M: winnt available-page-file ( -- n )
  30     memory-status MEMORYSTATUSEX-ullAvailPageFile ;
  31
  32 M: winnt total-virtual-mem ( -- n )
  33     memory-status MEMORYSTATUSEX-ullTotalVirtual ;
  34
  35 M: winnt available-virtual-mem ( -- n )
  36     memory-status MEMORYSTATUSEX-ullAvailVirtual ;
  37
  38 : pull-win32-string ( alien -- string )
  39     [ utf16n alien>string ] keep free ;
  40
  41 : computer-name ( -- string )
  42     MAX_COMPUTERNAME_LENGTH 1+ [ malloc ] keep
  43     <int> dupd GetComputerName zero? [
  44         free win32-error f
  45     ] [
  46         pull-win32-string
  47     ] if ;
  48
  49 : username ( -- string )
  50     UNLEN 1+ [ malloc ] keep
  51     <int> dupd GetUserName zero? [
  52         free win32-error f
  53     ] [
  54         pull-win32-string
  55     ] if ;