!==================================================================================
! Класс управляемого запуска внешней программы.
! Вячеслав Черников, г.Рязань, 2015г.
!==================================================================================

                     MEMBER

   INCLUDE('FsProcess.INC')
   INCLUDE('WINEQU.INC')

   MAP
     INCLUDE('BUILTINS.CLW'),ONCE   !функции RTL

     MODULE('WINAPI')
       CreateProcess      (LONG,LONG,LONG,LONG,BOOL,DWORD,LONG,LONG,LONG,LONG),BOOL,RAW,PASCAL,NAME('CreateProcessA')
       GetExitCodeProcess (LONG, LONG),BOOL,RAW,PASCAL
       FormatMessage      (DWORD,ULONG,DWORD,DWORD,*CSTRING,DWORD,long),DWORD,PASCAL,RAW,NAME('FormatMessageA')
       GetLastError       (),LONG,PASCAL 

       GetWindowThreadProcessId(ulong,*ulong),long,pascal,raw
       TerminateProcess(long hProcess, long uExitCode),bool,pascal
       GetExitCodeProcess(long hProcess, *long lpExitCode),bool,pascal,proc
       OpenProcess(ulong dwDesiredAccess, bool bInheritHandle, ulong dwProcessId),ulong,pascal

       CreateFile(*CSTRING,ULONG,ULONG,LONG,ULONG,ULONG,UNSIGNED=0),UNSIGNED,RAW,PASCAL,NAME('CreateFileA')
       GetFileSize(UNSIGNED,*ULONG),ULONG,PASCAL,NAME('GetFileSize')
       ReadFile(UNSIGNED,LONG,ULONG,*ULONG,LONG),BOOL,PASCAL,RAW,NAME('ReadFile')
       WriteFile(UNSIGNED,<*?>,ULONG,*ULONG,<*?>),BOOL,PASCAL,RAW,PROC
       CloseHandle(UNSIGNED),BOOL,PASCAL,PROC,NAME('CloseHandle')

       ShellExecute(UNSIGNED,*CSTRING,*CSTRING,*CSTRING,*CSTRING,SIGNED),UNSIGNED,PASCAL,RAW,PROC,NAME('ShellExecuteA')
     END

   END

PROCESS_TERMINATE         equate(01h)
PROCESS_QUERY_INFORMATION equate(0400h)
FILE_ATTRIBUTE_NORMAL     equate(00000080H)

!===================================================================================
!
! Запустить процесс
!
FsProcess.StartProcess FUNCTION (STRING pName, STRING pTitle, LONG pTime, BYTE pEnd)

loc:ok       byte
loc:prgName  &cstring
loc:error    ulong  
loc:errorTxt cstring(1024)

loc:Progress  long
Loc:Time      long

Window WINDOW('Выполнение...'),AT(,,170,41),FONT(,8,,FONT:regular,CHARSET:ANSI),CENTER,IMM,CENTERED,GRAY, |
         DOUBLE,MASK,MDI
       PROGRESS,USE(loc:Progress),AT(6,8,158,8),RANGE(0,100)
       STRING('Врем<255>, сек:'),AT(6,24),USE(?Time:Prompt),FONT(,8,,FONT:regular,CHARSET:ANSI)
       STRING(@s10),AT(47,24,44,10),USE(Loc:Time),FONT(,8,,FONT:regular,CHARSET:ANSI)
       BUTTON('Прервать'),AT(119,21,45,14),USE(?Close),DISABLE,FONT(,8,,FONT:regular,CHARSET:ANSI)
     END

   CODE
      
   if pName=''
      return(0)
   end  

   loc:prgName &= new(cstring(len(clip(pName))+1))

   loc:prgName = clip(pName)
   loc:ok=1

   SELF.StartUpInfo.cb = size(SELF.StartUpInfo)
   SELF.StartUpInfo.dwFlags = STARTF_USESHOWWINDOW
   SELF.StartUpInfo.wShowWindow = 1   !SELF.FlagShow
   if CreateProcess(0,address(loc:prgName),0,0,FALSE,0,0,0,address(SELF.StartUpInfo),address(SELF.Process_Information))   
      if SELF.FlagNoWite=0
         do wait_r
      end
   else
     loc:error = GetLastError()
     if FormatMessage(00001000H,0,loc:error,0,loc:errorTxt,size(loc:errorTxt),0).
     if SELF.FlagNoWite=0
        message(loc:prgName & '|' & loc:error & '-' & loc:errorTxt,'Ошибка')    
     end
     loc:ok=0
   end

   dispose(loc:prgName)
   return(loc:ok)

wait_r routine   !ожидание
   loc:Progress=0
   Loc:Time=0

   OPEN(Window)
   Window{PROP:TEXT}=pTitle
   Window{PROP:TIMER}=100
   display

   ACCEPT
     CASE EVENT()
       of EVENT:TIMER
          if GetExitCodeProcess(SELF.Process_Information.hProcess, address(loc:error))
             if loc:error<>259 
                loc:time+=1
                loc:Progress=100
                display 
                break
             end

             loc:time+=1
             loc:Progress+=10
             if loc:Progress>100
                loc:Progress=10
             end
             if loc:time>pTime
                if pEnd=0 
                  ?Close{PROP:DISABLE}=false
                else
                  if SELF.KillProcess()=1
                     loc:ok=0 
                     break
                  end
                end 
             end
             display
          else
             loc:error = GetLastError()
             loc:ok=0 
             if FormatMessage(00001000H,0,loc:error,0,loc:errorTxt,size(loc:errorTxt),0).
             message(loc:prgName & '|' & loc:error & '-' & loc:errorTxt,'Ошибка')    
             break
          end
       of EVENT:ACCEPTED
          if field()=?Close
             if SELF.KillProcess()=1
                loc:ok=0 
                break
             end
          end
     end
   end

   CLOSE(Window) 

!===================================================================================
!
! Убить процесс
!
FsProcess.KillProcess FUNCTION ()

loc:ProcessId long
loc:hProcess  ulong
loc:ExitCode  long

loc:ok   byte

   CODE
      
   loc:ProcessId = SELF.Process_Information.dwProcessId  
   if loc:ProcessId=0
      return(0)
   end

   loc:ok=1

   loc:hProcess=OpenProcess(PROCESS_QUERY_INFORMATION+PROCESS_TERMINATE,False,loc:ProcessId) 
   if loc:hProcess<>0
      if GetExitCodeProcess(loc:hProcess, loc:ExitCode)
        if ~TerminateProcess(loc:hProcess, loc:ExitCode)
           loc:ok=0
        else
           CloseHandle(loc:hProcess)
        end
      else
        loc:ok=0
     end
  else
     loc:ok=0
  end

  return(loc:ok)

!===================================================================================
!
! Проверить процесс
!
FsProcess.TestProcess FUNCTION (UNSIGNED pProcess)

loc:error  ulong 
loc:ok     byte
loc:errorTxt cstring(1024)

   CODE

       loc:ok=0
       SELF.Process_Information.dwProcessId=pProcess
       if GetExitCodeProcess(SELF.Process_Information.hProcess, address(loc:error))
          if loc:error=259 
             loc:ok=1
          end
       else
          loc:error = GetLastError()
          if FormatMessage(00001000H,0,loc:error,0,loc:errorTxt,size(loc:errorTxt),0).
          message('Программа|' & loc:error & '-' & loc:errorTxt,'Ошибка')    
       end

       return(loc:ok)