HOW TO USE EnumProcesses (psapi) IN LB?

[Fabio Siciliano]

Hi folks,

To enumerate processes in almost all Windows versions I first take a system snapshot by calling "CreateToolhelp32Snapshot" (kernel32) and then browse them by calling "Process32First" (kernel32) out of a loop and "Process32Next" (kernel32) in loop and, finally "CloseHandle" (kernel32) to free the system snapshot.

Sadly enough, this method is not available in Windows NT, because the "CreateToolhelp32Snapshot" function is missing in that Windows version.

So, to enumerate processes in Windows NT I must call the "EnumProcesses" (psapi) function which, BTW, is also available in Windows 10.

The very bad news is that the first required parameter of that function is a preallocated array (to receive the list of PIDs) and, so far, I was completely unable to make it work.

Here you can find a list of WEB articles I read to find a solution.

API replacement for 'CreateToolhelp32Snapshot' in Win NT
www.vbforums.com/showthread.php?201134-API-replacement-for-CreateToolhelp32Snapshot-in-Win-NT

Enhancing Liberty Basic [Array Handling] (AKA: The memory Article) by Dennis McKinney ([e-mail])
www.libertybasicuniversity.com/lbnews/nl99/3.htm

Enumerate Processes
www.delphibasics.info/home/delphibasicssnippets/enumerateprocesses

EnumProcesses function (psapi.h)
docs.microsoft.com/en-us/windows/win32/api/psapi/nf-psapi-enumprocesses

Enumerating All Processes
docs.microsoft.com/en-us/windows/win32/psapi/enumerating-all-processes

How To Enumerate Applications Using Win32 APIs
programtip.com/en/art-135708

And here below you can find my sample program using the "EnumProcesses" (psapi) function.

Obviously it does not work: "EnumProcesses" (psapi) returns ZERO and then "GetLastError" (kernel32) returns 998 (invalid address memory location).

'** myEnumProcesses4WinNT by Fabio Siciliano, 19/11/2020
'** Last update: 19/11/2020

'** character constants
   global nul$, ht$, lf$, cr$, cr2$, dq$, bullet$, ul$, nl$, nl2$, eol$, indent$, yuml$

'** character constants settings
   nul$ = chr$(0) : ht$ = chr$(9) : lf$ = chr$(10) : cr$ = chr$(13) : cr2$ = cr$; cr$ : dq$ = chr$(34) : bullet$ = chr$(149) : yuml$ = chr$(255)
   ul$ = space$(5); bullet$; space$(3) : nl$ = cr$; lf$ : nl2$ = nl$; nl$ : eol$ = space$(9) : indent$ = space$(7)

'** general globals
   global myApp$, myAppName$, caption$ : caption$ = "myEnumProcesses4WinNT 1.0"; cr$ : titlebar$ = trim$(caption$)

'** EnumProcesses (psapi)
'    struct lpidProcess, pidProcess as ulong
'    struct lpcbNeeded, cbNeeded as ulong

'** FormatMessageA (kernel32)
   struct lpSource, lpSource   as long
   struct Arguments, Arguments as long

'** PID element
   struct sPID, PID as ulong

   elements = 255 : dim structArray(elements)
[retry]
   redim structArray(elements)

   sizeofsPID = len(sPID.struct)
   memBlockSize = (elements + 1) * sizeofsPID
   hSArray = GlobalAlloc(_GMEM_MOVEABLE, memBlockSize)
   ptrSarray = GlobalLock(hSArray)

   for i = 0 to elements
       dest = ptrSarray + (i * sizeofsPID)
       calldll #kernel32, "RtlMoveMemory", dest as long, sPID as ptr, sizeofsPID as long, ret as void
       structArray(i) = dest
   next i

   lpidProcess = ptrSarray
   cb = memBlockSize

print "*** TEST - BEGIN ***"
print
print "EnumProcesses", "lpidProcess", "cb", "lpcbNeeded"

   open "psapi.dll" for dll as #psapi

   calldll #psapi, "EnumProcesses", lpidProcess as ulong, cb as ulong, lpcbNeeded as ulong, r as long

   if r then
      if lpcbNeeded.cbNeeded.struct = cb then elements = elements + 1 : goto [retry]
