Protection du pc par mdp (version basic)

Soyez le premier à donner votre avis sur cette source.

Vue 4 498 fois - Téléchargée 308 fois

Description

J'ai fait ce petit prog plus pour les débutant qu'autre chose.
Je ne sais pas si il est très efficace, mais en tout cas ca décourage les curieux qui n'y connaissent rien en informatique.

- Au 1er demarrage de l'appli, elle s'incrit dans la base de registre pour se chargée au démarrage du PC

- Au bout de 3 tentatives incorrectes le PC s'arrete

- A chaque tentative le nom et le mot de passe ainsi que l'heure et la date sont stockées et affichées lorsque le l'utilisateur entre le bon nom et mdp.

- Seuls les caratères et chiffres sont autorisés.

Source / Exemple :


'CE QU'IL FAUT POUR CETTE APP :
2 forms : 
 - Form1 avec 2 textbox et un boutton
 - Form2 avec une listbox et un boutton

'CECI EST A METTRE DANS FORM1

Private Entree As Boolean
Private MdpS$
Private nbchance As Single

'Déclarations pour la BDR
Private var1 As Long
Private resultat As Long
Private Ident As Long
Private ChmAcces As String
Private TailleBuffer As Long

'Constantes correspondant aux cinq clés
'à la base de la base de registres
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_DYN_DATA = &H80000004

'API nécessaires

'pour créer ou ouvrir une clé
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
    (ByVal hkey As Long, _
     ByVal lpSubKey As String, _
     phkResult As Long) As Long
     
'pour supprimer une clé
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
    (ByVal hkey As Long, _
     ByVal lpSubKey As String) As Long
     
'pour supprimer une valeur
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
    (ByVal hkey As Long, _
     ByVal lpSubKey As String) As Long
     
'pour lire une valeur
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hkey As Long, _
     ByVal lpValueName As String, _
     ByVal lpReserved As Long, _
     lpType As Long, _
     lpData As Any, _
     lpcbData As Long) As Long
     
'pour fixer ou créer une valeur
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
    (ByVal hkey As Long, _
     ByVal lpValueName As String, _
     ByVal Reserved As Long, _
     ByVal dwType As Long, _
     lpData As Any, _
     ByVal cbData As Long) As Long

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97

Private Const RSP_SIMPLE_SERVICE = 1
Private Const RSP_UNREGISTER_SERVICE = 0

Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal _
dwProcessID As Long, ByVal dwType As Long) As Long

Public Sub ActiveClavier()
    Dim pid As Long
    Dim regserv As Long

    pid = GetCurrentProcessId()
    regserv = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
End Sub
Public Sub DesactiveClavier()
    Dim pid As Long
    Dim regserv As Long

    pid = GetCurrentProcessId()
    regserv = RegisterServiceProcess(pid, RSP_UNREGISTER_SERVICE)
End Sub
Private Sub DesactiveCTRLALTSUPPR()
   Dim Retour  As Long
   Dim a As Boolean
   Retour = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, a, 0)
End Sub

Private Sub ActiveCTRLALTSUPPR()
   Dim Retour  As Long
   Dim a As Boolean
   Retour = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, a, 0)
End Sub

Public Function Decodage(Mtxt As Variant)

    Dim CarCode As String
    Dim CarEncode As String
    Dim TxtEnc
        
    For i% = 1 To Len(Mtxt)
        CarEncode = Asc(Mid(Mtxt, i%, 1)) - 16
        If CarEncode < 0 Then
            CarEncode = CarEncode + 255
        End If
        Decodage = Decodage & Chr(CarEncode)
    Next i%
    
End Function

Public Function Encodage(Mtxt As Variant)

    Dim CarEncode As Single
    Dim TxtEnc
        
    For i% = 1 To Len(Mtxt)
        CarEncode = Asc(Mid(Mtxt, i%, 1)) + 16
        If CarEncode > 255 Then
            CarEncode = CarEncode - 255
        End If
        Encodage = Encodage & Chr(CarEncode)
    Next i%
    
End Function

Private Sub Command1_Click()
    Dim Mdp$, Nom$, Confirm$, Nexe$, Nbacces%
    nbchance = nbchance - 1
    
    Form2.List1.Clear
    Nbacces% = CSng(GetSetting(App.Title, "Paramètre", "Acces", "0"))
    Form2.Hide
    If Nbacces > 0 Then
        For i% = 1 To Nbacces%
            Form2.List1.AddItem GetSetting(App.Title, "Paramètre", "Acces" & i%, "")
        Next i%
    End If
    
    Form2.List1.AddItem "Date : " & Format(Date, "dddd dd mmmm yyyy") & "   Heure : " & Format(Time, "hh:mm:ss") & " Nom : " & TxtNom.Text & "  Mot de passe : " & TxtMdp.Text
    
    Nbacces% = Form2.List1.ListCount
    Call SaveSetting(App.Title, "Paramètre", "Acces" & Nbacces%, Form2.List1.List(Form2.List1.ListCount - 1))
    
    Call SaveSetting(App.Title, "Paramètre", "Acces", Nbacces%)
    
    If TxtNom.Text = "" Or TxtMdp.Text = "" Then
        Call MsgBox("Vous devez entrer un nom d'utilisateur et un mot de passe !", vbOKOnly + vbCritical)
        Exit Sub
    End If
    
    Nom$ = GetSetting(App.Title, "Paramètre", "Nom", "")
    Mdp$ = GetSetting(App.Title, "Paramètre", "Mdp", "")
    
    If Nom$ = "" And Mdp$ = "" Then
        Confirm$ = InputBox("Entrez le mot de passe pour confirmation", "1ère utilisation - Confirmation du mot de passe")
        If Confirm$ = "" Then
            Call MsgBox("Vous devez entrer un mot de passe", vbOKOnly + vbCritical)
        End If
        If TxtMdp.Text = Confirm$ Then Entree = True
        Call SaveSetting(App.Title, "Paramètre", "Nom", Encodage(TxtNom.Text))
        Call SaveSetting(App.Title, "Paramètre", "Mdp", Encodage(TxtMdp.Text))
        Nexe$ = App.Path & "\" & App.EXEName & ".exe"
        'Ici on place une commande dans la base de registre pour que l'appli ce lance toute seule au démarrage du PC
        resultat = 0
        resultat = RegCreateKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", Ident)
        If resultat = 0 Then
            resultat = RegSetValueEx(Ident, "Mdp", 0&, 1, ByVal Nexe$, Len(Nexe$) + 1)
        End If
        Entree = True
    Else
        If TxtMdp.Text = Decodage(Mdp$) And TxtNom.Text = Decodage(Nom$) Then Entree = True
    End If

    If Entree = True Then
        Unload Me
    Else
        If nbchance > 0 Then
            Call MsgBox("Désolé, ce n'est pas le bon nom d'utilisateur ou le bon mot de passe." & vbCrLf & vbCrLf & "ATTENTION n'avez plus que " & nbchance & " tentatives", vbOKOnly)
        Else
            Call MsgBox("T'EST GRILLER AH AH AH !!!!!!!!!!!!!!!!!!!!", vbOKOnly)
            Shell ("rundll32.exe user.exe,exitwindows")
        End If
    End If
