SetTimer et Charge machine ?

Version imprimable

Bonjour à tous
J'écris un petit exe (VB6) pour assurer la sauvegarde de nos données sur un disque externe.
Pour ce faire, je lance un timer par SetTimer :

Code:

1
2
3
4
5
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Call SetTimer(0, TIMER_ID, CLng(pStrElapse), AddressOf Sauve)
Do While True
    DoEvents
Loop

Je met pStrElapse="60000" (période du timer) donc toutes les secondes

Dans la fonction appelée, je vérifie à quelle heure j'effectue la sauvegarde et si j'y suis, je sauvegarde (une fois par jour)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Sauve()
Dim plIntI As Long
Dim pStrFileName As String
Dim pStrDestinationReelle As String
 
    On Error GoTo Errorhandler
 
    If Not pBooDone Then
        If Hour(Now) = "12" Then
            pStrDestinationReelle = pStrDestination & "\" & GetDateDir
            MkDir pStrDestinationReelle
 
            For plIntI = 1 To UBound(pStrSource)
                pStrFileName = GetFileName(pStrSource(plIntI))
                FileCopy pStrSource(plIntI), pStrDestinationReelle & "\" & pStrFileName
            Next
 
            pBooDone = True
        End If
    Else
        If Hour(Now) <> "12" Then
            pBooDone = False
        End If
    End If
 
Sortie:
 
    Exit Sub
 
Errorhandler:
    If Err = 75 Then
        Resume Sortie
    End If
 
End Sub

Donc je m'attend à ce que le temps CPU affiché par le Gestionnaire des tâches soit quasi nul
Or il est de 29% !!!

Que fait-il pendant tout ce temps ???

Merci de vos suggestions

25/11/2016, 22h43
l_autodidacte

Citation:

Je met pStrElapse="60000" (période du timer) donc toutes les secondes

Tu veux dire 60 secondes !?.

Citation:

Donc je m'attend à ce que le temps CPU affiché par le Gestionnaire des tâches soit quasi nul

C'est minuit que tu vises par là ?
Par suite, as-tu essayé avec If Hour(Now) = 12 Then au lieu de If Hour(Now) = "12" Then ?
Car

Citation:

Envoyé par MSDN
Hour, fonction
Renvoie une valeur de type Variant (Integer) indiquant un nombre entier compris entre 0 et 23 inclus, qui représente l'heure du jour.
26/11/2016, 10h43
VBLed

Merci de ta réponse, l_autodidacte

Citation:

Envoyé par l_autodidacte

Tu veux dire 60 secondes !?.

Oui, bien sûr, coquille de frappe : 1 minute
D'ailleurs jusqu'à combien puis-je monter ? un long vaut 4 octets donc en théorie je pourrais monter plus haut que 65535, non ?

Citation:

Envoyé par l_autodidacte

C'est minuit que tu vises par là ?

Ben, tout de même !!! 29% de temps CPU alors qu'on ne fait que doevents, c'est un tantinet exagéré

Citation:

Envoyé par l_autodidacte

Par suite, as-tu essayé avec If Hour(Now) = 12 Then au lieu de If Hour(Now) = "12" Then ?
Car

OK, je veux bien, mais en pas à pas ça marche très bien, donc je ne me suis pas posé la question. Je crois que VB converti dans le bon format avant d'effectuer la comparaison donc fait un truc du genre if Trim(Hour(Now))="12"
26/11/2016, 14h29
l_autodidacte

Désolé d'avoir loupé quelque chose.
Si j'ai bien compris bien ta demande, par "le temps CPU" tu vises le pourcentage d'utilisation du Processeur ?

Pour le pourcentage(29%), il y a certainement d'autres applications, services, processus ... qui tournent en plus de l'appel de la fonction SetTimer.

Pour le type long , on trouve dans MSDN :
Les variables de type Long (entier long) sont stockées sous la forme de nombres signés de 32 bits (4 octets) dont la valeur est comprise entre -2 147 483 648 et 2 147 483 647. Le caractère de déclaration de type Long est le signe &.
26/11/2016, 21h42
unparia
Bonjour
Je réagis à :