print r,, lpidProcess, cb, lpcbNeeded
   else
      calldll #kernel32, "GetLastError", rc as long
      r$ = "EnumProcesses (kernel32) = "; rc
      notice caption$; formatMessage$(r$, rc)
print r,, lpidProcess, cb, lpcbNeeded
      goto [exit]
   end if

print
print "PID", "index", "value"

   for i = 0 to elements
       print "PID "; i, structArray(i)
   next i

[exit]

print
print "*** TEST -  END  ***"

   close #psapi
   ret = GlobalFree(hSArray)
   end

   [formatMessage]

function formatMessage$(source$, rc)

   dwFlags = _FORMAT_MESSAGE_FROM_SYSTEM or _FORMAT_MESSAGE_ALLOCATE_BUFFER

   dwMessageId = rc

   calldll #kernel32, "FormatMessageA", _
       dwFlags      as long,            _
       lpSource     as struct,          _
       dwMessageId  as long,            _
       dwLanguageId as long,            _
       lpBuffer$    as ptr,             _
       nSize        as long,            _
       Arguments    as struct,          _
       r            as long

   dwFlags = _FORMAT_MESSAGE_FROM_SYSTEM

   nSize = r + 1
   lpBuffer$ = space$(nSize) + nul$

   calldll #kernel32, "FormatMessageA", _
       dwFlags      as long,            _
       lpSource     as struct,          _
       dwMessageId  as long,            _
       dwLanguageId as long,            _
       lpBuffer$    as ptr,             _
       nSize        as long,            _
       Arguments    as struct,          _
       r            as long

   if r then
      formatMessage$ = source$; cr2$; trim$(lpBuffer$)
   else
      formatMessage$ = translate$("No further info is available"); "."
   end if

   lpBuffer$ = ""

end function

   [GlobalAlloc]

function GlobalAlloc(type, dwBytes)
   calldll #kernel32, "GlobalAlloc", type as long, dwBytes as ulong, GlobalAlloc as long
end function

   [GlobalFree]

function GlobalFree(hMem)
   calldll #kernel32, "GlobalFree", hMem as ulong, GlobalFree as long
end function

   [GlobalLock]

function GlobalLock(hMem)
   calldll #kernel32, "GlobalLock", hMem as long, GlobalLock as long
end function

   [translate]

function translate$(text$)
   translate$ = text$
end function


Any idea?

Thank you in advance,
Fabio

[Chris Iverson]

You actually have (almost) working code there, you just commented it out.

lpcbNeeded needs to be a pointer to a DWORD/ULONG, and the only way to do that in LB is as a struct. You've already made a struct for that, but you commented that out.

Uncomment that, change the entry for lpcbNeeded in the DLL call to "as struct", and the code runs.


Now, it doesn't actually list PIDs, because you're reading the block of memory at the wrong point, and you're reading the wrong data into the array anyway. The data you're storing into the array is all the memory addresses, not what's pointed at in those memory addresses(i.e. the PIDs).


Try adding this after you've made the EnumProcesses call, but before you try printing out the array.

for x = 0 to elements
   src = ptrSarray + (x * sizeofsPID)
   calldll #kernel32, "RtlMoveMemory", sPID as struct, src as ulong, sizeofsPID as ulong, ret as void
   structArray(x) = sPID.PID.struct
next x

[Fabio Siciliano]

Hi Chris,

Thank you once more time! Obviously it works... after reading your message I realized I commented the two structs lpidProcess and lpcbNeeded out because they led my program to General Protection Fault, so then I tried to replace BOTH structs by ulong variables WITHOUT giving a try to the combination lpidProcess (ulong) + lpcbNeeded (struct).

Here below the full working version.

Bye,
Fabio

'** myEnumProcesses4WinNT by Fabio Siciliano and Chris Iverson, 20/11/2020
'** Last update: 20/11/2020

'** character constants
   global nul$, ht$, lf$, cr$, cr2$, dq$, bullet$, ul$, nl$, nl2$, eol$, indent$, yuml$

'** character constants settings
   nul$ = chr$(0) : ht$ = chr$(9) : lf$ = chr$(10) : cr$ = chr$(13) : cr2$ = cr$; cr$ : dq$ = chr$(34) : bullet$ = chr$(149) : yuml$ = chr$(255)
   ul$ = space$(5); bullet$; space$(3) : nl$ = cr$; lf$ : nl2$ = nl$; nl$ : eol$ = space$(9) : indent$ = space$(7)

