App.HelpFile = App.Path & "\Aide.hlp"

Private Sub btnAide_Click()
 
'ouvre le fichier d'aide quand on clique sur le bouton btnAide
SendKeys "{F1}"
 
End Sub

Private Enum HH_COMMAND
    HH_DISPLAY_TOPIC = &H0
    HH_HELP_FINDER = &H0
    HH_DISPLAY_TOC = &H1
    HH_DISPLAY_INDEX = &H2
    HH_DISPLAY_SEARCH = &H3
    HH_SET_WIN_TYPE = &H4
    HH_GET_WIN_TYPE = &H5
    HH_GET_WIN_HANDLE = &H6
    HH_GET_INFO_TYPES = &H7
    HH_SET_INFO_TYPES = &H8
    HH_SYNC = &H9
    HH_ADD_NAV_UI = &HA
    HH_ADD_BUTTON = &HB
    HH_GETBROWSER_APP = &HC
    HH_KEYWORD_LOOKUP = &HD
    HH_DISPLAY_TEXT_POPUP = &HE
    HH_HELP_CONTEXT = &HF
    HH_TP_HELP_CONTEXTMENU = &H10
    HH_TP_HELP_WM_HELP = &H11   
    HH_CLOSE_ALL = &H12     
    HH_ALINK_LOOKUP = &H13
End Enum
 
Private Type structHH_FTS_QUERY
    cbStruct As Long
    fUniCodeStrings As Long
    pszSearchQuery As String
    iProximity As Long
    fStemmedSearch As Long
    fTitleOnly As Long
    fExecute As Long
    pszWindow As String
End Type
 
Private Declare Function HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" _
    (ByVal hwndCaller As Long, _
    ByVal pszFile As String, _
    ByVal uCommand As HH_COMMAND, _
    dwData As Any) As Long
 
Public Sub Show(NewFile As String, Optional WindowPane As String, Optional ContextID)
    Dim Fichier As String
    Fichier = NewFile
 
    If Len(WindowPane) Then
        Fichier = Trim(Fichier) & ">" & Trim(WindowPane)
    End If
 
    If IsMissing(ContextID) Then
        Call HtmlHelp(0, Fichier, HH_DISPLAY_TOC, ByVal 0&)
    Else
        Call HtmlHelp(0, Fichier, HH_HELP_CONTEXT, ByVal Clng(ContextID))
    End If
End Sub
 
Public Sub ShowIndex(NewFile As String, Optional WindowPane As String)
    Dim Fichier As String
    Fichier = NewFile
 
    If Len(WindowPane) Then
        Fichier = Trim(Fichier) & ">" & Trim(WindowPane)
    End If
 
    Call HtmlHelp(0, Fichier, HH_DISPLAY_INDEX, ByVal 0&)
End Sub
 
Public Sub ShowSearch(NewFile As String, Optional WindowPane As String)
 
    Dim Fichier As String
    Dim HH_FTS_QUERY As structHH_FTS_QUERY
    With HH_FTS_QUERY
        .cbStruct = Len(HH_FTS_QUERY)
        .fUniCodeStrings = 0&
        .pszSearchQuery = "TEST"
        .iProximity = 0&
        .fStemmedSearch = 0&
        .fTitleOnly = 0&
        .fExecute = 1&
        .pszWindow = ""
    End With
    Fichier = NewFile
 
    If Len(WindowPane) Then
        Fichier = Trim(Fichier) & ">" & Trim(WindowPane)
    End If
    Call HtmlHelp(0, Fichier, HH_DISPLAY_SEARCH, HH_FTS_QUERY)
 
End Sub

Dim objHelp As Chelp
 
Set objHelp = New Chelp
Call objHelp.ShowIndex(App.HelpFile, "W1")
Set objHelp = Nothing

Dim objHelp As Chelp
 
Set objHelp = New Chelp
Call objHelp.Show(App.HelpFile, "W1")
Set objHelp = Nothing

Dim objHelp As Chelp
 
