Appli rigolote pour exemple de désactivation de control/alt/suppr et generation dynamique de forms

Télécharger le projet
Commenter

Description

Le dernier rapport des experts vient de tomber : la maladie de Creutzfeld Jacob est transmissible à Windows ! ça a l'air d'une blague mais vous n'allez pas rigoler longtemps car pseudo virus mais virus quand même si vous ignorez la façon de vous en sortir. Allez, je vous donne le truc : tapez "Ouneufe" en aveugle et tout disparaît.

Source / Exemple : 


' DANS UNE FEUILLE NOMMEE FLE
'Cette petite appli débile a pour mérite de fournir :
'- quelques exemples de programmation événementielle
'( cour-circuitage de l'évenement "Unload" de la feuille et
'reconnaissance d 'une séquence saisie au clavier sur la feuille,
'mousemove, etc...)
'
'- 2 exemples d'utilisation d'API (Pour conserver la fenêtre
'au premier plan et désactiver Ctrl-alt-suppr -> ne fonctionne pas sous XP)
'
'- 1 exemple de génération dynamique de feuille
'
'- d'autres petits trucs comme positionnement aléatoire de la feuille

Option Explicit

' Déclaration d'API pour CRTL-ALT-SUPPR
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
     (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, _
    ByVal fuWinIni As Long) As Long
' Déclaration de constante
Private Const SPI_SCREENSAVERRUNNING = 97

'API nécessaire pour le mode "toujours visible"
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _
                                ByVal hWndInsertAfter _
                                As Long, ByVal X _
                                As Long, ByVal Y _
                                As Long, ByVal cx _
                                As Long, ByVal cy _
                                As Long, ByVal wFlags _
                                As Long) As Long

 'DEPLACEMENT APIS

Private Sub Form_Load()
    Dim nRet As Long

    ' Dimensions  et coordonnées aléatoires
    Label1.Width = Me.Width
    Label1.Height = Me.Height
    Randomize (Timer)
    Me.Left = Rnd * (Screen.Width - Me.Width)
    Me.Top = Rnd * (Screen.Height - Me.Height)
   
    ' Désactive ctrl_alt_suppr
    CTRL_ALT_SUPPR (False)
       
    ' Toujours visible
    Dim Resultat As Long
    Const Flags = &H2 Or &H1 Or &H40 Or &H10
    Resultat = SetWindowPos(Me.hWnd, -1, 0, 0, 0, 0, Flags)
    Me.SetFocus
    
    ' masquer dans le gestionnaire des tâches
    App.TaskVisible = False

    
End Sub

' FERMETURE IMPOSSIBLE (si KITE = FALSE)

Private Sub Form_Unload(Cancel As Integer)

    ' Test si autorisation de quitter alors fermeture de toutes les feuilles
    If KITE = True Then
        Dim F As Form
        For Each F In Forms
            Unload F
        Next
        Exit Sub
    End If
    
    ' si je suis ici, l'autorisation de fermer est refusée : nouvelle instance de la form FLE
    Dim Nform As Form
    Set Nform = New FLE
    Nform.Show
    Cancel = 1

End Sub

' Cette procédure permet de désactiver (et réactiver) les combinaisons :
' CTRL+ALT+SUPPR, CTRL+ECHAP et ALT+TAB
Public Sub CTRL_ALT_SUPPR(blOFF As Boolean)
    ' Si blOFF = True, désactive CTRL+ALT+SUPPR
    ' Si blOFF = False, active de nouveau CTRL+ALT+SUPPR
    Dim lgRep As Long
    lgRep = SystemParametersInfo(SPI_SCREENSAVERRUNNING, Not blOFF, False, 0)
End Sub

' ECHAPPER A CET ENFER -> saisie de "OUNEUFE" au clavier en aveugle
Private Sub Form_KeyPress(keyascii As Integer)
    ' Rendre Ctrl-alt-suppr à nouveau valide et autorisation de fermeture
    Pass = Pass & Chr(keyascii):
    
    If UCase(Right(Pass, 7)) = "OUNEUFE" Then
    CTRL_ALT_SUPPR (True): KITE = True: Unload Me
    End If
End Sub

'  effet savonnette
Private Sub label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     Randomize (Timer)
     Me.Left = Rnd * (Screen.Width - Me.Width)
     Me.Top = Rnd * (Screen.Height - Me.Height)
End Sub

' DANS UN MODULE
' Ces variable sont globales pour concerner toutes les feuilles créées dynamiquement
Public Pass As String
Public KITE  As Boolean

Conclusion :


Une petite appli débile mais qui permet de se faire à l'usage des API et d'autres petits trucs. n
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Ouneufe)