MODULE COMPLET D'ARRÊT MACHINE À DISTANCE

Option Strict On
Option Explicit On 

Module modAdvapi32

    'Constantes nécessaire au fonctionnement des fonctions de codes non managées
    'pour formatMessage
    Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Short = &H100
    Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Short = &H200
    Private Const FORMAT_MESSAGE_FROM_STRING As Short = &H400
    Private Const FORMAT_MESSAGE_FROM_HMODULE As Short = &H800
    Private Const FORMAT_MESSAGE_FROM_SYSTEM As Short = &H1000
    Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Short = &H2000
    Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Short = &HFF

    'pour le language des messages d'erreurs
    Private Const LANG_NEUTRAL As Short = &H0
    Private Const SUBLANG_DEFAULT As Short = &H1
    Private Const LANG_FRENCH As Short = &HC
    Private Const SUBLANG_FRENCH As Short = &H1

    'inclut les fonctions necessaires à l'arrêt de la machine
    '   on aurai pu passer par System.Runtime.InteropServices et DLLImport en mettant l'attribut setlasterror a true (comme en c#), mais en vb powa, il existe
    '   une fonction declare et elle le fait automatiquement et l'on pourra recuperer le message d'erreur via marshal getlastwin32error
    Private Declare Function InitiateSystemShutdown Lib "advapi32.dll" Alias "InitiateSystemShutdownA" (ByVal lpMachineName As String, ByVal lpMessage As String, ByVal dwTimeout As Integer, ByVal bForceAppsClosed As Integer, ByVal bRebootAfterShutdown As Integer) As Integer
    Private Declare Function AbortSystemShutdown Lib "advapi32.dll" Alias "AbortSystemShutdownA" (ByVal lpMachineName As String) As Integer

    'non utilisé dans le module mais par extension pour evolutions futures
    Private Function MAKELANGID(ByRef p As Object, ByRef s As Object) As Integer
        'MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
        Return CInt((CInt(s) * 4) Or CInt(p))
    End Function

    'inclut les fonctions necessaires à la récupération des messages d'erreur si une fonction win32 n'a pas aboutie
    Private Declare Function FormatMessageA Lib "kernel32" (ByVal dwFlags As Integer, ByRef lpSource As Object, ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, ByVal lpBuffer As String, ByVal nSize As Integer, ByRef Arguments As Integer) As Integer

    'surcharge de formatmessage a la sauce vb
    Private Function FormatMessage(ByVal dwMessageId As Integer) As String
        'On est obligé de passer par une variable qui sera "remplie" par la fonction win32, c'est après coup que la fonction renvoi le nombre de caracteres reellement utilise et qu'on pourra
        '   donc réajuster la taille de celle ci (999 est suffisant, vis a vis de ce qu'on peut trouver comme message d'erreur des API win32 (http://www.xs4all.nl/~rjg70/vbapi/ref/other/errorcodes.html)
        Dim buffer As String = Space(999)
        Dim realSize As Integer = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, 0, dwMessageId, LANG_NEUTRAL, buffer, 999, 0)
        buffer = Mid(buffer, 1, realSize)
        Return buffer
    End Function

    Friend Function MOD_remoteSystemShutdown(ByVal BoolAbortSystemShutdown As Boolean, ByVal IPaddress As String, Optional ByVal Message As String = "", Optional ByVal TimeOutInSecond As Integer = 0, Optional ByVal BoolForceAppsClosed As Boolean = True, Optional ByVal BoolRebootAfterShutdown As Boolean = False) As String
        'si AbortSystemShutdown=false, alors on envoi une init d'un system shutdown, les params par defaut sont arret immediat, sans message user, avec forcage fermeture appli et arret de la machine sans reboot
        'si AbortSystemShutdown=true, alors on envoi une annulation de la commande d'init d'un system shutdown, les autres parametres ne sont pas pris en compte

        Select Case BoolAbortSystemShutdown
            Case True
                'si la demande se passe bien on renvois "True" que le user de la fonction pourra facilement convertir en boolean
                'si la demande n'a pas aboutie, on renvois une chaine de caractere contenant le texte d'erreur dans la langue par defaut de la machine sur lequel on execute cette fonction
                '   (le user pourra try un cbool(return fonction) et en cas d'erreur traiter le message d'erreur comme bon lui semble)
                If AbortSystemShutdown(IPaddress) = 0 Then
                    'une erreur s'est produite, on la recupere, on la met en forme et on la renvoi
                    Return FormatMessage(System.Runtime.InteropServices.Marshal.GetLastWin32Error())
                Else
                    Return "True"
                End If
            Case False
                'si la demande se passe bien on renvois "True" que le user de la fonction pourra facilement convertir en boolean
                'si la demande n'a pas aboutie, on renvois une chaine de caractere contenant le texte d'erreur dans la langue par defaut de la machine sur lequel on execute cette fonction
                '   (le user pourra try un cbool(return fonction) et en cas d'erreur traiter le message d'erreur comme bon lui semble)
                If InitiateSystemShutdown(IPaddress, Message, TimeOutInSecond, CInt(BoolForceAppsClosed), CInt(BoolRebootAfterShutdown)) = 0 Then
                    'une erreur s'est produite, on la recupere, on la met en forme et on la renvoi
                    Return FormatMessage(System.Runtime.InteropServices.Marshal.GetLastWin32Error())
                Else
                    Return "True"
                End If
        End Select
    End Function

End Module

19 février 2008 17:55:55 :

19fév: correction de mon texte de description ou je me repetais comme un petit vieu :) (aucunes modifs du code)

19 février 2008 17:56:59 :

Modifs du texte de la description où je me répètais comme un petit vieu :)