Code:

29% de temps CPU alors qu'on ne fait que doevents, c'est un tantinet exagéré

des Doevents dans une longue boucle peuvent aller jusqu'à :
- dans un premier temps faire considérablement chauffer le processeur (et on entendra son ventilateur de refroidissement "s'énerver")
- dans un second temps provoquer une interruption brutale.
Qu'est-ce qui peut ou a pu te laisser croire que les opérations du système générées par un doevents sont anodines et légères ? C'est loin d'être le cas.

EDIT :
cette seule boucle sans fin puisque True est toujours True
Code:

1 2 3 Do While True DoEvents Loop
qui revient d'ailleurs à dire
Code:

1 2 3 Do DoEvents Loop
est extrêmement gourmande en utilisation processeur, y compris si seule ligne de code d'une appli et si aucune autre appli n'est lancée.

Salut

Sur 1 Form, 1 CommandButton et un label et ce

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
 
Private Sub Form_Load()
    Command1.Move 120, 60, 1215, 375
    Label1.Move 120, 540, 3375, 495
    Command1.Caption = "Start": Label1.Caption = ""
    Me.Height = 1725: Me.Width = 3855
    'Frquence = 1000 ' 1  Sc
    Frquence = 60000 ' 1 Mn
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Arrêter le temporisateur, si il est toujours en cours
    timeKillEvent hMMTimer
End Sub
Private Sub Command1_Click()
    If Command1.Caption = "Start" Then
        Label1.Caption = ""
        'Start both timers
        'hMMTimer = timeSetEvent(1, 0, AddressOf TimerProc, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
        'ATTENTION le 2° parametre ne doit jamais depasser le double du 1°
        hMMTimer = timeSetEvent(Frquence, 0, AddressOf TimerProc, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
        Command1.Caption = "Stop"
    Else
        'Stop both timers
        timeKillEvent hMMTimer
        Command1.Caption = "Start"
        'Show result
        Label1.Caption = "TimerProc a été appelé " & MMTimer & " fois"
        MMTimer = 0
    End If
End Sub

Ajouter un Module .bas avec ce

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit
'Événement se produit une fois, après uDelay millisecondes.
Public Const TIME_ONESHOT = 0
'Événement produit toutes les millisecondes uDelay.
Public Const TIME_PERIODIC = 1
'Lorsque le délai expire, Windows appelle la fonction thePulseEvent pour impulsez l'événement indiqué par le paramètre lpTimeProc.
'Le paramètre dwUser est ignoré.
Public Const TIME_CALLBACK_EVENT_PULSE = &H20
'Lorsque le délai expire, Windows appelle la fonction theSetEvent pour définir l'événement indiqué par le paramètre lpTimeProc.
'Le paramètre dwUser est ignoré.
Public Const TIME_CALLBACK_EVENT_SET = &H10
'Lorsque le délai expire, Windows appelle la fonction vers laquelle pointée le paramètre lpTimeProc. Il s'agit de la valeur par défaut.
Public Const TIME_CALLBACK_FUNCTION = &H0
 
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, _
                        ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
'Udelay:
'Cas où un retard en millisecondes.
'Si cette valeur n'est pas dans la plage des retards minimal et maximal d'événements pris en charge par la minuterie,
'la fonction retourne une erreur.
 
'uResolution:
'Résolution de l'événement timer en millisecondes.
'La résolution augmente avec des valeurs plus petites,
'une résolution de 0 indique les événements périodiques doivent avoir lieu avec la plus grande précision possible.
'Pour réduire la charge du système, cependant, vous devez utiliser la valeur maximale appropriée pour votre application
 
'lpFunction:
'Adresse d'une fonction de rappel qui sera appelée une fois à l'expiration d'un événement unique ou périodique à l'expiration d'événements périodiques.
'Si fuEvent spécifie le TIME_CALLBACK_EVENT_SET ou le drapeau TIME_CALLBACK_EVENT_PULSE,
'le paramètre lpFunction est interprété comme un handle à un objet de l'événement.
'L'événement sera mis pulsé ou à la fin d'un événement unique ou périodique à l'issue d'événements périodiques.
 
'dwUser:
'Fourni par l'utilisateur des données de rappel.
 
'uFlags:
'Type d'événement Timer. Ce paramètre peut comporter l'une des valeurs suivantes.
'TIME_ONESHOT  'Événement se produit une fois, après millisecondes udelay.
'TIME_PERIODIC  'l'événement se produit toutes les millisecondes udelay.
 
'Le paramètre fuEvent peut également comprendre une des valeurs suivantes:
'TIME_CALLBACK_FUNCTION   'Lorsque le délai expire, Windows appelle la fonction pointée par le paramètre lpFunction.
'                           Il s'agit de la valeur par défaut.
'TIME_CALLBACK_EVENT_SET  'Lorsque le délai expire, Windows appelle la fonction theSetEvent pour définir l'événement pointé par le paramètre lpFunction.
'                          Le paramètre dwUser est ignoré.
'TIME_CALLBACK_EVENT_PULSE 'Lorsque le délai expire, Windows appelle la fonction thePulseEvent à pulser l'événement pointé par le paramètre lpFunction.
'                          Le paramètre dwUser est ignoré.
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
'uID: (variable hMMTimer dans l'exemple)
'Identificateur de l'événement de minuterie pour annuler.
'Cet identifiant a été renvoyé par la fonction timeSetEvent lorsque la minuterie a été mis en place.
Public hMMTimer As Long
Public Frquence As Long ' maxi = 2147483 647 = + de 596 heures
Public MMTimer As Long
Public pBooDone As Boolean
 
