Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0339: Priorität des eigenen Threads ändern

 von 

Beschreibung 

Vorab sei angemerkt, einen Geschwindigkeitsvorteil in Punkto schnellere Anwendungen, bringt dieser Tipp nicht. Sinn ist es, einen Thread konstanter laufen zu lassen. Ist wenig im System los, kann kaum ein Unterschied bemerkt werden, egal ob die Priorität sich auf dem niedrigsten oder höchsten Level bewegt. Interessant wird es, wenn Windows stark beschäftigt ist. Hier kann der Unterschied zwischen niedrig und hoch einen Unterschied von ca. bis zu 50% ausmachen. Der als hoch eingestufte Prozess, läuft dann, sofern möglich, genauso konstant wie im Ruhezustand.

Dieser Tipp funktioniert entweder nur in kompilierter Form oder benötigt eine DLL/OCX-Datei. Diese Binärdateien sind dem Tipp hinzugefügt worden, um seinen Funktionsumfang darstellen zu können. Vor dem Upload wurden sie auf Viren geprüft.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

GetCurrentProcess, GetCurrentThread, GetPriorityClass, GetThreadPriority, SetPriorityClass, SetThreadPriority

Download:

Download des Beispielprojektes [9,35 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Rahmensteuerelement "Frame2"
' Steuerelement: Optionsfeld-Steuerelement "Option2" (Index von 0 bis 6) auf Frame2
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Optionsfeld-Steuerelement "Option1" (Index von 0 bis 3) auf Frame1
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label4"
' Steuerelement: Beschriftungsfeld "Label3"


'Anmerkung: Der Tip sollte als kompilierte Exe getestet werden.
'           Weiterhin machen sich die Änderungen der Priori-
'           täten zeitlich nur dann deutlich bemerkbar, wenn
'           Das System stark bis schwer ausgelastet ist.
            
Option Explicit

Private Declare Function GetCurrentThread Lib "kernel32" () _
        As Long
        
Private Declare Function GetCurrentProcess Lib "kernel32" () _
        As Long
        
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal _
        hThread As Long, ByVal nPriority As Long) As Long
        
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal _
        hProcess As Long, ByVal dwPriorityClass As Long) As Long
        
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal _
        hThread As Long) As Long
        
Private Declare Function GetPriorityClass Lib "kernel32" (ByVal _
        hProcess As Long) As Long
        
Const THREAD_BASE_PRIORITY_IDLE As Long = -15&
Const THREAD_BASE_PRIORITY_LOWRT As Long = 15&
Const THREAD_BASE_PRIORITY_MIN As Long = -2&
Const THREAD_BASE_PRIORITY_MAX As Long = 2&

Const THREAD_PRIORITY_LOWEST As Long = THREAD_BASE_PRIORITY_MIN
Const THREAD_PRIORITY_HIGHEST As Long = THREAD_BASE_PRIORITY_MAX
Const THREAD_PRIORITY_ABOVE_NORMAL As Long = (THREAD_PRIORITY_HIGHEST - 1&)
Const THREAD_PRIORITY_BELOW_NORMAL As Long = (THREAD_PRIORITY_LOWEST + 1&)
Const THREAD_PRIORITY_IDLE As Long = THREAD_BASE_PRIORITY_IDLE
Const THREAD_PRIORITY_NORMAL As Long = 0&
Const THREAD_PRIORITY_TIME_CRITICAL As Long = THREAD_BASE_PRIORITY_LOWRT
Const THREAD_PRIORITY_ERROR_RETURN As Long = &H7FFFFFFF


Const IDLE_PRIORITY_CLASS As Long = &H40&
Const NORMAL_PRIORITY_CLASS As Long = &H20&
Const HIGH_PRIORITY_CLASS As Long = &H80&
Const REALTIME_PRIORITY_CLASS As Long = &H100&

Dim hThread As Long, hProcess As Long
Dim optT As Long, optC As Long

Private Sub Form_Load()
    Dim Thread As String, Class As String
    
    hThread = GetCurrentThread
    hProcess = GetCurrentProcess
    
    If GetPriority(Thread, Class) = True Then
        Label1.Caption = Thread
        Label2.Caption = Class
        
        Call SetThreadPriority(hThread, THREAD_PRIORITY_NORMAL)
        Call SetPriorityClass(hProcess, NORMAL_PRIORITY_CLASS)
        optT = 5
        optC = 1
    Else
        Call MsgBox("Fehler!")
        Unload Me
    End If
