REBOOT D'UNE LIVEBOX 2 EN AUTOMATIQUE SANS TELNET

Private Declare Function FlushPrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal Section As String, ByVal MotCle As Long, ByVal Valleur As Long, ByVal NonFic$) As Integer
Rem {Section}   Sera forcé à zéro
Rem {MotCle}        Sera forcé à zéro
Rem {Buff}      Sera forcé à zéro
Rem {NomFichierINI$}    Nom du Fichier
Rem Retourne    0 : Si erreur
Rem         1 : Si écriture OK
Private Declare Function GetPrivateProfileStringA Lib "kernel32" (ByVal Section As String, ByVal MotCle As String, ByVal ValeurParDefaut As String, ByVal Valeur As String, ByVal Longueur As Integer, ByVal NomFichierINI As String) As Integer
Rem Lecture d'un fichier de type '.INI'
Rem {Section$}      Nom de la section
Rem {MotCle$}       Nom du mot clé
Rem {ValeurParDefaut$}  valeur qui est donnée à "Valeur$" si {Section$-MotCle$} n'est pas trouvée
Rem {Valeur}        Variable ou sera rangée la valeur trouvée
Rem {Longueur} est la longueur maximum de la chaine retournée dans "Valeur$"
Rem {NomFichierINI$}    Nom du Fichier
Rem Retourne la longueur de la chaine contenue dans "Valeur$"
Rem GetPrivateProfileStructA
Private Declare Function WritePrivateProfileStringA Lib "kernel32" (ByVal Section As String, ByVal MotCle As String, ByVal Valeur As String, ByVal NomFichierINI As String) As Integer
Rem Ecriture dans un fichier de type '.INI'
Rem Si le fichier n'existe pas il est créé
Rem {Section$}      Nom de la section
Rem {MotCle$}       Nom du mot clé
Rem {Valeur$}       Valeur à donner au mot clé
Rem {NomFichierINI$}    Nom du Fichier
Rem Retourne    0 : Si erreur
Rem             1 : Si ecriture OK

Const Val_Tempo As Integer = 2
Public Type POINTAPI
        X As Long
        Y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

' API declarations:
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long

Const navOpenInNewTab = &H800&
Dim ie As New InternetExplorer
Dim ie_pop As New InternetExplorer
' ie.ReadyState = Les états de readyState sont les suivants (seul le dernier est vraiment utile):
'   0 = READYSTATE_UNINITIALIZED    : non initialisé.
'   1 = READYSTATE_LOADING          : connexion établie.
'   2 = READYSTATE_LOADED           : requête reçue.
'   3 = READYSTATE_INTERACTIVE      : réponse en cours.
'   4 = READYSTATE_COMPLETE         : terminé.

Dim htmldoc As HTMLDocument
Dim htmlForms As IHTMLElementCollection
Dim htmlForm As HTMLFormElement
Dim htmlElement As HTMLObjectElement
Sub MAIN()

If Dir("C:\Reboot_LiveBox.ini") <> "" Then
    Kill "C:\Reboot_LiveBox.ini"
End If
Debut$ = Format(Date, "YYYY/MM/DD")
Debut$ = Debut$ & " " & Format(Time, "HH:MM:SS")
Ret = WriteString("INIT", "DEBUT", Debut$, "C:\Reboot_LiveBox.ini")
Ret = FlushProfile("C:\Reboot_LiveBox.ini")
Dim Posit_sourie As POINTAPI
Ret = GetCursorPos(Posit_sourie)
Ret = SetCursorPos(2000, 1000)
On Error GoTo FIN_SUB

'ouvre la page de l'interface livebox2 dans IE
ie.navigate "http://192.168.1.1"
ie.Visible = True

'attend que la page soit chargée
Do While ie.ReadyState <> READYSTATE_COMPLETE
    DoEvents
Loop

'Remplir le champ <<authpasswd>> avec le mot de passe
ie.Document.getElementsByName("authpasswd")(0).Value = "admin"

'Remplir le champ <<authlogin>> avec l'Identifiant
ie.Document.getElementsByName("authlogin")(0).Value = "admin"

'Valider
ie.navigate "JavaScript:FormSubmit()"

'attend que la page soit chargée
Do While ie.ReadyState <> READYSTATE_COMPLETE
    DoEvents
Loop

'Afficher la page "Configuration"
 ie.Document.All("rubric2").Click
'attend que la page soit chargée
Do While ie.ReadyState <> READYSTATE_INTERACTIVE
   DoEvents
Loop

Do While ie.ReadyState <> READYSTATE_COMPLETE
  DoEvents
Loop

