2013-08-20 12:35

'=======================================================
' Type Objet
' Classe QProcess version 1.0
'=======================================================
     CONST ProcessLow=-2
     CONST ProcessBelowNormal=-1
     CONST ProcessNormal=0
     CONST ProcessHight=2
     CONST ProcessAboveNormal=1
     CONST ProcessTimeCritical=15
     CONST ProcessIdle=-15

     $IFNDEF __WIN32API
      DECLARE FUNCTION CreateProcess LIB "kernel32" ALIAS "CreateThread" (lpThreadAttributes AS LONG, BYVAL dwStackSize AS LONG, lpStartAddress AS LONG, lpParameter AS LONG, BYVAL dwCreationFlags AS LONG, lpThreadId AS LONG) AS LONG
      DECLARE FUNCTION TerminateProcess LIB "kernel32" ALIAS "TerminateThread" (BYVAL hThread AS LONG, BYVAL dwExitCode AS LONG) AS LONG
      DECLARE FUNCTION GetProcessPriority LIB "kernel32" ALIAS "GetThreadPriority" (hThread AS LONG) AS LONG
      DECLARE FUNCTION SetProcessPriority LIB "kernel32" ALIAS "SetThreadPriority" (hThread AS LONG,nPriority AS LONG) AS LONG

' Declare Sub InitializeCriticalSection Lib "kernel32" Alias "InitializeCriticalSection" (lpCriticalSection As CRITICAL_SECTION)
' Declare Sub EnterCriticalSection Lib "kernel32" Alias "EnterCriticalSection" (lpCriticalSection As CRITICAL_SECTION)
' Declare Sub LeaveCriticalSection Lib "kernel32" Alias "LeaveCriticalSection" (lpCriticalSection As CRITICAL_SECTION)
' Declare Sub DeleteCriticalSection Lib "kernel32" Alias "DeleteCriticalSection" (lpCriticalSection As CRITICAL_SECTION)

' Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
' Declare Function OpenMutex Lib "kernel32" Alias "OpenMutexA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
' 'Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (BYREF lpMutexAttributes As LONG, ByVal bInitialOwner As Long, lpName As String) As Long
' Declare Function ReleaseMutex Lib "kernel32" Alias "ReleaseMutex" (ByVal hMutex As Long) As Long
'
'
' Declare Function WaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
' Declare Function WaitForMultipleObjects Lib "kernel32" Alias "WaitForMultipleObjects" (ByVal nCount As Long, lpHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long) As Long
     $ENDIF



     DECLARE SUB OnProcess_event

     TYPE QProcess EXTENDS QOBJECT
Private:
      IdProcess AS LONG
      hProcess AS LONG
Public:
      OnProcess AS EVENT(OnProcess_event)
      Priority AS LONG PROPERTY SET SetPriority

    '==========================================
    ' proprieté priorité process
    '==========================================
      PROPERTY SET SetPriority(priority AS LONG)
       this.priority=priority
      END PROPERTY

Private:
    '==========================================
    ' méthode appelle process
    '==========================================
      SUB Process
       IF This.OnProcess<>0 THEN CALLFUNC this.OnProcess
      END SUB

Public:
    '==========================================
    ' méthode exécution process
    '==========================================
      SUB OPEN
       DIM PtVar AS LONG
       DIM PtSub AS LONG

       IF this.hProcess<>0 THEN TerminateProcess(this.hProcess,0)
       PtVar=VARPTR(this.IdProcess)
       PtSub=CODEPTR(this.Process)
       this.hProcess=CreateProcess(0,0,PtSub,0,0,PtVar)
       SetProcessPriority(this.hProcess,this.Priority)
      END SUB

    '==========================================
    ' méthode fin process
    '==========================================
      SUB CLOSE
       IF this.hProcess<>0 THEN TerminateProcess(this.hProcess,0)
      END SUB

      CONSTRUCTOR
       priority=0
       IdProcess=0
       hProcess=0
      END CONSTRUCTOR
     END TYPE

2013-08-20 12:35