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 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
|
' ========================================================================================================= '
' 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"
' Activation de l'option avancée "Exécuter en tant qu'administrateur" de raccourcis LNK via "RunAsAdmin.vbs"
' Suppression de tous les fichiers RunAsAdmin.vbs + Chemin_VBS.txt + Chemin_LNK.txt
' ========================================================================================================= '
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
' Dossier racine de l'arborescence
' "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"
strStartFolder = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"
' Chemin script pour la case "Exécuter en tant qu'administrateur"
RunAsAdmin = "C:\LNKtest\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)
DeleteFiles 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 complet0 : " & LNKFull
'WScript.Echo "Chemin complet1 : " & Chr(34) & LNKFull & Chr(34)
ListeVBS(LNKFull)
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & LNKFull & chr(34), 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
Sub DeleteFiles(strRacine1)
'WScript.Echo "strRacine1 : " & strRacine1
For Each objFile In strRacine1.Files
' Suppression de tous fichiers RunAsAdmin.vbs
If InStr(1, "RunAsAdmin.vbs", Lcase(Right(objFile.Name,8))) <> 0 Then
' Chemin Uniquement
LNKPath = strRacine1.Path & "\"
' Chemin Complet avec Nom Fichier LNK
LNKFull = strRacine1.Path & "\" & objFile.Name
'WScript.Echo "Chemin complet0 : " & LNKFull
objFSO.DeleteFile LNKFull
End If
' Suppression Chemin_LNK.txt
If (objFSO.FileExists(outListeLNK)) Then
objFSO.DeleteFile outListeLNK
End If
' Suppression Chemin_VBS.txt
If (objFSO.FileExists(outListeVBS)) Then
objFSO.DeleteFile outListeVBS
End If
Next
For Each objSubfolder In strRacine1.SubFolders
DeleteFiles objSubfolder
Next
End Sub |
Partager