'** general globals
   global myApp$, myAppName$, caption$ : caption$ = "myEnumProcesses4WinNT 1.0"; cr$ : titlebar$ = trim$(caption$)

'** EnumProcesses (psapi)
   struct lpcbNeeded, cbNeeded as ulong

'** FormatMessageA (kernel32)
   struct lpSource, lpSource   as long
   struct Arguments, Arguments as long

'** PID element
   struct sPID, PID as ulong

   elements = 255 : dim structArray(elements)
[retry]
   redim structArray(elements)

   sizeofsPID = len(sPID.struct)
   memBlockSize = (elements + 1) * sizeofsPID
   hSArray = GlobalAlloc(_GMEM_MOVEABLE, memBlockSize)
   ptrSarray = GlobalLock(hSArray)

   for i = 0 to elements
       dest = ptrSarray + (i * sizeofsPID)
       calldll #kernel32, "RtlMoveMemory", dest as long, sPID as ptr, sizeofsPID as long, ret as void
       structArray(i) = dest
   next i

   lpidProcess = ptrSarray
   cb = memBlockSize

print "*** TEST - BEGIN ***"
print
print "EnumProcesses", "lpidProcess", "cb", "lpcbNeeded"

   open "psapi.dll" for dll as #psapi

   calldll #psapi, "EnumProcesses", lpidProcess as ulong, cb as ulong, lpcbNeeded as struct, r as long

   if r then
      if lpcbNeeded.cbNeeded.struct = cb then elements = elements + 1 : goto [retry]
print r,, lpidProcess, cb, lpcbNeeded.cbNeeded.struct
   else
      calldll #kernel32, "GetLastError", rc as long
      r$ = "EnumProcesses (kernel32) = "; rc
      notice caption$; formatMessage$(r$, rc)
      goto [exit]
   end if

print
print "#", "PID"

   for x = 0 to elements
       src = ptrSarray + (x * sizeofsPID)
       calldll #kernel32, "RtlMoveMemory", sPID as struct, src as ulong, sizeofsPID as ulong, ret as void
       structArray(x) = sPID.PID.struct
if structArray(x) then print x, structArray(x)
   next x

[exit]

print
print "*** TEST -  END  ***"

   close #psapi
   ret = GlobalFree(hSArray)
   end

   [formatMessage]

function formatMessage$(source$, rc)

   dwFlags = _FORMAT_MESSAGE_FROM_SYSTEM or _FORMAT_MESSAGE_ALLOCATE_BUFFER

   dwMessageId = rc

   calldll #kernel32, "FormatMessageA", _
       dwFlags      as long,            _
       lpSource     as struct,          _
       dwMessageId  as long,            _
       dwLanguageId as long,            _
       lpBuffer$    as ptr,             _
       nSize        as long,            _
       Arguments    as struct,          _
       r            as long

   dwFlags = _FORMAT_MESSAGE_FROM_SYSTEM

   nSize = r + 1
   lpBuffer$ = space$(nSize) + nul$

   calldll #kernel32, "FormatMessageA", _
       dwFlags      as long,            _
       lpSource     as struct,          _
       dwMessageId  as long,            _
       dwLanguageId as long,            _
       lpBuffer$    as ptr,             _
       nSize        as long,            _
       Arguments    as struct,          _
       r            as long

   if r then
      formatMessage$ = source$; cr2$; trim$(lpBuffer$)
   else
      formatMessage$ = translate$("No further info is available"); "."
   end if

   lpBuffer$ = ""

end function

   [GlobalAlloc]

function GlobalAlloc(type, dwBytes)
   calldll #kernel32, "GlobalAlloc", type as long, dwBytes as ulong, GlobalAlloc as long
end function

   [GlobalFree]

function GlobalFree(hMem)
   calldll #kernel32, "GlobalFree", hMem as ulong, GlobalFree as long
end function

   [GlobalLock]

function GlobalLock(hMem)
   calldll #kernel32, "GlobalLock", hMem as long, GlobalLock as long
end function

   [translate]

