OpenEuphoria

1. test if a program is running

• Posted by GeorgeWalters Jul 09, 2009
• 1340 views

I have a program that should not run if another different program is running. Does anyone have a routine to check to see of a program is running? I searched the user contributions but did not find anything I thought I could use or modify.

3. Re: test if a program is running

• Posted by GeorgeWalters Jul 10, 2009
• 1378 views

Sorry, rather stupid to not mention the environment. It's windows and I use win32lib. So what is the win32 api call that I should take a look at?

5. Re: test if a program is running

• Posted by jacques_desch Jul 10, 2009
• 1389 views

sample code tested on windows xp pro sp3 using euphoria 3.1 exwc.exe

-- how to get all running processes names 
without warning 
 
include dll.e 
include machine.e 
include wildcard.e 
 
constant kernel32=open_dll("kernel32.dll") 
constant psapi=open_dll("psapi.dll") 
 
constant iGetLastError=define_c_func(kernel32,"GetLastError",{},C_INT) 
constant iEnumProcesses=define_c_func(psapi,"EnumProcesses",{C_UINT,C_UINT,C_UINT},C_INT) 
constant iGetProcessImageFileName=define_c_func(psapi,"GetProcessImageFileNameA",{C_POINTER,C_POINTER,C_UINT},C_INT) 
constant iOpenProcess=define_c_func(kernel32,"OpenProcess",{C_UINT,C_INT,C_UINT},C_POINTER) 
 
constant PROCESS_QUERY_LIMITED_INFORMATION=#1000 
constant PROCESS_QUERY_INFORMATION=#400 
 
constant BUFFER_SIZE=4096 
 
global function GetAllProcessesNames() 
object fnVal 
atom pBuffer, pCount, pHandle 
integer bCount, try, p 
sequence pids, names 
     
  pCount = allocate(4)  
  -- first get processes ids 
  -- to ensure we get all processes ids we try until count is  
  -- smaller than buffer size. 
  try=1 
  bCount=BUFFER_SIZE 
  while bCount=BUFFER_SIZE do  
    pBuffer = allocate(try*BUFFER_SIZE) 
    poke4(pCount,try*BUFFER_SIZE) 
    fnVal = c_func(iEnumProcesses,{pBuffer,BUFFER_SIZE,pCount}) 
    if not fnVal then 
      free(pBuffer) 
      free(pCount) 
      return -1 
    end if 
    bCount = peek4u(pCount) 
    if bCount = try*BUFFER_SIZE then 
       free(pBuffer) 
       try += 1 
    end if 
  end while 
  free(pCount) 
  pids = peek4u({pBuffer,bCount/4}) 
  free(pBuffer) 
  -- now open each process to get an handle to and query for is name 
  pBuffer=allocate(BUFFER_SIZE) 
  names={} 
  for i = 1 to length(pids) do 
    pHandle=c_func(iOpenProcess,{PROCESS_QUERY_INFORMATION,0,pids[i]})  
    if pHandle then -- query process name 
       fnVal = c_func(iGetProcessImageFileName,{pHandle,pBuffer,BUFFER_SIZE}) 
       if fnVal then 
         names &={peek({pBuffer,fnVal})} 
         p = find(0,names[$]) 
         if p then 
           names[$] = names[$][1..p-1] 
         end if 
       end if 
    end if 
  end for 
  free(pBuffer) 
  free(pCount) 
  return names   
end function 
 
function name_only(sequence fqn) 
integer p 
   p = find('\\',reverse(fqn)) 
   if p then 
     return fqn[length(fqn)-p+2..$] 
   else 
     return fqn 
   end if 
end function 
 
object list 
list= GetAllProcessesNames() 
if sequence(list) then 
  for i = 1 to length(list) do 
     if length(list[i]) then 
       puts(1,name_only(list[i])&"\n") 
     end if 
  end for 
end if 
 

Jacques

7. Re: test if a program is running

