Script Library: 1238 scripts
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Archive version of: mem-check.r ... version: 2 ... sqlab 10-Jan-2005

Amendment note: I hope the formatting looks better now || Publicly available? Yes

Rebol [
	File: %mem-check.r
	Title: "Mem-Checker"
	Date: 10-Jan-2005
	Author: "Anton Reisacher"
	Purpose: "Checking the memory usage of critical processes running under Windows"
	Library: [
		Level: 'intermediate
		platform: [Windows]
		Notes: {from the Microsoft site on psapi.dll
			Client 	Requires Windows XP, Windows 2000 Professional, or Windows NT Workstation 4.0.
			Server 	Requires Windows Server 2003, Windows 2000 Server, or Windows NT Server 4.0.
		}
		type: [tool]
		tested-under: [WIN/NT  WIN2000]
		domain: [win-api ]
		Support: none
		License: none
	]

]
win-lib: context [
	kernel-lib: load/library %kernel32.dll
	
	GetError: make routine! [
		void [integer!]
		return: [long!]
	] kernel-lib "GetLastError"
	
	FormatMsg: make routine! [
		flags			[integer!] ; 4096
		Source		[integer!] ; 0
		MsgID		[integer!]  ; errno
		Language		[integer!] ; 0
		Buffer		[string!]
		Size			[integer!]
		Arguments		[integer!] ; 0
		return: 		[integer!]
	] kernel-lib "FormatMessageA"
		
	System-Msg: func [
		msgid 
		/local len buf
	] [
		buf: head insert/dup make string! 1000  "^@" 1000
		
		len:  FormatMsg 4096 0 msgid 0 buf 1000 0 
		copy/part  buf len
	]
	
	
	OpenProc: make routine! [
		AccessFlag		[integer!]; 1 = Terminate; 2035711 all-flags
		Inherited		[integer!]
		ProcessID		[integer!]
		return:		[integer!]
	] kernel-lib "OpenProcess"

	TerminateProcess: make routine! [
		handle 		[integer!]
		Exitcode 		[integer!]
		return: 		[integer!]
	] kernel-lib "TerminateProcess"
	
	set 'Terminate func [ [catch]  ; 
		Process-id [integer!]
		/local ProcHandle
	] [
		if any [
			0 = ProcHandle: Openproc 1 1 process-ID
			0 = TerminateProcess Proc-Handle 1 
		] [
			throw make error! System-Msg GetError 0
		]
	]
	

	FreeHandle: make routine! [
		handle		[integer!]
		return:		[integer!]
	] kernel-lib "CloseHandle"

	psapi-lib: load/library %psapi.dll
	
	ProcMemCounter-block: make block! [
		Size 			[integer!] ; in bytes
		PageFault 		[integer!] ; Number of page faults.
		PeakWorkingSize 	[integer!] ; Peak working set size
		WorkingSize 	[integer!] ; Current working set size
		QuotaPeakPaged 	[integer!]; Peak paged pool usage
		QuotaPaged 	[integer!] ; Current paged pool usage
		QuotaPeakNonPaged [integer!]; Current nonpaged pool usage
		QuotaNonPaged 	[integer!] ; Current nonpaged pool usage
		PageFile 		[integer!] ; Current space allocated for the pagefile
		PeakPageFile 	[integer!]; Peak space allocated for the pagefile
	]

	GetProcessMemory-block: compose/only [
		handle 		[integer!]
		pProcMemCounter (append/only [struct!] ProcMemCounter-block)
		return: 		[integer!]
	] 
	GetProcessMemory: make routine! GetProcessMemory-block psapi-lib "GetProcessMemoryInfo"
	
	set 'Check-Memory func [ [catch] ; '
		process-id [integer!]
		/local ProcMemCounter ProcHandle
	] [
		ProcMemCounter: make struct! ProcMemCounter-block none
		ProcMemCounter/size: length? third ProcMemCounter
		if any [
			0 = ProcHandle: OpenProc 2035711 1 process-id
			0 = GetProcessMemory ProcHandle ProcMemCounter
		] [
			throw make error! System-Msg GetError 0
		]
		freehandle ProcHandle
		ProcMemCounter
	]

]





Comment [
{	I use these routines in combination with routines from 
	"windows-list.r" by Paul Trettter to guard the memory usage 
	of some server processes.
	e.g.  }
	
	foreach [Process-id start-link]  from list-of-critical-windows [
	
		Memory: Check-Memory Process-ID
		if all	[
			Memory/pagefile > procmemcounter/peakworkingsize
			procmemcounter/pagefile > 15'000'000 ; 	15 Mb is very conservative
										;       but my processes require normally lesser mem
		] [
			Terminate Process-id
		;	execute start-link
		 	launch  start-link
		]
	]
]