Protection du pc par mdp (version basic)

Télécharger le projet
Commenter

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.
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 (PatDeLaYaute)