• Posted by otterdad Jul 10, 2009
• 1322 views

 
-- allow only one instance of this program 
-- 
-- check for multiple calls - will confuse you by shutting down early 
atom one_already one_already = False 
 
global procedure only_one(atom local_hwnd) 
	object jk atom zCreateSemaphore, zGetLastError, zERROR_ALREADY_EXISTS 
	if one_already then warnErr("calling only one multiple times") end if 
	one_already = True 
 
	zCreateSemaphore = registerw32Function(kernel32,"CreateSemaphoreA", 
    	{C_POINTER,C_INT,C_INT,C_POINTER},C_INT) 
	zGetLastError = registerw32Function(kernel32,"GetLastError",{},C_INT) 
	zERROR_ALREADY_EXISTS = 183 
 
	-- create a semaphore for this instance 
	jk = w32Func(zCreateSemaphore,{NULL, 0, 1,  
    	allocate_string(getText(local_hwnd))}) 
	jk = w32Func(zGetLastError,{}) 
	if jk = zERROR_ALREADY_EXISTS then  
    	abort(0) -- abort if we're already running ! 
	else 
    	--warnErr("good 2 go") 
	end if 
 
	return 
end procedure 
 

no - but the previous EnumProcesses code posted by jacques_desch should work. my code only works if all apps were written in Euphoria.

9. Re: test if a program is running

• Posted by jacques_desch Jul 10, 2009
• 1537 views

-- how to get all running processes names 
without warning 
 
include dll.e 
include machine.e 
include wildcard.e 
 
constant kernel32=open_dll("kernel32.dll") 
constant psapi=open_dll("psapi.dll") 
 
constant iGetLastError=define_c_func(kernel32,"GetLastError",{},C_INT) 
constant iEnumProcesses=define_c_func(psapi,"EnumProcesses",{C_UINT,C_UINT,C_UINT},C_INT) 
constant iGetProcessImageFileName=define_c_func(psapi,"GetProcessImageFileNameA",{C_POINTER,C_POINTER,C_UINT},C_INT) 
constant iOpenProcess=define_c_func(kernel32,"OpenProcess",{C_UINT,C_INT,C_UINT},C_POINTER) 
 
constant PROCESS_QUERY_LIMITED_INFORMATION=#1000 
constant PROCESS_QUERY_INFORMATION=#400 
 
constant BUFFER_SIZE=4096 
 
global function GetAllProcessesNames() 
object fnVal 
atom pBuffer, pCount, pHandle 
integer bCount, try, p 
sequence pids, names 
     
  pCount = allocate(4)  
  -- first get processes ids 
  -- to ensure we get all processes ids we try until count is  
  -- smaller than buffer size. 
  try=1 
  bCount=BUFFER_SIZE 
  while bCount=BUFFER_SIZE do  
    pBuffer = allocate(try*BUFFER_SIZE) 
    poke4(pCount,try*BUFFER_SIZE) 
    fnVal = c_func(iEnumProcesses,{pBuffer,BUFFER_SIZE,pCount}) 
    if not fnVal then 
      free(pBuffer) 
      free(pCount) 
      return -1 
    end if 
    bCount = peek4u(pCount) 
    if bCount = try*BUFFER_SIZE then 
       free(pBuffer) 
       try += 1 
    end if 
  end while 
  free(pCount) 
  pids = peek4u({pBuffer,bCount/4}) 
  free(pBuffer) 
  -- now open each process to get an handle to and query for is name 
  pBuffer=allocate(BUFFER_SIZE) 
  names={} 
  for i = 1 to length(pids) do 
    pHandle=c_func(iOpenProcess,{PROCESS_QUERY_INFORMATION,0,pids[i]})  
    if pHandle then -- query process name 
       fnVal = c_func(iGetProcessImageFileName,{pHandle,pBuffer,BUFFER_SIZE}) 
       if fnVal then 
         names &={peek({pBuffer,fnVal})} 
         p = find(0,names[$]) 
         if p then 
           names[$] = names[$][1..p-1] 
         end if 
       end if 
    end if 
  end for 
  free(pBuffer) 
  free(pCount) 
  return names   