function translate$(text$)
   translate$ = text$
end function


[Fabio Siciliano]

Hi folks,

Just in case somebody should find it useful, here below you can find a version of the above program enriched with the process names (notice: being targeted for Windows NT, it does not return 64 bit processes, so that if you run it on a 64 bit Windows version, then you'll get a list of 32 bit processes only).

Hope you will enjoy it.

Bye,
Fabio

'** enumWinNTProcesses by Fabio Siciliano and Chris Iverson, 20/11/2020
'** Last update: 20/11/2020

'** character constants
   global nul$, ht$, lf$, cr$, cr2$, dq$, bullet$, ul$, nl$, nl2$, eol$, indent$, yuml$

'** character constants settings
   nul$ = chr$(0) : ht$ = chr$(9) : lf$ = chr$(10) : cr$ = chr$(13) : cr2$ = cr$; cr$ : dq$ = chr$(34) : bullet$ = chr$(149) : yuml$ = chr$(255)
   ul$ = space$(5); bullet$; space$(3) : nl$ = cr$; lf$ : nl2$ = nl$; nl$ : eol$ = space$(9) : indent$ = space$(7)

'** general globals
   global myApp$, myAppName$, caption$ : caption$ = "enumWinNTProcesses 1.0"; cr$ : titlebar trim$(caption$)

'** EnumProcesses, EnumProcessModules (psapi)
   struct lpcbNeeded, cbNeeded as ulong

'** EnumProcessModules (psapi)
   struct lphModule, hModule as ulong

'** FormatMessageA (kernel32)
   struct lpSource, lpSource   as long
   struct Arguments, Arguments as long

'** PID element
   struct sPID, PID as ulong

'** main code
   call enumWinNTProcesses

   wait ' notice: "end" forces titlebar text to be overwritten by the "Execution of: [full path program name] complete." message!

   [enumWinNTProcesses]

sub enumWinNTProcesses ' BEWARE: it does NOT return 64 bit processess!

   processes = 255 : dim processes(processes)
[retry]
   if retry then redim processes(processes)

   sizeofsPID = len(sPID.struct)
   memBlockSize = (processes + 1) * sizeofsPID
   hSArray = GlobalAlloc(_GMEM_MOVEABLE, memBlockSize)
   ptrSarray = GlobalLock(hSArray)

   for i = 0 to processes
       dest = ptrSarray + (i * sizeofsPID)
       calldll #kernel32, "RtlMoveMemory", dest as long, sPID as ptr, sizeofsPID as long, ret as void
       processes(i) = dest
   next i

   lpidProcess = ptrSarray
   cb = memBlockSize

print "*** TEST - BEGIN ***"
print
print "EnumProcesses", "lpidProcess", "cb", "lpcbNeeded"

   open "psapi.dll" for dll as #psapi

   retry = EnumProcesses(ptrSarray, memBlockSize) : if retry then processes = processes + 1 : goto [retry]

print
print "#", "PID", "hProcess", "hModule", "Name"
print "------------------------------------------------------------------------------"

   for x = 0 to processes
       src = ptrSarray + (x * sizeofsPID)
       calldll #kernel32, "RtlMoveMemory", sPID as struct, src as ulong, sizeofsPID as ulong, ret as void
       processes(x) = sPID.PID.struct

if sPID.PID.struct then
  PROCESS.QUERY.INFORMATION = hexdec("400") : PROCESS.VM.READ = hexdec("10") : dwDesiredAccess = PROCESS.QUERY.INFORMATION or PROCESS.VM.READ
  hProcess = 0 : hModule = 0 : moduleBaseName$ = ""
  hProcess = OpenProcess(dwDesiredAccess, 0, sPID.PID.struct)
  if hProcess then hModule = EnumProcessModules(hProcess)
  if hModule then ' if hModule = 0 then is a 64 bit process (n/a in Windows NT)
     moduleBaseName$ = getModuleBaseName$(hProcess, hModule)
     print x, processes(x), hProcess, hModule, moduleBaseName$
  end if
end if

   next x

print "------------------------------------------------------------------------------"
print
print "*** TEST -  END  ***"

   close #psapi

   ret = GlobalFree(hSArray)

end sub

   [EnumProcesses]

function EnumProcesses(lpidProcess, cb)

   calldll #psapi, "EnumProcesses", lpidProcess as ulong, cb as ulong, lpcbNeeded as struct, r as long

   if r then
      if lpcbNeeded.cbNeeded.struct = cb then
         EnumProcesses = 1
      else
print r,, lpidProcess, cb, lpcbNeeded.cbNeeded.struct
      end if
   else
      calldll #kernel32, "GetLastError", rc as long
      r$ = "EnumProcesses (kernel32) = "; rc
      notice caption$; formatMessage$(r$, rc)
   end if

end function

   [EnumProcessModules]

function EnumProcessModules(hProcess)

   ERROR.PARTIAL.COPY = 299

   cb = len(lphModule.struct)

   calldll #psapi, "EnumProcessModules", hProcess as ulong, lphModule as struct, cb as ulong, lpcbNeeded as struct, r as long

   if r then
      EnumProcessModules = lphModule.hModule.struct
   else
      calldll #kernel32, "GetLastError", rc as long
      if rc <> ERROR.PARTIAL.COPY then ' returned for 64 bit processes (cannot happen on Windows NT)
         r$ = "EnumProcessModules (kernel32) = "; rc
         notice caption$; formatMessage$(r$, rc)
      end if
   end if

end function

   [getModuleBaseName]

function getModuleBaseName$(hProcess, hModule)

   nSize = _MAX_PATH : lpBaseName$ = space$(nSize)

   calldll #psapi, "GetModuleBaseNameA", hProcess as ulong, hModule as ulong, lpBaseName$ as ptr, nSize as ulong, r as ulong

   if r then
      getModuleBaseName$ = trim$(lpBaseName$)
   else
      calldll #kernel32, "GetLastError", rc as long
      r$ = "GetModuleBaseName (kernel32) = "; rc
      notice caption$; formatMessage$(r$, rc)
   end if

end function

   [formatMessage]

function formatMessage$(source$, rc)

   dwFlags = _FORMAT_MESSAGE_FROM_SYSTEM or _FORMAT_MESSAGE_ALLOCATE_BUFFER

   dwMessageId = rc

   calldll #kernel32, "FormatMessageA", _
       dwFlags      as long,            _
       lpSource     as struct,          _
       dwMessageId  as long,            _
       dwLanguageId as long,            _
       lpBuffer$    as ptr,             _
       nSize        as long,            _
       Arguments    as struct,          _
       r            as long

   dwFlags = _FORMAT_MESSAGE_FROM_SYSTEM

   nSize = r + 1
   lpBuffer$ = space$(nSize) + nul$

   calldll #kernel32, "FormatMessageA", _
       dwFlags      as long,            _
       lpSource     as struct,          _
       dwMessageId  as long,            _
       dwLanguageId as long,            _
       lpBuffer$    as ptr,             _
       nSize        as long,            _
       Arguments    as struct,          _
       r            as long

   if r then
      formatMessage$ = source$; cr2$; trim$(lpBuffer$)
   else
      formatMessage$ = translate$("No further info is available"); "."
   end if

   lpBuffer$ = ""

end function

   [GlobalAlloc]

function GlobalAlloc(type, dwBytes)
   calldll #kernel32, "GlobalAlloc", type as long, dwBytes as ulong, GlobalAlloc as long
end function

   [GlobalFree]

function GlobalFree(hMem)
   calldll #kernel32, "GlobalFree", hMem as ulong, GlobalFree as long
end function

   [GlobalLock]

function GlobalLock(hMem)
   calldll #kernel32, "GlobalLock", hMem as long, GlobalLock as long
end function

   [OpenProcess]

function OpenProcess(dwDesiredAccess, bInheritHandle, dwProcessId)

   calldll #kernel32, "OpenProcess", dwDesiredAccess as ulong, bInheritHandle as long, dwProcessId as ulong, r as ulong

   if r then
      OpenProcess = r
   else
      calldll #kernel32, "GetLastError", r as long
      if r <> 5 then ' 5 = Access is Denied
         r$ = "OpenProcess (kernel32) = "; r
         notice caption$; formatMessage$(r$, r)
      end if
   end if

end function

   [translate]

function translate$(text$)
   translate$ = text$
end function