4/5 (12 avis)
Snippet vu 5 403 fois - Téléchargée 29 fois
'Déclarations des API necessaires : Private Declare Sub SHChangeNotify Lib "shell32.dll" ( _ ByVal wEventId As Long, _ ByVal uFlags As Long, _ dwItem1 As Any, _ dwItem2 As Any) 'Déclarations des constantes nécessaires : Private Const SHCNE_ASSOCCHANGED = &H8000000 Private Const SHCNF_IDLIST = &H0& Private Function Associer(AdApp As String, AdIcon As String, Extention As Variant, NomDuFichier As String) As Boolean On Error GoTo F 'Si une erreur subsiste aller à la ligne F Set WshShell = CreateObject("Wscript.Shell") 'Création d'un object WshShell For v = LBound(Extention, 1) To UBound(Extention, 1) 'V variant de l'index le plus bas de la matrice Extention jusqu'a son plus haut niveau WshShell.RegWrite "HKEY_CLASSES_ROOT\." & Extention(v) & "\", NomDuFichier, "REG_SZ" 'Association de l'extention a un type "NomDuFichier" Next v AdSp = "HKEY_CLASSES_ROOT\" & NomDuFichier & "\" 'Simplification basique WshShell.RegWrite AdSp, NomDuFichier & " General", "REG_SZ"' Declaration de l'emplacement spécifique WshShell.RegWrite AdSp & "DefaultIcon\", AdIcon, "REG_SZ" 'Permet de mettre l'adresse de l'icone à asssocier WshShell.RegWrite AdSp & "Shell\open\command\", Chr(34) & AdApp & Chr(34) & " %1", "REG_SZ" 'Indique le chemin de lexe a ouvrir SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0 'Reinitialise la base dicone par defaut de windows Associer = True 'Fonction a bien fonctionner donc Associer est vrai F: End Function Private Sub Form_Load() Insérer End Sub Sub Insérer() ExtentionAMettreEnRelation = Array("kh1", "kh2", "kh4") 'Matrice des extentions à associer CheminDeLAppli$ = "d:\sp\Khorne.exe" CheminDeLicone$ = "d:\sp\Khorne.ico" NomDuGenreDeFichier$ = "Image Cryptée Spécifique" If Associer(CheminDeLAppli$, CheminDeLicone$, ExtentionAMettreEnRelation, NomDuGenreDeFichier$) Then MsgBox "Changement réussi.", vbInformation, "Super ça a marché!!!" Else: If (MsgBox("Ca n'a pas marché car l'un des paramétre insérer est mauvais.", vbCritical + vbYesNo, "Erreur") = vbYes) Then Insérer 'Si ca a pas marché on demande une réitération de l'opération End Sub
5 sept. 2007 à 18:09
2 août 2006 à 03:18
26 déc. 2004 à 23:55
28 mars 2004 à 21:01
Jattent une amélioration
27 févr. 2004 à 16:35
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.