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

Soyez le premier à donner votre avis sur cette source.

Vue 5 322 fois - Téléchargée 566 fois

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Galactus13
Messages postés
326
Date d'inscription
lundi 29 septembre 2008
Statut
Membre
Dernière intervention
27 juillet 2019
1 -
Très rigolo come virus! enfin, c'est vache quoi !...
Tenanio
Messages postés
16
Date d'inscription
jeudi 10 août 2006
Statut
Membre
Dernière intervention
2 avril 2008
-
Excellent ce programme.
bricomaniac
Messages postés
24
Date d'inscription
dimanche 20 août 2006
Statut
Membre
Dernière intervention
7 janvier 2007
-
c'est nul je suis infesté de vaches
sylvanox
Messages postés
19
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 mai 2016
-
Merci c'est super !! 9/10 ;-)
jjmaster
Messages postés
51
Date d'inscription
mardi 28 janvier 2003
Statut
Membre
Dernière intervention
29 septembre 2010
-
Une remarque. ca ne fonctionne pas non plus sous win2000. Dommage, je recherche comment bloqué le clavier et toute les combinaisons de touches qui permette de quitter l'application

Merci de repondre si vous avez une reponse (ou une source à m'indiqué)

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.