Définir la priorité d'un programme VB

Définir la priorité d'un programme VB - VB/VBA/VBS - Programmation

Marsh Posté le 22-11-2002 à 12:08:52    

Hello,
Comment peut-on faire pour qu'un programme VB6 change ça priorité d'exécution (Basse, Normal, Temps réel, etc...)
Merci !
Rarazor

Reply

Marsh Posté le 22-11-2002 à 12:08:52   

Reply

Marsh Posté le 22-11-2002 à 12:59:40    

c'est possible sous NT4 (et peut-être sous win9x ?) mais pas sous Win2000, la fonction est vérouillée.
 
sources ici:
http://www.vbfrance.com/article.aspx?Val=21


---------------
"I wonder if the internal negative pressure in self pumping toothpaste tubes is adjusted for different market altitudes." John Carmack
Reply

Marsh Posté le 22-11-2002 à 14:31:31    

je viens de passer un peu de temps sur le problème (parce que je suis sous win2k donc c'est pas top).
 
Sous Win2K, on peut le faire MAIS, faut demander la permission d'abord.
 
Je me suis même aperçu que ça ne marchait pas si j'utilisais le même handle de process (différent de l'id du process) pour faire un GetPriorityClass d'abord puis un SetPriorityClass ensuite.  Mais au final, on peut.  Windows 2000 complique un petit peu les choses.
 
Tu as trouvé ton bonheur ou je m'étends un peu plus?


---------------
Whichever format the fan may want to listen is fine with us – vinyl, wax cylinders, shellac, 8-track, iPod, cloud storage, cranial implants – just as long as it’s loud and rockin' (Billy Gibbons, ZZ Top)
Reply

Marsh Posté le 22-11-2002 à 14:51:51    

bon, j'ai un collègue qui a codé un petit tool de tests en C++ Builder, il utilise aussi ces API, il est sous Win2K, et il doit pas demander la permission.  Je comprends plus là...  :cry:


---------------
Whichever format the fan may want to listen is fine with us – vinyl, wax cylinders, shellac, 8-track, iPod, cloud storage, cranial implants – just as long as it’s loud and rockin' (Billy Gibbons, ZZ Top)
Reply

Marsh Posté le 22-11-2002 à 15:36:44    

drasche a écrit a écrit :

je viens de passer un peu de temps sur le problème (parce que je suis sous win2k donc c'est pas top).
 
Sous Win2K, on peut le faire MAIS, faut demander la permission d'abord.
 
Je me suis même aperçu que ça ne marchait pas si j'utilisais le même handle de process (différent de l'id du process) pour faire un GetPriorityClass d'abord puis un SetPriorityClass ensuite.  Mais au final, on peut.  Windows 2000 complique un petit peu les choses.
 
Tu as trouvé ton bonheur ou je m'étends un peu plus?




 
Si tu pouvais t'étendre un peu plus  :D  As-tu un code source à me faire parvenir ?

Reply

Marsh Posté le 22-11-2002 à 15:45:05    

Rarazor a écrit a écrit :

 
 
Si tu pouvais t'étendre un peu plus  :D  As-tu un code source à me faire parvenir ?



je te file un lien vers du source dans mon post


---------------
"I wonder if the internal negative pressure in self pumping toothpaste tubes is adjusted for different market altitudes." John Carmack
Reply

Marsh Posté le 22-11-2002 à 15:54:39    

voyons voir:
 


' Priorités (par ordre croissant)
Private Const IDLE_PRIORITY_CLASS As Long = &H40
Private Const BELOW_NORMAL_PRIORITY_CLASS As Long = &H4000
Private Const NORMAL_PRIORITY_CLASS As Long = &H20
Private Const ABOVE_NORMAL_PRIORITY_CLASS As Long = &H8000
Private Const HIGH_PRIORITY_CLASS As Long = &H80
Private Const REALTIME_PRIORITY_CLASS As Long = &H100
 
' Ouvre un handle vers un process
Private Declare Function OpenProcess _
                Lib "kernel32" (ByVal dwDesiredAccess As Long, _
                                ByVal bInheritHandle As Long, _
                                ByVal dwProcessId As Long) As Long
                                 
' Ferme un handle process ouvert
Private Declare Function CloseHandle _
                Lib "kernel32" (ByVal hObject As Long) As Long
 
' Récupère la priorité d'exécution
Private Declare Function GetPriorityClass _
                Lib "kernel32" (ByVal hProcess As Long) As Long
 
' Assigne une nouvelle priorité d'exécution
Private Declare Function SetPriorityClass _
                Lib "kernel32" (ByVal hProcess As Long, _
                                ByVal dwPriorityClass As Long) As Long
 
' Récupère le process Id de l'application
Private Declare Function GetCurrentProcessId _
                Lib "kernel32" () As Long
 
Private lAppProcID As Long
Private lAppHwndID As Long
 
Private Function GetPriority() As Long
    Dim lCurClass As Long
    Dim lRet As Long
 
    ' Get handle to process
    lAppHwndID = OpenProcess(PROCESS_QUERY_INFORMATION, True, lAppProcID)
 
    ' Get priority class
    lCurClass = GetPriorityClass(lAppHwndID)
    If lCurClass = 0 Then
        Call GetErrorMessage(lCurClass)
    End If
 
    lRet = CloseHandle(lAppHwndID)
    If lRet = 0 Then
        Call GetErrorMessage(lRet)
    End If
    GetPriority = lCurClass
