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 818 fois - Téléchargée 609 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
cs_wbr Messages postés 110 Date d'inscription dimanche 11 août 2002 Statut Membre Dernière intervention 21 juillet 2006
18 janv. 2003 à 05:12
ahh je l'aime trop ton appli! c un super blague a faire ça! un peu ti 8/10 lol j'aime trop ça!
sebleboss2002 Messages postés 189 Date d'inscription lundi 30 décembre 2002 Statut Membre Dernière intervention 3 avril 2005
18 janv. 2003 à 08:49
Mouaih... Niveau code, c'est pas mal, mais niveau utilité ;)
Au fait : Moi, quand je fais Ctrl+Alt+Suppr, je la vois ton appli dans le menu !
cs_EBArtSoft Messages postés 4525 Date d'inscription dimanche 29 septembre 2002 Statut Modérateur Dernière intervention 22 avril 2019 9
18 janv. 2003 à 10:25
C'est vrais c'est plutot inattendu comme truc....

C'est marrant et c'est plutot bien fait le code et clair et simple
comme wbr je met 8/10

@+
Tenanio Messages postés 16 Date d'inscription jeudi 10 août 2006 Statut Membre Dernière intervention 2 avril 2008
14 mars 2008 à 14:49
Excellent ce programme.
Galactus13 Messages postés 332 Date d'inscription lundi 29 septembre 2008 Statut Membre Dernière intervention 10 avril 2020 1
27 nov. 2009 à 14:58
Très rigolo come virus! enfin, c'est vache quoi !...

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.