End Sub

Private Sub Command1_Click()
    Dim lT As Long, lC As Long
    Dim Thread As String, Class As String
  
    Select Case optT
        Case 0: lT = THREAD_PRIORITY_LOWEST
        Case 1: lT = THREAD_PRIORITY_HIGHEST
        Case 2: lT = THREAD_PRIORITY_ABOVE_NORMAL
        Case 3: lT = THREAD_PRIORITY_BELOW_NORMAL
        Case 4: lT = THREAD_PRIORITY_IDLE
        Case 5: lT = THREAD_PRIORITY_NORMAL
        Case 6: lT = THREAD_PRIORITY_TIME_CRITICAL
    End Select
    
    Select Case optC
        Case 0: lC = IDLE_PRIORITY_CLASS
        Case 1: lC = NORMAL_PRIORITY_CLASS
        Case 2: lC = HIGH_PRIORITY_CLASS
        Case 3: lC = REALTIME_PRIORITY_CLASS
    End Select

    Call SetThreadPriority(hThread, lT)
    Call SetPriorityClass(hProcess, lC)
    
    If GetPriority(Thread, Class) = True Then
        Label1.Caption = Thread
        Label2.Caption = Class
    Else
        Call MsgBox("Fehler!")
        Unload Me
    End If
End Sub

Private Sub Command2_Click()
    Dim x As Long, y As Long
    Dim z As Single
   
    z = Timer
    
    For x = 0 To 5000000
        y = Sqr(4435)
    Next x
    
    z = Timer - z
    Me.Caption = z
End Sub

Private Sub Option1_Click(Index As Integer)
    optC = Index
End Sub

Private Sub Option2_Click(Index As Integer)
    optT = Index
End Sub

Private Function GetPriority(T As String, C As String) As Boolean
    Dim lThread As Long, lClass As Long
    
    lThread = GetThreadPriority(hThread)
    lClass = GetPriorityClass(hProcess)
    
    If lThread = THREAD_PRIORITY_ERROR_RETURN Or lClass = 0 Then
        Exit Function
    End If
    
    GetPriority = True
    
    Select Case lClass
        Case IDLE_PRIORITY_CLASS: C = "IDLE_PRIORITY_CLASS"
        Case NORMAL_PRIORITY_CLASS: C = "NORMAL_PRIORITY_CLASS"
        Case HIGH_PRIORITY_CLASS: C = "HIGH_PRIORITY_CLASS"
        Case REALTIME_PRIORITY_CLASS: C = "IREALTIME_PRIORITY_CLASS"
    End Select
    
    Select Case lThread
        Case THREAD_PRIORITY_LOWEST: T = "LOWEST"
        Case THREAD_PRIORITY_HIGHEST: T = "HIGHEST"
        Case THREAD_PRIORITY_ABOVE_NORMAL: T = "ABOVE_NORMAL"
        Case THREAD_PRIORITY_BELOW_NORMAL: T = "BELOW_NORMAL"
        Case THREAD_PRIORITY_IDLE: T = "IDLE"
        Case THREAD_PRIORITY_NORMAL: T = "NORMAL"
        Case THREAD_PRIORITY_TIME_CRITICAL: T = "TIME_CRITICAL"
    End Select
    
    T = "THREAD_PRIORITY_" & T
End Function

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 6 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Timo am 30.03.2005 um 10:06

Hallo

Das ist ja wirkich ein toller Tipp.

Mein Modul dazu was ich überalle einfach einbinden kann:
[/code]
Option Explicit

Private Declare Function GetCurrentThread Lib "kernel32" () _
As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () _
As Long

Private Declare Function SetThreadPriority Lib "kernel32" (ByVal _
hThread As Long, ByVal nPriority As Long) As Long

Private Declare Function SetPriorityClass Lib "kernel32" (ByVal _
hProcess As Long, ByVal dwPriorityClass As Long) As Long

Private Declare Function GetThreadPriority Lib "kernel32" (ByVal _
hThread As Long) As Long

Private Declare Function GetPriorityClass Lib "kernel32" (ByVal _
hProcess As Long) As Long

Const THREAD_BASE_PRIORITY_IDLE As Long = -15&
Const THREAD_BASE_PRIORITY_LOWRT As Long = 15&
Const THREAD_BASE_PRIORITY_MIN As Long = -2&
Const THREAD_BASE_PRIORITY_MAX As Long = 2&

