1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
|
' ========================================================================================================= '
' Cette routine permet d'activer l'option avancée "Exécuter en tant qu'administrateur" de raccourcis LNK
' Il répertorie l'arborescence d'un dossier racine cible dans "Chemin_LNK.txt", créer à la racine
' Il copie le fichier de traitement "RunAsAdmin.vbs" dans chaqu'un des sous-dossiers.
' La nouvelle valeur du chemin du sous-dossier sera inscrite dans le fichier de traitement "RunAsAdmin.vbs"
' ========================================================================================================= '
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
' Dossier racine de l'arborescence
' "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"
strStartFolder = "C:\LNKs"
' Chemin script pour la case "Exécuter en tant qu'administrateur"
RunAsAdmin = "C:\LNKs\RunAsAdmin\RunAsAdmin.vbs"
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Creation du futur fichier contenant le chemin complet de chaque *.LNK
outListeLNK="C:\LNKs\Chemin_LNK.txt"
Set objFile = objFSO.CreateTextFile(outListeLNK,True)
objFile.Close
'Creation du futur fichier contenant le chemin complet de chaque *.VBS
outListeVBS="C:\LNKs\Chemin_VBS.txt"
Set objFile = objFSO.CreateTextFile(outListeVBS,True)
objFile.Close
' Si sous-dossier existe alors communique la variable à la fonction ShowSubFolders
If objFSO.FolderExists(strStartFolder) Then
ShowSubFolders objFSO.GetFolder(strStartFolder)
ExecRunAsAdmin objFSO.GetFolder(strStartFolder)
End If
' Liste tout fichier LNK contenu dans l'arborescence du dossier racine
Sub ShowSubFolders(objFolder)
For Each objFile In objFolder.Files
' Enumère tous les fichiers ShortCut LNK
If InStr(1, ".lnk", Lcase(Right(objFile.Name,4))) <> 0 Then
' Chemin Uniquement
LNKPath = objFolder.Path & "\"
' Chemin Complet avec Nom Fichier LNK
LNKFull = objFolder.Path & "\" & objFile.Name
'WScript.Echo "Chemin complet : " & LNKFull
ListeLNK(LNKFull)
CopieFichier(LNKPath)
End If
Next
For Each objSubfolder In objFolder.SubFolders
ShowSubFolders objSubfolder
Next
End Sub
Sub ListeLNK(strLNKFull)
' Ajout les Chemin Complet avec Nom Fichier LNK dans un fichier
Set objFile = objFSO.OpenTextFile(outListeLNK, ForAppending)
objFile.write strLNKFull & vbCrLf
objFile.Close
End Sub
Sub CopieFichier(strLNKPath)
' Copy le fichier RunAsAdmin.vbs dans chaque sous-dossier et dossier racine
objFSO.CopyFile RunAsAdmin, strLNKPath
ActiveRunAsAdmin(strLNKPath)
'WScript.Echo "Nouveau Chemin Cible complet : " & vbCrLf & vbCrLf & strLNKPath & "RunAsAdmin.vbs"
End Sub
Sub ActiveRunAsAdmin(RunAsAdminLNKPath)
' la procédure recherche un mot clef connu dans un fihier puis le remplace par une autre valeur variable -- strNewText --
' ligne effectuant l'oprération -- strNewText = Replace(strText, strOldText, strNewText) --
'WScript.Echo "Nouveau Chemin Cible Uniquement - RunAsAdminLNKPath : " & vbCrLf & vbCrLf & RunAsAdminLNKPath
Dim oFSO, rech, Ligne
strNewText = RunAsAdminLNKPath
'WScript.Echo "Nouveau Chemin Cible Uniquement - strNewText : " & vbCrLf & vbCrLf & strNewText
strFileName = RunAsAdminLNKPath & "RunAsAdmin.vbs"
'WScript.Echo "Nouveau Chemin Cible et fichier RunAsAdmin.vbs - strfileName : " & vbCrLf & vbCrLf & strfileName
strOldText = "Chemin"
'WScript.Echo "Mot clef à trouver dans le fichier RunAsAdmin.vbs de référence - strOldText : " & vbCrLf & vbCrLf & strOldText
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Si fichier non existant, alors stop
If objFSO.FileExists(strFileName) = False Then Wscript.Quit
Set objFile = objFSO.OpenTextFile(strFileName, ForReading)
rech = 0
While Not objFile.AtEndOfStream
Ligne = objFile.ReadLine
' Recherche la présence strOldText et combien de fois
If Instr(Ligne, strOldText) <> 0 Then rech = rech + 1
Wend
'WScript.Echo "Mot clef à trouvé " & vbCrLf & vbCrLf & rech & "x" & vbCrLf & vbCrLf & "dans le fichier"
objFile.Close
Set objFile = objFSO.OpenTextFile(strFileName, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, strOldText, strNewText)
Set objFile = objFSO.OpenTextFile(strFileName, ForWriting)
objFile.Write strNewText
objFile.Close
End Sub
Sub ExecRunAsAdmin(strRacine)
WScript.Echo "strRacine : " & strRacine
For Each objFile In strRacine.Files
' Enumère tous les fichiers RunAsAdmin.vbs
If InStr(1, "RunAsAdmin.vbs", Lcase(Right(objFile.Name,8))) <> 0 Then
' Chemin Uniquement
LNKPath = strRacine.Path & "\"
' Chemin Complet avec Nom Fichier LNK
LNKFull = strRacine.Path & "\" & objFile.Name
WScript.Echo "Chemin complet : " & LNKFull
ListeVBS(LNKFull)
'CreateObject("WScript.Shell").Run LNKFull
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run strRacine.Path & "\" & "RunAsAdmin.vbs", 0, True
'WshShell.Run LNKFull, 0, True
End If
Next
For Each objSubfolder In strRacine.SubFolders
ExecRunAsAdmin objSubfolder
Next
End Sub
Sub ListeVBS(strLNKFull)
' Ajout les Chemin Complet avec Nom Fichier VBS dans un fichier
Set objFile = objFSO.OpenTextFile(outListeVBS, ForAppending)
objFile.write strLNKFull & vbCrLf
objFile.Close
End Sub |
Partager