Cyber Power Panel Shedule VB6

[MChurlet]

I use Cyber Power Panel vith VB6 program to shutdown my PC and restart.

TA : Stop time
TD : Start time

Sub PPPED(Optional ByVal TA As Date, Optional ByVal TD As Date) 'Gestion de l'allmentation de l'UPS
Dim ff, Chaine$, F$, l As Integer, j As Byte, S, SJ, i As Byte
Dim MH As Byte, MM As Byte, AH As Byte, AM As Byte, R As Single
Dim Message As Boolean

    
    Shell "net stop ppped", vbHide
    
    DoEvents
    If TA = 0 Then 'Heure si vide
        TA = Left(Time + #12:01:00 AM#, 5)
        Message = True
    End If
    
    AH = Left(TA, 2) 'Arrondi à 5 mn de l'heure d'arrêt
    AM = Val(Mid(TA, 4, 2))
    R = AM Mod 5
    While R <> 0
        TA = TA + #12:01:00 AM#
        AH = Left(TA, 2)
        AM = Val(Mid(TA, 4, 2))
        R = AM Mod 5
        DoEvents
    Wend
    
    If TD = 0 Then TD = TA + #12:05:00 AM# 'Heure + 5mn si vide
    
    MH = Left(TD, 2) 'Arrondi à 5 mn de l'heure d'arrêt
    MM = Val(Mid(TD, 4, 2))
    R = MM Mod 5
    While R <> 0
        TD = TD + #12:01:00 AM#
        MH = Left(TD, 2)
        MM = Val(Mid(TD, 4, 2))
        R = MM Mod 5
        DoEvents
    Wend
    
   
    F = "c:\Program Files (x86)\CyberPower PowerPanel Personal Edition\schedule.xml" 'Fichier de programmation horraire de CyberPower Panel Personnal édition
    
    ff = FreeFile
    On Error Resume Next
    l = FileLen(F)
    On Error GoTo 0
    Debug.Print l
    If l = 0 Then
        On Error Resume Next
        fLog "Erreur de lecture du fichier shedule.xml de Cyber Power"
        On Error GoTo 0
        Shell "net start ppped", vbHide
        Exit Sub
    End If
    
    If Message Then
        MsgBox ("Arrêt programmé à " & Left(TA, 5) & " redémarrage à " & Left(TD, 5))
    Else
        fLog "Arrêt programmé à " & TA & " redémarrage à " & TD
    End If
    
    Chaine = String(l, " ")
    Open F For Binary Access Read As #ff
        Get #ff, , Chaine
    Close #ff
    
    S = Split(Chaine, "<schedule>")
    
    j = Weekday(Date) 'Jour à traiter
    SJ = Split(S(j), ">")
        
    SJ(9) = AH & "</off_hour"
    SJ(11) = AM & "</off_minute"
    SJ(13) = "no</off_only"
    SJ(15) = "yes</off_active"
        
    If TD < TA Then
        chaine=""
        For i = 0 To UBound(SJ)
            Chaine = Chaine & SJ(i) & ">"
        Next i
        S(j) = Chaine 'Modification des info d'extinction
        j = Weekday(Date + 1) 'Lendemain
        SJ = Split(S(j), ">")
    End If
    
    SJ(3) = MH & "</on_hour"
    SJ(5) = MM & "</on_minute"
    SJ(17) = "yes</on_active"
    
    Chaine = ""
    For i = 0 To UBound(SJ) 'Ecriture des changements avant enregistrement
        Chaine = Chaine & SJ(i) & ">"
    Next i

    S(j) = Chaine
    
    Chaine = S(0) '<schedules>
    For i = 1 To UBound(S) 'Ecriture des changements avant enregistrement
        Chaine = Chaine & "<schedule>" & S(i)
    Next i
    
    Debug.Print Len(Chaine)
    'Stop
    'F = "chaine:\Program Files (x86)\CyberPower PowerPanel Personal Edition\Test.txt"
    Open F For Binary Access Write As #ff
        Put #ff, , Chaine
    Close #ff
    DoEvents
    
    Shell "net start ppped", vbHide
    
End Sub