Public Sub TimerProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
    ' pour la demo increment MMTimer
    MMTimer = MMTimer + 1
    Form1.Label1.Caption = MMTimer & " passage dans la sub TimerProc"
    'fin pour la demo
'------------------------ ton code ici -----------------------------------------------
    If Not pBooDone Then
    '    Dim plIntI As Long
    '    Dim pStrFileName As String
    '    Dim pStrDestinationReelle As String
    '    If Hour(Now) = "12" Then
    '        pStrDestinationReelle = pStrDestination & "\" & GetDateDir
    '        MkDir pStrDestinationReelle
'
    '        For plIntI = 1 To UBound(pStrSource)
    '            pStrFileName = GetFileName(pStrSource(plIntI))
    '            FileCopy pStrSource(plIntI), pStrDestinationReelle & "\" & pStrFileName
    '        Next
'
    '        pBooDone = True
    '    End If
    'Else
    '    If Hour(Now) <> "12" Then
    '        pBooDone = False
    '    End If
    End If
'------------------------ fin ton code ici -----------------------------------------------
End Sub

Donc pas de Doevents, utilisation du CPU, entre 0 et 4%, les 4% ne sont pas forcements liées au programme mais plutôt au(x) tâche(s) de fond windows.

Citation:

Envoyé par ProgElecT

Salut

Sur 1 Form, 1 CommandButton et un label et ce

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Option Explicit
 
Private Sub Form_Load()
    Command1.Move 120, 60, 1215, 375
    Label1.Move 120, 540, 3375, 495
    Command1.Caption = "Start": Label1.Caption = ""
    Me.Height = 1725: Me.Width = 3855
    'Frquence = 1000 ' 1  Sc
    Frquence = 60000 ' 1 Mn
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Arrêter le temporisateur, si il est toujours en cours
    timeKillEvent hMMTimer