Const THREAD_PRIORITY_LOWEST As Long = THREAD_BASE_PRIORITY_MIN
Const THREAD_PRIORITY_HIGHEST As Long = THREAD_BASE_PRIORITY_MAX
Const THREAD_PRIORITY_ABOVE_NORMAL As Long = (THREAD_PRIORITY_HIGHEST - 1&)
Const THREAD_PRIORITY_BELOW_NORMAL As Long = (THREAD_PRIORITY_LOWEST + 1&)
Const THREAD_PRIORITY_IDLE As Long = THREAD_BASE_PRIORITY_IDLE
Const THREAD_PRIORITY_NORMAL As Long = 0&
Const THREAD_PRIORITY_TIME_CRITICAL As Long = THREAD_BASE_PRIORITY_LOWRT
Const THREAD_PRIORITY_ERROR_RETURN As Long = &H7FFFFFFF


Const IDLE_PRIORITY_CLASS As Long = &H40&
Const NORMAL_PRIORITY_CLASS As Long = &H20&
Const HIGH_PRIORITY_CLASS As Long = &H80&
Const REALTIME_PRIORITY_CLASS As Long = &H100&

Dim hThread As Long, hProcess As Long


Public Function SetPriority() As Boolean

Dim Thread As String, Class As String

hThread = GetCurrentThread
hProcess = GetCurrentProcess

If GetPriority(Thread, Class) = True Then
Call SetThreadPriority(hThread, THREAD_PRIORITY_HIGHEST)
Call SetPriorityClass(hProcess, HIGH_PRIORITY_CLASS)
SetPriority = True
Else
Call MsgBox("Fehler in Set_Priority!")
End If


End Function


Private Function GetPriority(T As String, C As String) As Boolean
Dim lThread As Long, lClass As Long

lThread = GetThreadPriority(hThread)
lClass = GetPriorityClass(hProcess)

If lThread = THREAD_PRIORITY_ERROR_RETURN Or lClass = 0 Then
Exit Function
End If

GetPriority = True

Select Case lClass
Case IDLE_PRIORITY_CLASS: C = "IDLE_PRIORITY_CLASS"
Case NORMAL_PRIORITY_CLASS: C = "NORMAL_PRIORITY_CLASS"
Case HIGH_PRIORITY_CLASS: C = "HIGH_PRIORITY_CLASS"
Case REALTIME_PRIORITY_CLASS: C = "IREALTIME_PRIORITY_CLASS"
End Select

Select Case lThread
Case THREAD_PRIORITY_LOWEST: T = "LOWEST"
Case THREAD_PRIORITY_HIGHEST: T = "HIGHEST"
Case THREAD_PRIORITY_ABOVE_NORMAL: T = "ABOVE_NORMAL"
Case THREAD_PRIORITY_BELOW_NORMAL: T = "BELOW_NORMAL"
Case THREAD_PRIORITY_IDLE: T = "IDLE"
Case THREAD_PRIORITY_NORMAL: T = "NORMAL"
Case THREAD_PRIORITY_TIME_CRITICAL: T = "TIME_CRITICAL"
End Select

T = "THREAD_PRIORITY_" & T
End Function


[code]

Kommentar von noVaniac am 01.06.2003 um 14:19

Hy!
Ist es möglich, auch die Priorität anderer Programme zu ändern? Gibt es dafür einen API-Aufruf, um die Thread- bzw. Process-ID über z.B. den hWnd zu ermitteln
Danke im Voraus

Kommentar von PCMueller am 23.10.2002 um 14:32

die änderung über diese art kann zu fehlern führen, wenn mien prog nicht das aktuelle ist.
am sichersten ist die Änderung über die Prozessnumer (PID), die man durch vergleichen des EXE.Namens bekommt.

Kommentar von Pate am 17.07.2002 um 23:36

Zwischen Thread und Prozess gibt es keinerlei Unterschied!

Kommentar von Ivan am 22.04.2002 um 17:20

Hallo,
wo ist der Unterschied zwischen einem Thread und einem Prozess (Class) ??
DANKE

Kommentar von Stephan Muller am 01.01.2002 um 16:37

Gilt das nur für NT oder auch 9x? Bitte Mail = Danke :-)!