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.