end function 
 
function name_only(sequence fqn) 
integer p 
   p = find('\\',reverse(fqn)) 
   if p then 
     return fqn[length(fqn)-p+2..$] 
   else 
     return fqn 
   end if 
end function 
 
object list 
list= GetAllProcessesNames() 
if sequence(list) then 
  for i = 1 to length(list) do 
     if length(list[i]) then 
       puts(1,name_only(list[i])&"\n") 
     end if 
  end for 
end if 
 

forgot something to the sample code, you should add the following lines.

-- add this binding 
constant iCloseHandle=define_c_proc(kernel32,"CloseHandle",{C_POINTER}) 
-- add this line after the call to GetProcessImageFileName 
c_proc(iCloseHandle,{pHandle}) 

Jacques

11. Re: test if a program is running

• Posted by ChrisB (moderator) Jul 12, 2009
• 1366 views
• Last edited Jul 13, 2009

-- how to get all running processes names 
without warning 
 
include dll.e 
include machine.e 
include wildcard.e 
 
constant kernel32=open_dll("kernel32.dll") 
constant psapi=open_dll("psapi.dll") 
 
constant iGetLastError=define_c_func(kernel32,"GetLastError",{},C_INT) 
constant iEnumProcesses=define_c_func(psapi,"EnumProcesses",{C_UINT,C_UINT,C_UINT},C_INT) 
constant iGetProcessImageFileName=define_c_func(psapi,"GetProcessImageFileNameA",{C_POINTER,C_POINTER,C_UINT},C_INT) 
constant iOpenProcess=define_c_func(kernel32,"OpenProcess",{C_UINT,C_INT,C_UINT},C_POINTER) 
 
constant PROCESS_QUERY_LIMITED_INFORMATION=#1000 
constant PROCESS_QUERY_INFORMATION=#400 
 
constant BUFFER_SIZE=4096 
 
global function GetAllProcessesNames() 
object fnVal 
atom pBuffer, pCount, pHandle 
integer bCount, try, p 
sequence pids, names 
     
  pCount = allocate(4)  
  -- first get processes ids 
  -- to ensure we get all processes ids we try until count is  
  -- smaller than buffer size. 
  try=1 
  bCount=BUFFER_SIZE 
  while bCount=BUFFER_SIZE do  
    pBuffer = allocate(try*BUFFER_SIZE) 
    poke4(pCount,try*BUFFER_SIZE) 
    fnVal = c_func(iEnumProcesses,{pBuffer,BUFFER_SIZE,pCount}) 
    if not fnVal then 
      free(pBuffer) 
      free(pCount) 
      return -1 
    end if 
    bCount = peek4u(pCount) 
    if bCount = try*BUFFER_SIZE then 
       free(pBuffer) 
       try += 1 
    end if 
  end while 
  free(pCount) 
  pids = peek4u({pBuffer,bCount/4}) 
  free(pBuffer) 
  -- now open each process to get an handle to and query for is name 
  pBuffer=allocate(BUFFER_SIZE) 
  names={} 
  for i = 1 to length(pids) do 
    pHandle=c_func(iOpenProcess,{PROCESS_QUERY_INFORMATION,0,pids[i]})  
    if pHandle then -- query process name 
       fnVal = c_func(iGetProcessImageFileName,{pHandle,pBuffer,BUFFER_SIZE}) 
       if fnVal then 
         names &={peek({pBuffer,fnVal})} 
         p = find(0,names[$]) 
         if p then 
           names[$] = names[$][1..p-1] 
         end if 
       end if 
    end if 
  end for 
  free(pBuffer) 
  free(pCount) 
  return names   
end function 
 
