Url deleting - supprimer url dans la barre d'adresse

Télécharger le projet
Commenter

Description

C'est un code que j'avais fait pour un pote pour gruger au lycée.
J'en profite pour le mettre la aussi.

Le programme supprime les URL que l'on veut ou bien toutes à la fois.

Excusez le manque de commentaire de cette source (je les mettrais peut-être plus tard)

Source / Exemple : 


Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

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

Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long

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

Const REG_SZ = 1
Const HKEY_CURRENT_USER = &H80000001
Const REG_OPTION_NON_VOLATILE = 0
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const SYNCHRONIZE = &H100000
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Dim hKey, Ret As Long, tableofval(1 To 30) As String, z As Integer

----------------------------------------------------------------------------------------

Private Sub Form_Load()
    On Error Resume Next
    Dim i As Integer, val As String, buffersize, result As Long
    
    If RegCreateKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\TypedURLs", 0, "REG_SZ", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, hKey, Ret) = 0 Then
       
        For i = 1 To 30
            result = RegQueryValueEx(hKey, "url" & i, 0, 0, ByVal 0, buffersize)
            If result = 0 Then
                val = String(buffersize, Chr$(0))
                result = RegQueryValueEx(hKey, "url" & i, 0, 0, ByVal val, buffersize)
                List1.AddItem val
                tableofval(i) = val
                List1.ItemData(List1.NewIndex) = i
            End If
        Next i
        
    Else
        Dim msg As String
        msg = MsgBox("Erreur lors du chargement", vbExclamation, vbOKOnly, "Erreur")
    End If
End Sub

----------------------------------------------------------------------------------------

Private Sub Command1_Click()
    Dim indexdat, g, b As Integer
    indexdat = 0
    g = 0
    b = 0
    If List1.SelCount = 0 Then
        Dim msg2 As String
        msg2 = MsgBox("Tu n'as rien selectionné !", vbExclamation + vbOKOnly, "Erreur")
    Else
        Dim msg3, msg4 As String
        msg3 = MsgBox("Confirmer ?", vbQuestion + vbYesNo, "Suppression")
    
        Select Case msg3
            Case vbYes
                indexdat = List1.ItemData(List1.ListIndex)
                tableofval(indexdat) = vbNullString
                z = z + 1

                If RegDeleteKey(hKey, "") <> 0 Then msg4 = MsgBox("Erreur lors de la suppression !", vbExclamation + vbOKOnly, "Erreur")

                If RegCreateKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\TypedURLs", 0, "REG_SZ", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, hKey, Ret) <> 0 Then msg4 = MsgBox("Erreur lors de la suppression !", vbExclamation + vbOKOnly, "Erreur")
                
                For g = 1 To 30 - z
                    If tableofval(g + b) <> vbNullString Then
                        RegSetValueEx hKey, "url" & g, 0, REG_SZ, ByVal tableofval(g + b), Len(tableofval(g + b))
                    Else
                        While (tableofval(g + b) = vbNullString) And (b < z)
                            b = b + 1
                        Wend
                        RegSetValueEx hKey, "url" & g, 0, REG_SZ, ByVal tableofval(g + b), Len(tableofval(g + b))
                    End If
                Next g
                List1.RemoveItem List1.ListIndex
            Case vbNo
                msg4 = MsgBox("Abandon", vbInformation + vbOKOnly, "Arrêt")
        End Select
        
    End If
End Sub

----------------------------------------------------------------------------------------

Private Sub Command2_Click()
    Dim msg6 As String
    msg6 = MsgBox("Confirmer ?", vbQuestion + vbYesNo, "Suppression")

    Select Case msg6
        Case vbYes
                RegDeleteKey hKey, ""
                RegCreateKeyEx HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\TypedURLs", 0, "REG_SZ", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, hKey, Ret
                List1.Clear
        Case vbNo
            Dim msg7 As String
            msg7 = MsgBox("Abandon", vbInformation + vbOKOnly, "Arrêt")
    End Select
    
End Sub

----------------------------------------------------------------------------------------

Private Sub Form_Unload(Cancel As Integer)
    RegCloseKey hKey
End Sub

Conclusion :


Pour ceux qui auront du mal au début, j'explique le fonctionnement :

1) Pour la suppression au coups par coups, il fallait inventer un système permettant à partir de la selection de la listbox de supprimer celle ci dans la base de registre.
Pour celà, au chargement du programme je teste toutes les valeures possibles de 1 à 30. Si une telle url existe, alors j'enregistre son contenu dans la listbox et dans un tableau.
Lors de la suppression d'une url dans la listbox, je prend son index que j'ai pris soin de paramétrer au début (chaque entrée dans la listbox possède un index différent).
Je repère donc à partir de quel enregistrement je dois supprimer l'url. Pour ça, je prend l'index de la valeur, et je prend celle ci pour le tableau, identifie l'URL à l'interieur de celui ci et la remplace par une chaine nulle.
Je n'ai plus qu'à supprimer la clé TypedURLs pour la recréer ensuite. Apres je fais une structure FOR de 1 à 30 - z
Z correspond au nombre de fois ou la personne à supprimé qqe chose. Si elle appuie une fois, il ne reste plus 30 enregistrements mais 30 - ceux supprimé. Apres pour chaque boucle for j'enregistre dans la clé recréée, les valeurs en leur donnant comme nom "url" + un nombre.
Et oui on ne peut supprimer 1 enregistrement directement sinon :
url1 --> Supprimez url2 et vous avez url1 et url3. A ce moment là, IE bug et affiche les
url2 --> nombres dans la continuité. Si la suite est fausse il s'arrête. Il y aurait donc que
url3 --> URL1 dans la barre d'adresse bien que URL3 soit dans la base de registre.

AU moment des enregistrements des adresses, j'enregistre leur contenu au même moment en prenant les valeurs dans le tableau. Mais si pour l'URL1, le tableau indique l'URL de celle ci, il n'en va pas de même pour l'URL supprimée. Ainsi, lors des enregistrements, si le contenu du tableau est une chaine nulle, cela indique que c'est la valeur supprimée. Alors dans ce cas, j'incrémente la valeur de recherche des URL. Car le tout est décalé, j'espère que vous comprenez ! C'est dur d'expliquer :p

2) Pour la suppression totale, je supprime la clé et la recréée ensuite sans mettre de valeur.

Voilà, j'espère que vous avez compris :p
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_Kephren)