Soyez le premier à donner votre avis sur cette source.
Vue 5 516 fois - Téléchargée 320 fois
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
10 oct. 2002 à 22:56
En fait c'est compatible avec WinNT ou 2000 normalement. C'est juste que la clé s'appelle
HKEy_CURRENT_USER<id_utilisateur....
Cet ID est différent en fonction de la machine et je ne sais pas comment le trouver. Si jamais je le trouve je me demerderais pour faire marcher le prog. SI qqun à une idée la dessus
10 oct. 2002 à 21:25
Ton prochain travail : porter ça sur NT (plus souvent utilisé pour des postes libre accès... et puis faudrait gérer la suppression dans l'historique et le cache aussi...
ça fé du boulot lol :)
bon j'te mé 8 pour l'ID.
10 oct. 2002 à 19:46
Ca à pas cette gueule sur Vbasic ne vous affolez pas :p
Je pense que si vous voulez analyser cette source, ouvrez directement le projet.
Au fait, c'est compatible win95,98 seulement !
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.