Set objHelp = New Chelp
Call objHelp.ShowSearch(App.HelpFile, "W1")
Set objHelp = Nothing

Dim objHelp As Chelp
 
Set objHelp = New Chelp
Call objHelp.Show (App.HelpFile, "W1", 320)
Set objHelp = Nothing

regsvr32.exe <fichier>

regsvr32.exe /u <fichier>

Dim MaCle As WshShell 'ou As object
 
Set MaCle = New WshShell 'ou Set MaCle = CreateObject("WScript.Shell")
'nom de votre type de fichier
MaCle.RegWrite "HKEY_CLASSES_ROOT\Test Ext\", "Test Ext", "REG_SZ"
'commande a exécuter pour ouvrir les fichiers de ce type
MaCle.RegWrite "HKEY_CLASSES_ROOT\Test Ext\shell\open\command\", "C:\jmarc\FAQ\TestExt.exe %1", "REG_SZ"
'icone à utiliser pour représenter les fichiers de ce type, ici la troisième icone contenue dans TestExt.exe
'(la première icone a l'index 0)
MaCle.RegWrite "HKEY_CLASSES_ROOT\Test Ext\DefaultIcon\", "C:\jmarc\FAQ\TestExt.exe,2", "REG_SZ"
""
'extension correspondant à ce type de fichier
MaCle.RegWrite "HKEY_CLASSES_ROOT\.jmr\", "Test Ext", "REG_SZ"

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
                                      (ByVal hKey As Long, ByVal lpSubKey As String, _
                                       phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" _
                                     (ByVal hKey As Long, ByVal lpSubKey As String, _
                                      ByVal dwType As Long, ByVal lpData As String, _
                                      ByVal cbData As Long) As Long
 
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const MAX_PATH = 255
Private Const REG_SZ = 1
 
Private Sub cmdAssocExt_Click()
 
Dim MaCle As Long
 
Call RegCreateKey(HKEY_CLASSES_ROOT, "Test Ext", MaCle)
Call RegSetValue&(MaCle, "", REG_SZ, "Test Ext", 0&)
Call RegSetValue&(MaCle, "shell\open\command", REG_SZ, "C:\jmarc\FAQ\TestExt.exe %1", MAX_PATH)
Call RegSetValue&(MaCle, "DefaultIcon", REG_SZ, "C:\jmarc\FAQ\TestExt.exe,2", MAX_PATH)
Call RegCreateKey&(HKEY_CLASSES_ROOT, ".jmr", MaCle)
Call RegSetValue&(MaCle, "", REG_SZ, "Test Ext", 0&)
 
End Sub

Private Declare Sub SHChangeNotify Lib "shell32.dll" ( _ 
ByVal wEventId As Long, _ 
ByVal uFlags As Long, _ 
dwItem1 As Any, _ 
dwItem2 As Any) 
 
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 
 
    Set WshShell = CreateObject("Wscript.Shell") 
 
    For v = LBound(Extention, 1) To UBound(Extention, 1) 
        WshShell.RegWrite "HKEY_CLASSES_ROOT\." & Extention(v) & "\", NomDuFichier, "REG_SZ" 
    Next v 
 
    AdSp = "HKEY_CLASSES_ROOT\" & NomDuFichier & "\" 
    WshShell.RegWrite AdSp, "Khorne File Crypted", "REG_SZ" 
    WshShell.RegWrite AdSp & "DefaultIcon\", AdIcon, "REG_SZ" 
    WshShell.RegWrite AdSp & "Shell\open\command\", Chr(34) & AdApp & Chr(34) & " %1", "REG_SZ" 
    SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0 
    Associer = True 
 
F: 
 
End Function 
 
Private Sub Form_Load() 
    Insérer 
End Sub 
 
Sub Insérer() 
    ExtentionAMettreEnRelation = Array("kh1", "kh2", "kh4") 
    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étres insérés est mauvais.", vbCritical + vbYesNo, "Erreur") = vbYes) Then Insérer 
    End If
End Sub