Rem Dans l 'URL de connection remplacer :
Val_URL = ie.LocationURL
Rem http://192.168.1.1/index.cgi?page=hwview&sessionid=<clé>
Val_Cle = Right(Val_URL, Len(Val_URL) - InStr(Val_URL, "page=hwview&sessionid=") - Len("page=hwview&sessionid=") + 1)
Rem par: http://192.168.1.1/index.cgi?page=reboot&sessionid=<clé>
Rem Sans changer la clé
ie.Navigate2 "http://192.168.1.1/index.cgi?page=reboot&sessionid=" & Val_Cle
Do While ie.ReadyState <> READYSTATE_COMPLETE
  DoEvents
Loop

ie.Navigate2 "JavaScript:FormSubmit('butt1');"
Do While ie.ReadyState <> READYSTATE_COMPLETE
  DoEvents
Loop

ie.Navigate2 "JavaScript:FormSubmit('butt4');"
Do While ie.ReadyState <> READYSTATE_COMPLETE
  DoEvents
Loop

Open "c:\Reboot_LiveBox.log" For Append As #1
Print #1, "REAL : " & Format(Date, "DD/MM/YYYY") & " " & Format(Time, "HH:MM:SS")
Close #1
FIN_SUB:
If Dir("C:\Reboot_LiveBox.ini") <> "" Then
    Ret = GetString("INIT", "DEBUT", Debut$, 256, "C:\Reboot_LiveBox.ini")
    Actuel$ = Format(Date, "YYYY/MM/DD")
    Actuel$ = Actuel$ & " " & Format(Time, "HH:MM:SS")
    Delta = (CDate(Actuel$) - CDate(Debut$)) * 3600 * 24
Rem Attendre 3 min le reboot effectif de la LiveBoxe
    Delta = ((3 * 60) + 30) - Round(Delta)
    Suspendre Delta
    Kill "C:\Reboot_LiveBox.ini"
End If
On Error GoTo 0
On Error Resume Next
ie.Quit

Ret = SetCursorPos(Posit_sourie.X, Posit_sourie.Y)
Bascule_NumLock True
Application.Quit SaveChanges:=wdDoNotSaveChanges
End Sub
Public Function Suspendre(ByVal Pause As Integer)
Dim PauseTime As Integer, Start
PauseTime = Pause   ' Définit la durée.
Start = Timer   ' Définit l'heure de début.
Do While Timer < Start + PauseTime
    DoEvents    ' Donne le contrôle à d'autres processus.
Loop
Bascule_NumLock True
End Function
Sub AutoExec()
Reboot_LiveBox.MAIN
End Sub
Sub AutoOpen()
Reboot_LiveBox.MAIN
End Sub
Sub AutoNew()
Reboot_LiveBox.MAIN
End Sub
Public Sub Bascule_NumLock(TurnOn As Boolean)
'To turn numlock on, set turnon to true
'To turn numlock off, set turnon to false

Dim bytKeys(255) As Byte
Dim bnumLockOn As Boolean

'Get status of the 256 virtual keys
    GetKeyboardState bytKeys(0)
    
    bnumLockOn = bytKeys(VK_NUMLOCK)
    Dim typOS As OSVERSIONINFO
    
    If bnumLockOn <> TurnOn Then    'if current state <> requested state
        If typOS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98
            bytKeys(VK_NUMLOCK) = 1
            SetKeyboardState bytKeys(0)
        Else    '=== WinNT/2000
        'Simulate Key Press
            keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
        'Simulate Key Release
            keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
        End If
    End If
End Sub
Public Function FlushProfile(NonFic$)
Dim Ret
Ret = FlushPrivateProfileString(Chr(0), 0, 0, NonFic$)
FlushProfile = Ret
End Function
Public Function GetString(Section$, Variable$, ValeurVariable$, Lg, NomFichierINI$)
Dim NomSection$
Dim MotCle$
Dim Lg_
Dim Valeur$
Dim Ret_
NomSection$ = Section$
MotCle$ = Variable$
Lg_ = Lg
Valeur$ = String(Lg_, Chr(0))
Ret_ = GetPrivateProfileStringA(NomSection$, MotCle$, Chr(14) + Chr(255), Valeur$, Lg, NomFichierINI$)
If Ret_ > 0 Then
    If Left$(Valeur$, Ret_) = Chr(14) + Chr(255) Then
        ValeurVariable$ = ""
        GetString = -1
       Else
        ValeurVariable$ = Left$(Valeur$, Ret_)
        GetString = Ret_
    End If
   Else
    ValeurVariable$ = ""
    GetString = 0
End If
End Function
Public Function WriteString(Section$, Variable$, ValeurVariable$, NomFichierINI$)
Dim NomSection$
Dim MotCle$
Dim Valeur$
Dim Ret_
NomSection$ = Section$
MotCle$ = Variable$
Valeur$ = ValeurVariable$
Ret_ = WritePrivateProfileStringA(NomSection$, MotCle$, Valeur$, NomFichierINI$)
WriteString = Ret_
End Function