>
>How do you get process ID of all VFP processes?
The recipe
- You start by going to microsoft's website and searching for 'enum process'
- You find this :
http://msdn.microsoft.com/en-us/library/ms682629(VS.85).aspx- You then wade through all the bits and pieces and come up with this
Display all processes that can be opened - see ProcessSample()
You can filter on the path of the processes
#define true .T.
#define false .F.
#include "FoxPro.h"
function ProcessSample()
local success
success = true
local processBitsObj, processQueueObj, processObj
do case
case !m.success
case !ProcessBits_Object(@m.processBitsObj)
assert false
success = false
case !m.processBitsObj.GetProcessQueue(@m.processQueueObj)
assert false
success = false
otherwise
do while m.success and m.processQueueObj.Dequeue(@m.processObj)
with m.processObj
? .Id, .Path
endwith
enddo
endcase
return m.success
endfunc
#define LIGHTWEIGHT_CLASS [_LightWeightClass_]
define class LIGHTWEIGHT_CLASS as Relation
hidden ChildAlias, ChildOrder, ClassLibrary, ;
Comment, OneToMany, ;
Parent, ParentAlias, RelationalExpr, Tag
DataSessionId = 0
protected function init()
local success
success = true
do case
case !m.success
case !DoDefault()
assert false
success = false
case !AddProperty(m.this, 'DataSessionId', set('dataSession'))
assert false
success = false
endcase
return m.success
endfunc
protected function Destroy()
return DoDefault()
endfunc
enddefine
#define PROCESSBITS_CLASS [_ProcessBits_Class_]
function ProcessBits_Object(obj)
local success
success = true
obj = null
try
obj = createObject(PROCESSBITS_CLASS)
catch
assert false
success = false
endtry
return m.success
endfunc
define class PROCESSBITS_CLASS as LIGHTWEIGHT_CLASS
WindowErrorObj = null
protected function init()
local success
success = true
local obj
do case
case !m.success
case !DoDefault()
assert false
success = false
case !WindowsError_Object(@m.obj)
assert false
success = false
case !m.this.AddProperty('WindowErrorObj', m.obj)
assert false
success = false
endcase
return m.success
endfunc
protected function Destroy()
store null to ;
this.WindowErrorObj
return DoDefault()
endfunc
#if false
queue of processes that can be opened
objects
- Id process id
- Path path
#endif
#if false
http://msdn.microsoft.com/en-us/library/ms682629(VS.85).aspx
#endif
#define MAX_PROCESSES 8192
function GetProcessQueue(queueObj)
local success
success = true
local s, nbytesIn, nBytesOut
nbytesIn = 4 * MAX_PROCESSES
s = space(m.nbytesIn)
nBytesOut = 0
do case
case !m.success
case empty(EnumProcesses(@m.s, m.nbytesIn, @m.nBytesOut))
assert false
success = false
case !Queue_Object(@m.queueObj)
assert false
success = false
otherwise
local processObj
for i = 1 to m.nBytesOut step 4
do case
case !m.success
exit
case !m.this.GetProcess( ;
@m.processObj, ;
ctobin(substr(m.s, m.i, 4), '4rs') ;
)
assert false
success = false
case isnull(m.processObj)
case !m.queueObj.Enqueue(m.processObj)
assert false
success = false
endcase
endfor
endcase
return m.success
endfunc
#define PROCESS_ALL_ACCESS bitor(0x000F0000, 0x00100000,0x0FFF)
#define PROCESS_QUERY_INFORMATION (0x0400)
protected function GetProcess(processObj, pid)
local success
success = true
local pHandle, disposableHandleObj
do case
case !m.success
otherwise
pHandle = OpenProcess( PROCESS_QUERY_INFORMATION, 0, m.pid)
endcase
do case
case !m.success
case empty(m.pHandle)
processObj = null
case !Disposable_CloseHandle_Object(@m.disposableHandleObj, m.pHandle )
assert false
success = false
case !Empty_Object(@m.processObj)
assert false
success = false
case !AddProperty(m.processObj, 'Id', m.pid)
assert false
success = false
case !m.this.GetProcess_AddInfo_Path(m.pHandle, m.processObj)
assert false
success = false
endcase
return m.success
endfunc
protected function GetProcess_AddInfo_Path(pHandle, processObj)
local success
success = true
local s, nBytes, lastError
s = space(1024)
nBytes = len(m.s)
do case
case !m.success
case empty( ;
QueryFullProcessImageName( ;
m.pHandle, ;
0, ;
@m.s, ;
@m.nBytes ;
) ;
)
lastError = GetLastError()
do case
case !m.this.WindowErrorObj.Format(@m.s, m.lastError)
assert false
endcase
asser false
case !AddProperty(m.processObj, 'Path', left(m.s, m.nBytes))
assert false
success = false
endcase
return m.success
endfunc
enddefine
#define DISPOSABLE_BASE_CLASS [_Disposable_Base_Class_]
#define DISPOSABLE_INTEGER_CLASS [_Disposable_Integer_Class_]
define class DISPOSABLE_BASE_CLASS as LIGHTWEIGHT_CLASS
DisposeFunction = ''
ArgsPattern = '(%1)'
ItemToDispose = null
protected function init(disposeFunction, itemToDispose)
local success
success = true
do case
case !m.success
case !DoDefault()
assert false
success = false
case !IsChar(m.this.ArgsPattern, true)
assert false
success = false
case !IsChar(m.disposeFunction, true)
assert false
success = false
case !m.this.AddProperty('DisposeFunction', m.disposeFunction + m.this.ArgsPattern)
assert false
success = false
case pcount() < 2
assert false
success = false
otherwise
this.ItemToDispose = m.itemToDispose
endcase
return m.success
endfunc
protected function Destroy()
=m.this.Dispose()
return DoDefault()
endfunc
function Dispose()
local success
success = true
do case
case !m.success
case isnull(m.this.ItemToDispose)
otherwise
try
success = !empty(eval(strtran(m.this.DisposeFunction, '%1', transf(m.this.ItemToDispose))))
assert m.success
catch
assert false
success = false
endtry
this.ItemToDispose = null
endcase
return m.success
endfunc
enddefine
function Disposable_Integer_Object(obj, disposeFunction, itemToDispose )
local success
success = true
obj = null
try
obj = createObject( ;
DISPOSABLE_INTEGER_CLASS, ;
disposeFunction, ;
itemToDispose ;
)
catch
assert false
success = false
endtry
return m.success
endfunc
define class DISPOSABLE_INTEGER_CLASS as DISPOSABLE_BASE_CLASS
protected function init(disposeFunction, itemToDispose)
local success
success = true
do case
case !m.success
case !IsInteger(m.itemToDispose)
assert false
success = false
case !DoDefault(m.disposeFunction, m.itemToDispose)
assert false
success = false
endcase
return m.success
endfunc
enddefine
function Disposable_CloseHandle_Object(obj, handle)
return Disposable_Integer_Object( ;
@m.obj, ;
'CloseHandle', ;
m.handle ;
)
endfunc
#define WINDOWS_ERROR_CLASS [_Windows_Error_Class]
function WindowsError_Object(obj)
local success
success = true
obj = null
try
obj = createObject( ;
WINDOWS_ERROR_CLASS ;
)
catch
assert false
success = false
endtry
return m.success
endfunc
define class WINDOWS_ERROR_CLASS as LIGHTWEIGHT_CLASS
protected function init()
local success
success = true
do case
case !m.success
case !DoDefault()
assert false
success = false
otherwise
declare Integer FormatMessage in win32api ;
Integer dwFlags, ;
string @lpSource, ;
Integer dwMessageId, ;
Integer dwLanguageId, ;
string @lpBuffer, ;
Integer nSize, ;
Integer
endcase
return m.success
endfunc
function Format(s, lastError)
local n, buf
buf = space(1024)
#define FORMAT_MESSAGE_ALLOCATE_BUFFER 0x00000100
#define FORMAT_MESSAGE_IGNORE_INSERTS 0x00000200
#define FORMAT_MESSAGE_FROM_STRING 0x00000400
#define FORMAT_MESSAGE_FROM_HMODULE 0x00000800
#define FORMAT_MESSAGE_FROM_SYSTEM 0x00001000
#define FORMAT_MESSAGE_ARGUMENT_ARRAY 0x00002000
#define FORMAT_MESSAGE_MAX_WIDTH_MASK 0x000000FF
n = FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM, ;
0, ;
m.lastError, ;
0, ;
@m.buf, ;
len(m.buf), ;
0 ;
)
s = 'Error ' + transf(m.lastError)
do case
case !empty(m.n)
s = m.s + ' : ' + left(m.buf, m.n)
endcase
#undefine FORMAT_MESSAGE_ALLOCATE_BUFFER
#undefine FORMAT_MESSAGE_IGNORE_INSERTS
#undefine FORMAT_MESSAGE_FROM_STRING
#undefine FORMAT_MESSAGE_FROM_HMODULE
#undefine FORMAT_MESSAGE_FROM_SYSTEM
#undefine FORMAT_MESSAGE_ARGUMENT_ARRAY
#undefine FORMAT_MESSAGE_MAX_WIDTH_MASK
endfunc
enddefine
#define COLLECTION_CLASS [_CollectionClass_]
function Collection_Object(obj)
local success
success = true
obj = null
try
obj = createObject(COLLECTION_CLASS)
catch
assert false
success = false
endtry
return m.success
endfunc
#if false
- properties
- HasKeys returns TRUE if the items have a key
- methods
- Clear()
- Empty()
- Add(item [, key])
- TryGetValue(@value, itemOrKey)
- ContainsKey(key)
#endif
define class COLLECTION_CLASS as Collection
DataSessionId = 0
HasKeys = false
protected function init()
local success
success = true
do case
case !m.success
case !DoDefault()
assert false
success = false
case !AddProperty(m.this, 'DataSessionId', set('dataSession'))
assert false
success = false
endcase
return m.success
endfunc
protected function Destroy()
=m.this.Clear()
return DoDefault()
endfunc
function HasKeys_Access()
return !( empty(m.this.Count) or empty(m.this.getKey(1)) )
endfunc
function Clear()
=m.this.Remove(-1)
endfunc
function Empty()
return empty(m.this.Count)
endfunc
function add(sValue, sKey)
NODEFAULT
local success
success = true
do case
case pcount() = 1
try
if( !DoDefault(m.sValue) )
assert false
success = false
endif
catch
assert false
success = false
endtry
otherwise
try
if( !DoDefault(m.sValue, m.sKey) )
assert false
success = false
endif
catch
assert false
success = false
endtry
endcase
return m.success
endfunc
function ContainsKey(key)
local success
success = true
do case
case !m.success
case !IsChar(m.Key)
assert false
success = false
otherwise
success = !empty(m.this.GetKey(m.key))
endcase
return m.success
endfunc
function TryGetValue(sValue, itemOrKey)
local success
success = true
try
sValue = m.this.Item(m.itemOrKey)
catch
success = false
endtry
return m.success
endfunc
enddefine
#define STACK_CLASS [_Stack_Class_]
function Stack_Object(obj)
local success
success = true
obj = null
try
obj = createObject( ;
STACK_CLASS ;
)
catch
assert false
success = false
endtry
return m.success
endfunc
define class STACK_CLASS as COLLECTION_CLASS
function Push(v)
=m.this.Add(m.v)
endfunc
function Pop(v)
if( empty(m.this.Count) )
return false
endif
v = m.this.Item(m.this.Count)
=m.this.Remove(m.this.Count)
endfunc
function Peek(v)
if( empty(m.this.Count) )
return false
endif
v = m.this.Item(m.this.Count)
endfunc
enddefine
#define QUEUE_CLASS [_Queue_Class_]
function Queue_Object(obj)
local success
success = true
obj = null
try
obj = createObject( ;
QUEUE_CLASS ;
)
catch
assert false
success = false
endtry
return m.success
endfunc
define class QUEUE_CLASS as COLLECTION_CLASS
function EnQueue(v)
=m.this.Add(m.v)
endfunc
function DeQueue(v)
if( empty(m.this.Count) )
return false
endif
v = m.this.Item(1)
=m.this.Remove(1)
endfunc
function Peek(v)
if( empty(m.this.Count) )
return false
endif
v = m.this.Item(1)
endfunc
enddefine
function Empty_Object(obj)
obj = createObject('Empty')
endfunc
function IsChar(s, needFilled)
return inlist(vartype(m.s), T_CHARACTER, T_MEMO) ;
and ( !m.needFilled or !empty(nvl(m.s, '')) )
endfunc
function IsLogical(s)
return inlist(vartype(m.s), T_LOGICAL)
endfunc
function IsInteger(x)
return inlist(vartype(m.x), T_NUMERIC) and empty(mod(m.x, 1))
endfunc
function IsPositiveInteger(x)
return inlist(vartype(m.x), T_NUMERIC) and empty(mod(m.x, 1)) and (m.x >= 1)
endfunc
#define BOOL integer
#define DWORD long
#define T_HANDLE long
#define PDWORD DWORD @
#define LPTSTR string @
function EnumProcesses(pProcessIds, cb, pBytesReturned)
local success
success = true
local declared
declared = false
local returnValue
local exceptionObj
local dllArray[2], dllName
dllArray[1] = [Kernel32.dll]
dllArray[2] = [Psapi.dll]
for each dllName in dllArray
try
declare BOOL EnumProcesses in (m.dllName) ;
string @pProcessIds, ;
DWORD cb, ;
DWORD @pBytesReturned
returnValue = EnumProcesses(@m.pProcessIds, m.cb, @m.pBytesReturned)
declared = true
catch to exceptionObj when m.exceptionObj.ErrorNo == 1754
catch
assert false
endtry
do case
case m.declared
exit
endcase
endfor
do case
case !m.declared
asser false
endcase
return m.returnValue
endfunc
function OpenProcess(dwDesiredAccess, bInheritHandle, dwProcessId)
local returnValue
try
declare T_HANDLE OpenProcess in Kernel32.dll ;
DWORD dwDesiredAccess, ;
BOOL bInheritHandle, ;
DWORD dwProcessId
returnValue = OpenProcess( ;
m.dwDesiredAccess, ;
m.bInheritHandle, ;
m.dwProcessId ;
)
catch
assert false
ReturnValue = 0
endtry
return m.ReturnValue
endfunc
function CloseHandle(handle)
local returnValue
try
declare BOOL CloseHandle in Kernel32.dll ;
T_HANDLE handle
returnValue = CloseHandle(m.handle)
catch
assert false
ReturnValue = 0
endtry
return m.ReturnValue
endfunc
function QueryFullProcessImageName
lparameters hProcess, ;
dwFlags, ;
lpExeName, ;
lpdwSize
local success
success = true
local declared
declared = false
local returnValue
local exceptionObj
local dllArray[2], dllName
dllArray[1] = [Kernel32.dll]
dllArray[2] = [Psapi.dll]
for each dllName in dllArray
try
declare BOOL QueryFullProcessImageName in Kernel32.dll ;
T_HANDLE hProcess, ;
DWORD dwFlags, ;
LPTSTR lpExeName, ;
PDWORD lpdwSize
returnValue = QueryFullProcessImageName( ;
m.hProcess, ;
m.dwFlags, ;
@m.lpExeName, ;
@m.lpdwSize ;
)
declared = true
catch to exceptionObj when m.exceptionObj.ErrorNo == 1754
catch
assert false
endtry
do case
case m.declared
exit
endcase
endfor
do case
case !m.declared
asser false
endcase
return m.returnValue
endfunc
function GetLastError()
local returnValue
try
declare integer GetLastError IN Win32API
returnValue = GetLastError()
catch
assert false
returnValue = -1
endtry
return m.returnValue
endfunc
Gregory