End Sub

Private Sub Form_Load()
    Entree = False
    MdpS$ = ""
    TxtNom.Text = ""
    TxtMdp.Text = ""
    nbchance = 3
    Call DesactiveClavier
    Call DesactiveCTRLALTSUPPR

    Frame1.Left = (Screen.Width / 2) - (Frame1.Width / 2)
    Frame1.Top = (Screen.Height / 2) - (Frame1.Height / 2)
    
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call DesactiveClavier
    Call DesactiveCTRLALTSUPPR
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call ActiveClavier
    Call ActiveCTRLALTSUPPR
    Form2.Show
End Sub

Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call DesactiveClavier
    Call DesactiveCTRLALTSUPPR
End Sub

Private Sub TxtMdp_Click()
    Call ActiveClavier
    Call ActiveCTRLALTSUPPR
End Sub

Private Sub TxtMdp_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode >= 65 And KeyCode <= 90 Or KeyCode >= 48 And KeyCode <= 57 Then GoTo fin
    Call DesactiveClavier
    Call DesactiveCTRLALTSUPPR
fin:

End Sub

Private Sub TxtMdp_LostFocus()
    Call DesactiveClavier
    Call DesactiveCTRLALTSUPPR
End Sub

Private Sub TxtNom_Click()
    Call ActiveClavier
    Call ActiveCTRLALTSUPPR
End Sub

Private Sub TxtNom_GotFocus()
    Call DesactiveClavier
    Call DesactiveCTRLALTSUPPR
End Sub

Private Sub TxtNom_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode >= 65 And KeyCode <= 90 Or KeyCode >= 48 And KeyCode <= 57 Then GoTo fin
    Call DesactiveClavier
    Call DesactiveCTRLALTSUPPR
fin:
End Sub

'CECI EST A METTRE DANS FORM2

Private Sub Command1_Click()
    Unload Me
End Sub

Conclusion :


Désolé mais il n'y pas de fonction pour changer le nom d'utilisateur et le mot de passe et il n'y pas de gestion de plusieurs utilisateurs. Enfin c'est juste pour montrer comment on peut bloquer l'accès a un PC.

N'hésitez pas à commenter.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

PatDeLaYaute
Messages postés
133
Date d'inscription
dimanche 28 avril 2002
Statut
Membre
Dernière intervention
15 janvier 2009
3 -
Je vous remercie de votre aide,
mais j'ai laisser cette source de coté.
Au tout début je l'avais développer pour une amie qui ne souhaitait pas voir de curieux fouiner sur son PC. Depuis je ne l'ai plus toucher. Mais il est vrai que si l'on est un puriste le code peut-être grandement optimiser. Notament au niveau du password qui est simplement codé et non pas crypté.

PatDeLaYaute
Gilmirsoft
Messages postés
9
Date d'inscription
mardi 22 février 2000
Statut
Membre
Dernière intervention
3 juin 2004
-
Cela me paraît fort compliqué, je n'ai pas essayé le code affiché, mais je pense qu'il vaut mieux utiliser l'Api de windows qui possède lez instructions plus adéquate pour supprimer la fonction du clavier.
Je vais essayer de développer une application qui vous donnera toutes les instructions nécessaires pour fabriquer un Password.
J'ai déjà diffusé sur un autre site comment utiliser un Password, mais j'ai omis volontairement de donner les explications pour bloquer le clavier, je vais remédier à cette lacune le temps de rechercher dans mes archives.
GilMirSoft
yoman64
Messages postés
962
Date d'inscription
samedi 19 janvier 2002
Statut
Membre
Dernière intervention
2 août 2010
-
Ouais vive Linux!
cs_Florent
Messages postés
53
Date d'inscription
jeudi 20 décembre 2001
Statut
Membre
Dernière intervention
22 novembre 2005
-
Le mieux est d'avoir un système qui gère correctement les utilisateurs, comme Linux où Windows NT/2000/XP
PatDeLaYaute
Messages postés
133
Date d'inscription
dimanche 28 avril 2002
Statut
Membre
Dernière intervention
15 janvier 2009
3 -
Je sais, mais j'ai bien préciser que c'était pour les petits curieux qui n'y connaissent rien en informatique!

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.