End Function
 
Private Sub SetPriority(ByRef lNextClass As Long)
    Dim lRet As Long
 
    ' Get handle to process
    lAppHwndID = OpenProcess(PROCESS_SET_INFORMATION, True, lAppProcID)
 
    ' Set priority class
    lRet = SetPriorityClass(lAppHwndID, lNextClass)
    If lRet = 0 Then
        Call GetErrorMessage(lRet)
        cboPii.ListIndex = -1
    End If
 
    lRet = CloseHandle(lAppHwndID)
    If lRet = 0 Then
        Call GetErrorMessage(lRet)
    End If
End Sub


 
en gros c'est ça sous Windows 2000.
 
En premier lieu tu dois connaître le process ID de ton application.  Sous NT/2K/XP, tu sais le voir via le task manager, et comparer avec le résultat que te renvoie la fonction GetCurrentProcessId.
 
Dans la fonction SetPriority ci-dessus, j'ouvre un handle vers mon process (= mon application) en demandant l'autorisation de changer la priorité (grâce à la constante PROCESS_SET_INFORMATION).
 
Si lAppHwndID est rempli, alors je peux tenter de changer la priorité.  La valeur du paramètre lNextClass est au choix l'une des constantes définies plus haut (priorités).
 
C'est mon code plus ou moins tel quel, compare le avec l'adresse donnée par Mareek.  Tu peux te passer du GetErrorMessage, j'ai préféré virer ses références pour éviter de parler de quelques autres API (hem :)).
 
Voilà.


Message édité par drasche le 22-11-2002 à 15:57:57

---------------
Whichever format the fan may want to listen is fine with us – vinyl, wax cylinders, shellac, 8-track, iPod, cloud storage, cranial implants – just as long as it’s loud and rockin' (Billy Gibbons, ZZ Top)
Reply

Marsh Posté le 23-11-2002 à 02:32:32    

Je faisait ca comme ca aussi mais j'ai vu que ca ne marcherais pas terrible sous windows 2000, du coup j'ai aussi changé la priorité au niveau du thread et la, ca marche au poil :
 

Code :
  1. '///////////////////////////////////////////////////////////////
  2. ' Ajuste les propriété des processus
  3. ' Set process priorities
  4. Private Const THREAD_BASE_PRIORITY_IDLE = -15
  5. Private Const THREAD_BASE_PRIORITY_LOWRT = 15
  6. Private Const THREAD_BASE_PRIORITY_MIN = -2
  7. Private Const THREAD_BASE_PRIORITY_MAX = 2
  8. Private Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
  9. Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
  10. Private Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
  11. Private Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)
  12. Private Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
  13. Private Const THREAD_PRIORITY_NORMAL = 0
  14. Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT
  15. Private Const HIGH_PRIORITY_CLASS = &H80
  16. Private Const IDLE_PRIORITY_CLASS = &H40
  17. Private Const NORMAL_PRIORITY_CLASS = &H20
  18. Private Const REALTIME_PRIORITY_CLASS = &H100
  19. Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
  20. Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
  21. Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
  22. Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long
  23. Private Declare Function GetCurrentThread Lib "kernel32" () As Long
  24. Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
  26. Public Sub SetPriority(ByVal Priority As Long)
  27.     Dim hThread As Long, hProcess As Long
  28.     'retrieve the current thread and process
  29.     hThread = GetCurrentThread
  30.     hProcess = GetCurrentProcess
  31.     Select Case Priority
  32.         Case 1:
  33.             'set the new thread priority to "lowest"
  34.             SetThreadPriority hThread, THREAD_PRIORITY_IDLE
  35.             'set the new priority class to "idle"
  36.             SetPriorityClass hProcess, IDLE_PRIORITY_CLASS
  37.        
  38.         Case 2:
  39.             'set the new thread priority to "lowest"
  40.             SetThreadPriority hThread, THREAD_PRIORITY_NORMAL
  41.             'set the new priority class to "idle"
  42.             SetPriorityClass hProcess, NORMAL_PRIORITY_CLASS
  43.        
  44.         Case 3:
  45.             'set the new thread priority to "lowest"
  46.             SetThreadPriority hThread, THREAD_PRIORITY_HIGHEST
  47.             'set the new priority class to "idle"
  48.             SetPriorityClass hProcess, HIGH_PRIORITY_CLASS
  49.        
  50.         Case 4:
  51.             'set the new thread priority to "lowest"
  52.             SetThreadPriority hThread, THREAD_PRIORITY_TIME_CRITICAL
  53.             'set the new priority class to "idle"
  54.             SetPriorityClass hProcess, REALTIME_PRIORITY_CLASS
  55.     End Select
  56.    
  57. End Sub


 
Scuzez moi pour les commentaires, j'ai la fleme de mofifier le code :sarcastic:


Message édité par karlkox le 23-11-2002 à 02:33:47
Reply

Marsh Posté le 23-11-2002 à 11:31:00    

remarquez le contraste des noms des constantes pour les "class" et les "thread".  Sont pas très fute chez MS :/


---------------
Whichever format the fan may want to listen is fine with us – vinyl, wax cylinders, shellac, 8-track, iPod, cloud storage, cranial implants – just as long as it’s loud and rockin' (Billy Gibbons, ZZ Top)
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed