DominoArea.org [Archive]

Salut à tous,

voici un script LS qui permet d'ouvrir n'importe quel fichier. Le programme va chercher lui même dans la base de registre l'application exécutable à lancer pour pouvoir ouvrir le fichier. Celui-ci utilise les APIs Windows.

Je tiens à préciser que j'ai réussi cela en m'inspirant d'un code vb trouver sur www.vbfrance.com dont l'auteur est GOTH.

Vous trouverez peut-être quelques problèmes ou, vous verez peut-être des améliorations à apporter. Dans tous les cas faites-en part ici pour le partager à tout le monde.

Je crois avoir tout dit....

Partie Déclaration

Code : Tout sélectionner

Const HKEY_CLASSES_ROOT = &H80000000

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyExA"_
(Byval hKey As Long, Byval KeyName As String, Byval ulOptions As Integer,_
Byval samDesired As Long, phkResult As Long) As Integer

Declare Sub RegCloseKey Lib "advapi32" Alias "RegCloseKey" _
(Byval hKey As Long)

Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
(Byval hKey As Long, Byval ValueName As String, Byval Reserwed As Long, _
ValType As Long, Byval Value As String, ValueLen As Long) As Long

Série de fonctions :

Code : Tout sélectionner

'Cette fonction permet de récupérer la valeur d'une clé de la base de registre
Function GetRegValue (Byval MainKey As Long, KeyName As String, ValueName As String) As String
   Dim ValType As Long
   Dim ValSize As Long
   Dim hKey As Long
   Dim Value As String
   
   Value = Space(256)
   ValSize = 255
   ValType = 0
   hKey = 0
   
   GetRegValue = ""
   If RegOpenKey (MainKey, KeyName,0,1, hKey) = 0 Then
      If RegQueryValueEx (hKey, ValueName, 0, ValType, Value, ValSize) = 0 Then
         GetRegValue = Left$(Value, ValSize-1)
      End If
      RegCloseKey hKey
   End If
End Function

'Cette fonction permet de récupérer d'un caractère dans une chaîne
'Exemple : InStrRev("C:\toto.xls", ".") =>8
Function InStrRev (src As String, s As String) As Integer
   Dim b As Integer
   
   If Len(src) = 0 Then Exit Function
   If Len(s) <> 1 Then Exit Function
   
   For b = 1 To Len(src)
      If Mid$(src, b, 1) = s Then
         InStrRev = b
         Exit Function
      End If
   Next
   
   InStrRev = -1
End Function

'Cette fonction permet de récupérer ce qui est contenu entre les % dans un chemin
'Exemple : getEnvironment(%SystemRoot%\System32\...) => SystemRoot
Function getEnvironment (chemin As String) As String
   Dim Debut As Boolean
   Dim pos As Integer
   
   For i = 1 To Len(chemin)
      If Mid$(chemin, i, 1) = "%" Then
         If Debut Then
            getEnvironment = Mid$(chemin, pos+1, (i - pos-1))
            Exit Function
         Else
            Debut = True
            pos = i
         End If
      Elseif Mid$(chemin, i, 1) = " " Then
         Debut = False
      End If
   Next
   getEnvironment = ""
End Function


Et la partie principale :

Code : Tout sélectionner

sub RunApp (fileName As String)
   Dim extension As String
   Dim var As String
   Dim pos As Integer
   Dim tmp1 As String
   Dim tmp2 As String
      
   'Vérification que le fichier existe bien
   If Dir$(fileName, 0) = "" Then
      Msgbox "Le chemin du fichier est incorrect", , "Erreur"
      Exit Sub
   End If
   
   'Récupération de la position du '.' dans le nom du fichier
   pos = InStrRev(fileName, ".")
   'Récupération de l'extension du fichier
   extension = Right(fileName, Len(fileName) - pos + 1)
   
   'Récupération en 2 temps du chemin de l'application à lancer
   'Les extensions se situe dans le dossier HKEY_CLASSES_ROOT dans la base de registre
   tmp1 = GetRegValue (HKEY_CLASSES_ROOT , extension, "")
   tmp2 = GetRegValue (HKEY_CLASSES_ROOT, tmp1 & "\shell\open\command", "")
   
   If tmp2 = "" Then
      Msgbox "Aucune application n'a été trouvé pour lancer le fichier", , "Erreur"
      Exit Sub
   End If
   
   'On regarde si le chemin renvoyé dans tmp2 contient des valeurs entre '%' => Utilisation de variables d'environement
   var = getEnvironment(tmp2)
   
   'Remplace l'expression entre '%' par le chemin réel
   If var <> "" Then
      tmp2 = Replace(tmp2, "%" & var & "%", Environ(var))
   End If
   
   tmp2 = Replace(tmp2, Chr(34) & "%1" & Chr(34), "")
   tmp2 = Replace(tmp2, Chr(34) & "%L" & Chr(34), "")
   tmp2 = Replace(tmp2, "%1", "")
   
   'Association du chemin et du fichier à lancer
   tmp2 = tmp2 & " " & fileName
   
   'Lancement du fichier
   ret = Shell(tmp2, 1)
End Sub


Si vous voulez des précisions sur le code n'hésitez pas à en parler.