function name_only(sequence fqn) 
integer p 
   p = find('\\',reverse(fqn)) 
   if p then 
     return fqn[length(fqn)-p+2..$] 
   else 
     return fqn 
   end if 
end function 
 
object list 
list= GetAllProcessesNames() 
if sequence(list) then 
  for i = 1 to length(list) do 
     if length(list[i]) then 
       puts(1,name_only(list[i])&"\n") 
     end if 
  end for 
end if 
 

genius. Works with eu4 too

Chris

13. Re: test if a program is running

• Posted by GeorgeWalters Jul 13, 2009
• 1342 views

This is where it crashes in message_box

ret = c_func(msgbox_id, {c_func(get_active_id, {}), text_ptr, title_ptr, or_style})

15. Re: test if a program is running

• Posted by gbonvehi Jul 13, 2009
• 1363 views

Just a shot since I don´t have any sources right now, try giving a sequence with length > 0 as the title parameter, like "test".

17. Re: test if a program is running

• Posted by ChrisB (moderator) Jul 15, 2009
• 1330 views

Hi

I used the above get processes code as an include, and wrote a small program

--  code generated by Win32Lib IDE v1.0.4 Build July-06-2008 
 
constant TheProgramType="exw"  
  
include Win32Lib.ew 
without warning 
include processes.ex 
 
-------------------------------------------------------------------------------- 
--  Window Window1 
constant Window1 = createEx( Window, "Window1", 0, Default, Default, 400, 300, 0, 0 ) 
constant List2 = createEx( List, "List2", Window1, 12, 16, 356, 204, 0, 0 ) 
constant PushButton3 = createEx( PushButton, "Show processess", Window1, 12, 228, 108, 28, 0, 0 ) 
--------------------------------------------------------- 
-------------------------------------------------------------------------------- 
procedure PushButton3_onClick (integer self, integer event, sequence params)--params is () 
object proclist, void 
 
proclist= GetAllProcessesNames() 
if sequence(proclist) then 
  for i = 1 to length(proclist) do 
     if length(proclist[i]) then 
 
       --puts(1,name_only(proclist[i])&"\n") 
       addItem(List2, name_only(proclist[i])) 
     end if 
  end for 
  void = message_box("Items added", "", 0) 
end if 
 
 
end procedure 
setHandler( PushButton3, w32HClick, routine_id("PushButton3_onClick")) 
--------------------------------------------------------- 
 
 
WinMain( Window1,Normal ) 
 

And it did not crash. (Note, I exported name_only from the include too)

I'm using eu4 latest, win32lib 0704 (last unmodified package, not yet been updated)

Incidentally, remove the void = from in front of message_box, and the interpreter complains about expecting a procedure, not a function. (should be expecting a function, not a procedure, but I thought this behaviour had been squashed anyway. Strange)

Chris

19. Re: test if a program is running

• Posted by ChrisB (moderator) Jul 15, 2009
• 1286 views

Yup, looks like I'm behind again.

Chris

21. Re: test if a program is running

• Posted by mattlewis (admin) Jul 15, 2009
• 1288 views

This is probably the easiest place:

http://jeremy.cowgar.com/eubins/

However, it appears that only linux is up to date right now.

Matt

23. Re: test if a program is running

• Posted by ChrisB (moderator) Jul 15, 2009
• 1315 views

Hi

Yes, that's interesting, 3rd time for me too, here's the crash output

 
C:\EUPHORIA\include\msgbox.e:92 in function message_box() 
A machine-level exception occurred during execution of this statement 
 
... called from C:\EUPHORIA\000_Projects\Tests\ShowProcesses.exw:28 in procedure 
 PushButton3_onClick() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:3920 in function in 
vokeHandler() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:21608 in procedure 
wmCommand() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:22880 in function f 
DoCommand() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24413 in function M 
essageProcessor() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24464 in function W 
ndProc() 
 
^^^ call-back from Windows 
 
