! Sample demonstrating how to emulate the ! "Press any key to continue" feature of ! Developer Studio when running console ! programs. Build as a console application. ! ! At program start, call function ! press_anykey. The function tests to see ! how the program was activated. If this was ! the "parent", then it spawns itself as a ! "child", waits for it to finish, then prompts ! the user to press a key and returns .true.. If ! it detects that it is the child process, it ! returns .false. which tells the main program to ! go about its business. ! ! Updated November 2016 to use COMMAND_ARGUMENT_COUNT ! and pass NULL for omitted arguments to CreateProcess. ! program stall if (press_anykey()) goto 99999 do i=1,10 write (*,*) i end do 99999 continue contains ! Function press_anykey ! ! See header above for function description ! logical function press_anykey () use kernel32 use ifcore, only: getcharqq implicit none character*(MAX_PATH) path type (T_STARTUPINFO) :: StartupInfo type (T_PROCESS_INFORMATION) :: ProcessInfo integer ret, path_len character*1 cret press_anykey = .false. ! Any arguments specified? If so, assume that we got ! spawned by the code below and return to the caller. ! Feel free to use a more sophisticated test if you ! like (such as testing for a particular switch.) ! if (COMMAND_ARGUMENT_COUNT() > 0) return ! Get path to this exe ! path_len = GetModuleFileName (NULL, path, & len(path)) ! Initialize StartupInfo - we won't use any of its fields ! StartupInfo = T_STARTUPINFO(SIZEOF(StartupInfo),& 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) ! Create a new process to run this executable, passing the ! complete executable path and a "-child" switch ! as the command line (anything that has two or more tokens), ! and specifying that it should inherit the handles ! (including console) of this process. ! ret = CreateProcess (NULL, & ! Application Name '"'//path(1:path_len)//'" -child'C, & ! Command line NULL, & NULL, & TRUE, & ! InheritHandles 0, & ! CreationFlags NULL, & ! Environment variables NULL, & ! Current directory StartupInfo, & ProcessInfo) if (ret == 0) then ret = GetLastError () write (*,'(A,I0)') "Create process failed with error ",ret else ! CreateProcess succeeded. Wait for the process to finish ! ret = WaitForSingleObject (ProcessInfo%hProcess, INFINITE) ! Close handles, otherwise resources are lost ! ret = CloseHandle (ProcessInfo%hThread) ret = CloseHandle (ProcessInfo%hProcess) end if ! Prompt the user to press any key ! write (*,'(A)', advance="no") "Press any key to exit" cret = getcharqq () press_anykey = .TRUE. return end function press_anykey end program stall