! Copyright (C) 2001 by Fortran Library ! ! This source may be freely copied, modified, or distributed so long as the original ! copyright statement remains intact. ! ! Suggestions for improvment to the original posted version are welcome. Comments ! should be sent to mailto:webmaster@fortranlib.com ! ! Version: 2.0, 4 August 2001, 21:20:00 ! ! Purpose: OS Command line interface utility with immediate return or wait specified ! in milliseconds (routine automatically quotes the command string) ! ! System Requirements: Written for Digital/Compaq/Intel) Visual Fortran (x86) ! ! Routine Name: OSCall ! ! iWaitMS: default 32-bit (unsigned) integer wait value in milliseconds ! 0 = do not wait for completion ! >0 = Number of milliseconds to wait for completion of initiated process ! -1 = Infinite wait (wait for process completion) ! ! Command: character command string ! ! Args: optional character argument list string ! ! iRet: default integer return code ! -1 = Unable to initiate process ! 0 = Successful process initiate (if iWait = 0) ! 1 = Successful process initiate (Process terminated normally prior to wait period) ! 2 = Successful process initiate (Wait timeout occurred prior to process termination) ! 3 = Successful process initiate (Wait abandoned (unreleased mutex object)) ! 4 = Successful process initiate (Wait failed) ! subroutine OSCall(iWaitMS,Command,Args,iRet) use dflib use dfwin use dfwinty implicit none character(*), intent(in) :: Command !Command portion of the command line (i.e. the program name) character(*), intent(in) :: Args !Argument portion of the command line character(256) :: CmdLine !Work area for the command line integer, intent(in) :: iWaitMS !Process completion wait value in milliseconds integer, intent(out) :: iRet !Main return code integer :: iWRC !Return code for WaitForSingleObject integer :: iCRC !Return code for CreateProcess type (T_StartupInfo) :: StartInfo !CreatProcess parms type (T_Process_Information) :: ProcInfo !CreatProcess parms (created process info) ! ! Initialize return code ! iRet = 0 ! ! Insure console window is suppressed ! StartInfo%cb = 68 StartInfo%lpReserved = 0 StartInfo%lpDesktop = NULL StartInfo%lpTitle = NULL StartInfo%dwX = 0 StartInfo%dwY = 0 StartInfo%dwXSize = 0 StartInfo%dwYSize = 0 StartInfo%dwXCountChars = 0 StartInfo%dwYCountChars = 0 StartInfo%dwFillAttribute = 0 StartInfo%dwFlags = StartF_UseShowWindow StartInfo%wShowWindow = SW_HIDE StartInfo%cbReserved2 = 0 StartInfo%lpReserved2 = NULL ! ! Prepare the command line string and arguments ! cmdLine = '"' // trim(command) // '" ' // args // char(0) ! ! Initiate process ! iCRC = CreateProcess(null_character, & cmdLine, & null_Security_Attributes, & null_Security_Attributes, & .false., & Null, & Null, & Null_Character, & StartInfo, & ProcInfo) ! ! Check return code from CreateProcess ! if (iCRC .eq. 0) then !Nonzero means success (i.e. the process id) iRet = -1 return end if ! ! If user specified to wait ! if (iWaitMS .ne. 0) then iWRC = WaitForSingleObject(ProcInfo%hProcess,iWaitMS) !Wait for completion if (iWRC .eq. Wait_Failed) iRet = 4 !Wait failed if (iWRC .eq. Wait_Abandoned) iRet = 3 !Timeout abandoned if (iWRC .eq. Wait_Timeout) iRet = 2 !Timeout occurred if (iWRC .eq. Wait_Object_0) iRet = 1 !Normal termination (signaled) end if return end subroutine