... called from C:\EUPHORIA\win32lib0704\include\w32dll.ew:209 in function w32Fu 
nc() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24324 in function D 
efProcessing() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24422 in function M 
essageProcessor() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24470 in function S 
ubProc() 
 
^^^ call-back from Windows 
 
... called from C:\EUPHORIA\win32lib0704\include\w32dll.ew:280 in procedure w32P 
roc() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24964 in procedure 
eventLoop() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:25192 in procedure 
WinMain() 
 
... called from C:\EUPHORIA\000_Projects\Tests\ShowProcesses.exw:37 
 
--> See ex.err 
 
 
Press Enter... 
 
 

Then, to line 28 of the above program, add "Message", like

  void = message_box("Items added", "Message", 0) 

Then it takes 5 clicks, and its on the show process button, not the message button.

Here's the output now

 
C:\EUPHORIA\include\misc.e:36 in function reverse() 
A machine-level exception occurred during execution of this statement 
 
... called from C:\EUPHORIA\000_Projects\Tests\processes.ex:79 in function name_ 
only() 
 
... called from C:\EUPHORIA\000_Projects\Tests\ShowProcesses.exw:25 in procedure 
 PushButton3_onClick() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:3920 in function in 
vokeHandler() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:21608 in procedure 
wmCommand() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:22880 in function f 
DoCommand() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24413 in function M 
essageProcessor() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24464 in function W 
ndProc() 
 
^^^ call-back from Windows 
 
... called from C:\EUPHORIA\win32lib0704\include\w32dll.ew:209 in function w32Fu 
nc() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24324 in function D 
efProcessing() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24422 in function M 
essageProcessor() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24470 in function S 
ubProc() 
 
^^^ call-back from Windows 
 
... called from C:\EUPHORIA\win32lib0704\include\w32dll.ew:280 in procedure w32P 
roc() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:24964 in procedure 
eventLoop() 
 
... called from C:\EUPHORIA\win32lib0704\include\Win32Lib.ew:25192 in procedure 
WinMain() 
 
... called from C:\EUPHORIA\000_Projects\Tests\ShowProcesses.exw:37 
 
--> See ex.err 
 
 
Press Enter... 
 

Think theres a memory leak corruption problem introduced somewhere, possibly by getallprocess() ?

Chris

25. Re: test if a program is running

• Posted by gbonvehi Jul 16, 2009
• 1356 views

Well, the code is not calling CloseHandle, maybe you could try adding it to see if it helps.
CloseHandle: http://msdn.microsoft.com/en-us/library/ms724211(VS.85).aspx
Microsoft´s Example of getting process info: http://msdn.microsoft.com/en-us/library/ms686701(VS.85).aspx

Cheers,
Guillermo

27. Re: test if a program is running

• Posted by GeorgeWalters Jul 16, 2009
• 1319 views

You had actually added this in your previous post and I included it in the test rtn. Here's a code snippit.

  for i = 1 to length(pids) do  
    pHandle=c_func(iOpenProcess,{PROCESS_QUERY_INFORMATION,0,pids[i]})   
    if pHandle then -- query process name  
       fnVal = c_func(iGetProcessImageFileName,{pHandle,pBuffer,BUFFER_SIZE})  
       c_proc(iCloseHandle,{pHandle})  
       if fnVal then  
         names &={peek({pBuffer,fnVal})}  
         p = find(0,names[length(names)])  
         if p then  
           names[length(names)] = names[length(names)][1..p-1]  
         end if  
       end if  
    end if  
  end for  

However mine still crashes on the 3rd time. Any more ideas?

29. Re: test if a program is running

• Posted by mattlewis (admin) Jul 16, 2009
• 1282 views

The problem is at the end of GetAllProcessNames(). There is a call to free(pCount), but that pointer was already freed.

Matt

31. Re: test if a program is running

• Posted by ChrisB (moderator) Jul 16, 2009
• 1334 views

Yes, thanks, thats a useful include there.

Chris