End Sub
Private Sub Command1_Click()
    If Command1.Caption = "Start" Then
        Label1.Caption = ""
        'Start timer
        'ATTENTION le 2° parametre ne doit jamais depasser le double du 1°
        hMMTimer = timeSetEvent(Frquence, 0, AddressOf TimerProc, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
        Command1.Caption = "Stop"
    Else
        'Stop both timers
        timeKillEvent hMMTimer
        Command1.Caption = "Start"
        'Show result
        Label1.Caption = "TimerProc a été appelé " & MMTimer & " fois"
        MMTimer = 0
    End If
End Sub

Ajouter un Module .bas avec ce

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Option Explicit
'Événement se produit une fois, après uDelay millisecondes.
Public Const TIME_ONESHOT = 0
'Événement produit toutes les millisecondes uDelay.
Public Const TIME_PERIODIC = 1
'Lorsque le délai expire, Windows appelle la fonction thePulseEvent pour impulsez l'événement indiqué par le paramètre lpTimeProc.
'Le paramètre dwUser est ignoré.
Public Const TIME_CALLBACK_EVENT_PULSE = &H20
'Lorsque le délai expire, Windows appelle la fonction theSetEvent pour définir l'événement indiqué par le paramètre lpTimeProc.
'Le paramètre dwUser est ignoré.
Public Const TIME_CALLBACK_EVENT_SET = &H10
'Lorsque le délai expire, Windows appelle la fonction vers laquelle pointée le paramètre lpTimeProc. Il s'agit de la valeur par défaut.
Public Const TIME_CALLBACK_FUNCTION = &H0

Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, _
                        ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
'Udelay:
'Cas où un retard en millisecondes.
'Si cette valeur n'est pas dans la plage des retards minimal et maximal d'événements pris en charge par la minuterie,
'la fonction retourne une erreur.

'uResolution:
'Résolution de l'événement timer en millisecondes.
'La résolution augmente avec des valeurs plus petites,
'une résolution de 0 indique les événements périodiques doivent avoir lieu avec la plus grande précision possible.
'Pour réduire la charge du système, cependant, vous devez utiliser la valeur maximale appropriée pour votre application

'lpFunction:
'Adresse d'une fonction de rappel qui sera appelée une fois à l'expiration d'un événement unique ou périodique à l'expiration d'événements périodiques.
'Si fuEvent spécifie le TIME_CALLBACK_EVENT_SET ou le drapeau TIME_CALLBACK_EVENT_PULSE,
'le paramètre lpFunction est interprété comme un handle à un objet de l'événement.
'L'événement sera mis pulsé ou à la fin d'un événement unique ou périodique à l'issue d'événements périodiques.

'dwUser:
'Fourni par l'utilisateur des données de rappel.

'uFlags:
'Type d'événement Timer. Ce paramètre peut comporter l'une des valeurs suivantes.
'TIME_ONESHOT  'Événement se produit une fois, après millisecondes udelay.
'TIME_PERIODIC  'l'événement se produit toutes les millisecondes udelay.

'Le paramètre fuEvent peut également comprendre une des valeurs suivantes:
'TIME_CALLBACK_FUNCTION   'Lorsque le délai expire, Windows appelle la fonction pointée par le paramètre lpFunction.
'                           Il s'agit de la valeur par défaut.
'TIME_CALLBACK_EVENT_SET  'Lorsque le délai expire, Windows appelle la fonction theSetEvent pour définir l'événement pointé par le paramètre lpFunction.
'                          Le paramètre dwUser est ignoré.
'TIME_CALLBACK_EVENT_PULSE 'Lorsque le délai expire, Windows appelle la fonction thePulseEvent à pulser l'événement pointé par le paramètre lpFunction.
'                          Le paramètre dwUser est ignoré.
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
'uID: (variable hMMTimer dans l'exemple)
'Identificateur de l'événement de minuterie pour annuler.
'Cet identifiant a été renvoyé par la fonction timeSetEvent lorsque la minuterie a été mis en place.
Public hMMTimer As Long
Public Frquence As Long ' maxi = 2147483 647 = + de 596 heures OK
Public MMTimer As Long
Public pBooDone As Boolean

Public Sub TimerProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
    ' pour la demo increment MMTimer
    MMTimer = MMTimer + 1
    Form1.Label1.Caption = MMTimer & " passage dans la sub TimerProc"
    'fin pour la demo
'------------------------ ton code ici -----------------------------------------------
    If Not pBooDone Then
    '    ma routine
    End If
'------------------------ fin ton code ici -----------------------------------------------
End Sub

Donc pas de Doevents, utilisation du CPU, entre 0 et 4%, les 4% ne sont pas forcements liées au programme mais plutôt au(x) tâche(s) de fond windows.

