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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
| ' *******************************************************************************
' Script de création RDP 6.1 pour connexion RDP
' Fait par
' Dernière modification:
' Note: SVP ne pas modifier ce script sans l'approbation de l'éditeur, Merci
' *******************************************************************************
Option Explicit
'ON ERROR RESUME NEXT
' **********************************************************************
' Définition des variables
' **********************************************************************
Dim objNetwork : Set objNetwork = WScript.CreateObject("Wscript.Network")
Dim oSh : Set oSh = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim usager : usager = objNetwork.UserName 'Variable qui contient le nom d'usager courant
Dim strComputerName : strComputerName = objNetwork.ComputerName 'Variable qui contient le nom de l'ordinateur
Dim encryptedPassword 'Variable contenant le mot de passe encrypter par la fonction EncryptPasswordRDP
Dim nomapplic : nomapplic = "test" 'Variable qui defini le nom de la connexion RDP
Dim nomicon : nomicon = "test.ico" 'Variable qui défini le nom de l'icone du raccourcis de la connexion RDP
Dim nomraccourcisrdp : nomraccourcisrdp = "test.lnk" 'Variable qui défini le nom du raccourcis de la connexion RDP
Dim nomrdp : nomrdp = "test.rdp" 'Variable qui défini le nom de la connexion RDP
Dim cheminapplic : cheminapplic = "c:\script\" 'Chemin du répertoire contenant les icones de
Dim serverrdpconnection : serverrdpconnection = "le nom du serveur" 'Variable qui défini le nom du serveur de connexion de la connexion RDP
Dim Bureau : Bureau = oSh.SpecialFolders("Desktop") 'Variable qui défini le chemin du bureau de l'usager
Dim userProfile : userProfile = oSh.ExpandEnvironmentStrings("%USERPROFILE%") 'Variable qui défini le chemin du profil de l'usager
Dim winos : winos = FindOSType() 'Variable qui défini si la version du OS
Dim fullpathnameconnexion : fullpathnameconnexion = userprofile & "\" & nomapplic & "\" & nomrdp 'Full path de la connexion RDP
Dim goodOS : goodOS = ValidationduOS(winos) 'Variable contenant la validation si le OS est accepté
' **********************************************************************
' Début du script
' **********************************************************************
if goodOS = true then 'resultat est défini dans la fonction FindOSType, Si le windows est accepté pour le script, on l'exécute (XP et WIN7)
'msgbox "La version de windows est accepté, on l'exécute le script"
if IsMember("le nom du groupe") then 'Si on est membre du groupe, on continu
'msgbox "Member"
if not fso.FolderExists(userprofile & "\" & nomapplic) then 'Verifie si le répertoire des icones existe
fso.copyFolder cheminapplic & "Icones", userprofile & "\" & nomapplic 'Copie du répertoire avec les icones
else
if not fso.fileExists(userprofile & "\" & nomapplic & "\" & nomicon) then 'Vérifie si les icones sont dans le répertoire
fso.copyFile cheminapplic & "Icones\" & nomicon, userprofile & "\" & nomapplic & "\" & nomicon 'Copie des icones
end if
end if
'Encrypte le mot de passe pour la connexion RDP
encryptedPassword = EncryptPasswordRDP ("cmd /c ""\\domain\netlogon\command\cryptRDP5.exe"" motdepasse")
'CRÉE LE FICHIER DE CONNEXION DANS LE PROFILE DU USER
createRDPFile fullpathnameconnexion, "", serverrdpconnection, usager, encryptedPassword
'EVITE DE VOIR LE MESSAGE D'AVERTISSEMENT DISANT QUE LE SERVEUR EST INCONNU
oSh.regWrite "HKEY_CURRENT_USER\Software\Microsoft\Terminal Server Client\LocalDevices\" & serverrdpconnection, 8, "REG_DWORD"
if not fso.FileExists(Bureau & "\" & nomraccourcisrdp) then 'Si deja configurer un raccourci existe, si l'icone n'est pas la on continu
'CRÉE LES RACCOURCIS SUR LE BUREAU
Dim raccourci : Set raccourci = oSh.CreateShortcut(Bureau & "\" & nomraccourcisrdp)
With raccourci
.TargetPath = oSh.ExpandEnvironmentStrings(userprofile & "\" & nomapplic & "\" & nomrdp)
.IconLocation = oSh.ExpandEnvironmentStrings(userprofile & "\" & nomapplic & "\" & nomicon)
.Description = nomapplic
.WindowStyle = 4
End With
raccourci.Save
Set raccourci = nothing
WScript.sleep(500)
'RAFRAICHI LE BUREAU POUR ÉVITER DE VOIR LES ANCIENNES ICONES
oSh.AppActivate "Program Manager"
oSh.SendKeys "{F5}"
End if
Else
'msgbox "Not member"
End if
End if
' *******************************************************************************
' Fonction
' *******************************************************************************
' Cette fonction valide si un ordinateur est membre d'un groupe AD
Function IsComputerMember(sGroup)
on error resume next
Dim objNetwork : Set objNetwork = WScript.CreateObject("Wscript.Network")
Dim strComputerName : strComputerName = objNetwork.ComputerName 'Variable qui contient le nom d'ordinateur
Dim strDomain : strDomain = objNetwork.UserDomain 'Variable qui contient le nom du domaine court
Dim strNetBIOSDomain : strNetBIOSDomain = strDomain
Dim objComputer : Set objComputer = GetObject("WinNT://" & strNetBIOSDomain & "/" & strComputerName & ",computer")
Dim oGroup : Set oGroup = GetObject("WinNT://" & strDomain & "/" & sGroup & ",group")
IsComputerMember = CBool(oGroup.IsMember(objComputer.ADsPath & "$"))
Set oGroup = Nothing
on error goto 0
End Function
' *******************************************************************************
' Cette fonction valide si un usager est membre d'un groupe AD
Function IsMember(sGroup)
Dim objNetwork : Set objNetwork = WScript.CreateObject("Wscript.Network")
Dim strUser : strUser = objNetwork.UserName 'Variable qui contient le nom d'usager
Dim strDomain : strDomain = objNetwork.UserDomain 'Variable qui contient le nom du domaine court
Dim strAdsPath : strAdsPath = strDomain & "/" & strUser
Dim oDict, oUser, oGroup
If IsEmpty(oDict) Then
Set oDict = CreateObject("Scripting.Dictionary")
oDict.CompareMode = vbTextCompare
Set oUser = GetObject("WinNT://" & strAdsPath & ",user")
For Each oGroup In oUser.Groups
oDict.Add oGroup.Name, "-"
Next
Set oUser = Nothing
End If
IsMember = CBool(oDict.Exists(sGroup))
End Function
' *******************************************************************************
' Cette sous routine creer une connexion RDP
Sub createRDPfile(nomConnexion, nomEXE, adress, username, password)
Dim Connexion : Set Connexion = fso.OpenTextFile(nomConnexion, 2, TRUE)
Connexion.writeLine "screen mode id:i:0"
Connexion.writeLine "desktopwidth:i:1024"
Connexion.writeLine "desktopheight:i:768"
Connexion.writeLine "session bpp:i:16"
'Connexion.writeLine "winposstr:s:0,1,1440,0,2800,682"
Connexion.writeLine "compression:i:1"
Connexion.writeLine "keyboardhook:i:1"
Connexion.writeLine "displayconnectionbar:i:1"
Connexion.writeLine "disable wallpaper:i:1"
Connexion.writeLine "disable full window drag:i:1"
Connexion.writeLine "allow desktop composition:i:0"
Connexion.writeLine "allow font smoothing:i:0"
Connexion.writeLine "disable menu anims:i:1"
Connexion.writeLine "disable themes:i:0"
Connexion.writeLine "disable cursor setting:i:0"
Connexion.writeLine "bitmapcachepersistenable:i:1"
Connexion.writeLine "full address:s:" & adress
Connexion.writeLine "audiomode:i:0"
Connexion.writeLine "redirectprinters:i:0"
Connexion.writeLine "redirectcomports:i:0"
Connexion.writeLine "redirectsmartcards:i:0"
Connexion.writeLine "redirectclipboard:i:0"
Connexion.writeLine "redirectposdevices:i:0"
Connexion.writeLine "autoreconnection enabled:i:1"
Connexion.writeLine "authentication level:i:0"
Connexion.writeLine "prompt for credentials:i:0"
Connexion.writeLine "negotiate security layer:i:1"
Connexion.writeLine "remoteapplicationmode:i:0"
Connexion.writeLine "alternate shell:s:" & nomEXE
Connexion.writeLine "shell working directory:s:"
Connexion.writeLine "gatewayhostname:s:"
Connexion.writeLine "gatewayusagemethod:i:4"
Connexion.writeLine "gatewaycredentialssource:i:4"
Connexion.writeLine "gatewayprofileusagemethod:i:0"
Connexion.writeLine "promptcredentialonce:i:1"
Connexion.writeLine "drivestoredirect:s:"
Connexion.writeLine "use multimon:i:0"
Connexion.writeLine "audiocapturemode:i:0"
Connexion.writeLine "videoplaybackmode:i:1"
Connexion.writeLine "connection type:i:2"
Connexion.writeLine "redirectdirectx:i:1"
Connexion.writeLine "use redirection server name:i:0"
Connexion.writeLine "username:s:ledomaine\" & username
Connexion.writeLine "password 51:b:" & password
Connexion.close
Set Connexion = nothing
End Sub
' *******************************************************************************
' Fonction pour trouver le OS du système
Function FindOSType()
' Function FindOSType(strComputer)
'Defining Variables
Dim strComputer : strComputer = "."
Dim objWMI, objItem, colItems
Dim OSVersion, OSName, ProductType
'Get the WMI object and query results
Set objWMI = GetObject("winmgmts://" & strComputer & "/root/cimv2")
Set colItems = objWMI.ExecQuery("Select * from Win32_OperatingSystem",,48)
'Get the OS version number (first two) and OS product type (server or desktop)
For Each objItem in colItems
OSVersion = Left(objItem.Version,3)
ProductType = objItem.ProductType
Next
'Time to convert numbers into names
Select Case OSVersion
Case "6.1"
OSName = "Windows 7"
Case "6.0"
OSName = "Windows Vista"
Case "5.2"
OSName = "Windows 2003"
Case "5.1"
OSName = "Windows XP"
Case "5.0"
OSName = "Windows 2000"
Case "4.0"
OSName = "Windows NT 4.0"
Case Else
OSName = "Windows 9x"
End Select
'Return the OS name
FindOSType = OSName
'Clear the memory
Set colItems = Nothing
Set objWMI = Nothing
End Function
' *******************************************************************************
'Fonction pour crypter un mot de passe pour une connexion RDP avec cryptRDP5.exe
Function EncryptPasswordRDP (command)
'CRÉE LE FICHIER DE CONNEXION DANS LE PROFILE DU USER, ENCRYPT LE MOT DE PASSE DE LA CONNEXION RDP, CHAQUE UTILISATEUR GÉNÈRE SON PROPRE "HASHAGE"
Dim oExec, temporaire
' la variable command doit correspondre à l'exemple qui suit --> "cmd /c ""\\cssscharlevoix.reg03.rtss.qc.ca\netlogon\command\cryptRDP5.exe"" password"
Set oExec = oSh.Exec(command)
While Not oExec.StdOut.AtEndOfStream
temporaire = oExec.StdOut.ReadLine
Wend
EncryptPasswordRDP = temporaire
End Function
' *******************************************************************************
'Fonction qui valide si le OS est accepté
Function ValidationduOS (OSName)
Select Case OSName
Case "Windows 7"
goodOS = true
Case "Windows Vista"
goodOS = False
Case "Windows 2003"
goodOS = False
Case "Windows XP"
goodOS = true
Case "Windows 2000"
goodOS = False
Case "Windows NT 4.0"
goodOS = False
Case Else
goodOS = False
End Select
ValidationduOS = goodOS
End Function |
Extraire mot de passe windows pour l'insérer dans une connexion RDP
Répondre avec citation
Partager