Merci ProgElecT, tu utilises une fonction timer différente, je vois que winmm.dll est dans sysWow64
Quelle est la différence avec SetTimer qui est dans user32.dll qui est aussi dans sysWOW64 ?

Y-a-t-il un doc expliquant uResolution et comment choisir la valeur ?

En fait, j'ai fais un .exe (sans fenètre) dans lequel je met une boucle sans fin qui renvoie à windows avec doevents, mais c'est sans doute inutile, car le .exe est lui même une boucle sans fin qui, sans évènement interne renvoie aux évènements de windows.
Oui ? Non ?
Je vais essayer d'enlever

Code:

1
2
3
Do While True
    DoEvents
Loop

tout simplement

Demain je vais regarder de près ta proposition pour bien la comprendre
Bon WE

Salut

Une amélioration ;), avec un deuxième CommandButton pour synchroniser le début de la surveillance de l'heure à la seconde prés, qui avec le premier CommandButton pouvait démarrer à xxHxxMnxxSc.
Là, avec le deuxième CommandButton, le démarrage commencera à xxHxxMn00Sc, donc ton code dans la Sub TimerProc aura lieu toute les minutes à xxHxxMn00Sc.

Donc 1 Form, 1 Label et 2 CmmandButton et ce

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
 
Private Sub Form_Load()
    Command1.Move 120, 60, 1215, 375
    Command2.Move 1380, 60, 1815, 375
    Label1.Move 120, 540, 3375, 495
    Command1.Caption = "Start": Command2.Caption = "Auto synchro": Label1.Caption = ""
    Me.Height = 1725: Me.Width = 3855
    'Frquence = 1000 ' 1  Sc
    Frquence = 60000 ' 1 Mn
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Arrêter le temporisateur, si il est toujours en cours
    timeKillEvent hMMTimer
End Sub
 
Private Sub Command1_Click()
    If Command1.Caption = "Start" Then
        Label1.Caption = ""
        'Start both timers
        'hMMTimer = timeSetEvent(1, 0, AddressOf TimerProc, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
        'ATTENTION le 2° parametre ne doit jamais dépasser le double du 1°
        hMMTimer = timeSetEvent(Frquence, 0, AddressOf TimerProc, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
        Command1.Caption = "Stop"
        Command2.Enabled = False
    Else
        'Stop both timers
        timeKillEvent hMMTimer
        Command1.Caption = "Start"
        'Show result
        Label1.Caption = "TimerProc a été appelé " & MMTimer & " fois"
        hMMTimer = 0: MMTimer = 0
        Command2.Caption = "Auto synchro": Command2.Enabled = True
    End If
End Sub
Private Sub Command2_Click()
If Command2.Caption = "Auto synchro" Then
    Command1.Enabled = False
    Command2.Caption = "Arrêt auto synchro"
    Label1.Caption = "Synchro en cours ....."
    hMMTimer = 0
    Do
        If Second(Now) = 0 Then
            MMTimer = 0
            hMMTimer = timeSetEvent(Frquence, 0, AddressOf TimerProc, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
            Label1.Caption = "Synchro Ok"
            Exit Do
        End If
        DoEvents
    Loop
    Command2.Enabled = False
    Command1.Enabled = True: Command1.Caption = "Stop"
    Else
    Command2.Caption = "Auto synchro"
End If
End Sub

Pas de modification du module .bas.
La charge CPU, durant -60Sc, la phase de synchronisation sera donc de +- 30% (chez moi), puis une fois synchronisé, passera à +- 0%.

28/11/2016, 11h40
VBLed

En fait j'ai fais deux choses qui règlent mon problème :

2/ j'ai ajouté une feuille invisible, dont j'affecte de hwnd à SetTimer
je mémorise le retour de SetTimer (j'appalais par call
je renseigne KillTimer avec cette valeur mémorisée

1/ j'ai supprimé la boucle de doevents dans la routine main, je prog travaille alors en tâche de fond tant qu'il n'a pas rencontré d'instruction End

Et là, le % temps CPU tombe à ... 0%

Gagné !

Merci à tous