Script d'authentification vbs

**idvbs** · 04/05/2013, 12h14

Bonjour tout le monde.

Je débute en script et je souhaite faire un script qui permet la saisie d'authentification de connexion avec cryptage de texte lors de la saisie du mot de passe. Je sais qu'il est impossible de le faire dans un inputbox c'est pourquoi j'ai cherché une alternative. J'ai trouvé un script qui fait appel a du css pour l'interface de saisie. Voici le script:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 On error resume next
    Dim objExplorer : Set objExplorer = WScript.CreateObject("InternetExplorer.Application", "IE_")
    With objExplorer
        .Offline =True
        .Navigate "about:blank"  
        .ToolBar = 0
        .StatusBar = 0
        .Width = 490
        .Height = 300
        .Visible = 1   
        .Resizable = 0	
		.MenuBar = 0
 
        .Document.Title = "Connexion"
 
Dim strHTML :
 
        strHTML = strHTML & "<P>Entrez votre identifiant:<br> <input type='text' name='user' size='30'>"
		strHTML = strHTML & "<br>" & "Saissez votre Mot de Passe:<br>"
		strHTML = strHTML & "<input type='password' name='password' size='31'><br></p></div>"
        strHTML = strHTML & "<button type='submit' style='font-family:Times New Roman;font-size:14px;height:25px;Width:90px; float:right; ' id='btn_Exit' onclick=" & Chr(34)& "VBScript:me.Value='Enregistrement....'" & Chr(34)& " title='Enregistrement....'>OK</button>" & "</body></center>"
       .Document.Body.InnerHTML = strHTML
	   .Document.Body.Style.overflow = "auto"
.Document.body.style.backgroundimage=""
	   .Document.All("user").Focus
  End With

Le problème se pose au niveau du bouton submit. Je souhaite récupérer la valeur des textes saisies après avoir cliqué sur le bouton ok mais je ne sais pas comment. Les informations récupérées me serviront a exécuter une commande vbs comme un msgbox qui affichera les informations.

Je sais jute faire ca:
user=objExplorer.document.GetElementByID("user").Value
password=objExplorer.document.GetElementByID("password").Value

Et il faut qu'une fois la valeur récupéré que la fenêtre de saisie se ferme.

Pouvez vous m'aidez sur ce cas de figure?
Merci par avance.

**hackoofr** · 04/05/2013, 13h23

Inspirez-vous de ce code : Comment créer un dossier et le protéger par mot de passe par vbscript

**idvbs** · 04/05/2013, 14h09

Bonjour,

Justement le bout de code que j'ai mis est issu du code que t'as cité.
Cependant chez moi ca ne fonctionne pas.
Lorsque j'exécute l'ensemble du code ca me met directement que les champs mdp sont vide ou alors voulez vous accéder au dossier sans demande de saisie du mdp suite au retéléchargement du dossier.
C'est pourquoi j'ai garder que le minimum (du moins une partie dont j'ai compris).
En fait j'ai pas besoin de verification si les deux champs sont vide ou pas.
Juste qu'il récupère les valeurs même si la personne n'a rien saisie dans le champs.

Je n'ai pas compris la partie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

onclick=" & Chr(34)& "VBScript:me.Value='Enregistrement....'" & Chr(34)& " title='Enregistrement....'

**hackoofr** · 05/05/2013, 02h55

A tester chez vous ce bout de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Set colItems = GetObject("winmgmts:root\cimv2").ExecQuery("Select ScreenHeight, ScreenWidth from Win32_DesktopMonitor Where ScreenHeight Is Not Null And ScreenWidth Is Not Null")
For Each objItem in colItems
    intHorizontal = objItem.ScreenWidth
    intVertical = objItem.ScreenHeight
Next
On Error resume Next
Dim objExplorer : Set objExplorer = Wscript.CreateObject("InternetExplorer.Application", "IE_")
With objExplorer
    .Offline =True
    .Navigate "about:blank"
    .Left = (intHorizontal-400) / 2
    .Top = (intVertical-300) / 2
    .ToolBar = 0
    .StatusBar = 0
    .Width = 460
    .Height = 250
    .Visible = 1  
    .Resizable = 0   
    .MenuBar = 0
    .Document.Title = "Connexion"
 
    Dim strHTML : strHTML = strHTML & "<P>Entrez votre identifiant:<br> <input type='text' name='user' size='30'>"
    strHTML = strHTML & "<br>" & "Saissez votre Mot de Passe:<br>"
    strHTML = strHTML & "<input type='password' name='password' size='30'><br></p></div>"
    'l'astuce pour fermer la fenêtre se trouve dans cette ligne qui va nous permettre de changer la valeur du bouton de "ok" ==> "Vérification...." afin de mettre fin au script et a la fenêtre
    strHTML = strHTML & "<center><button type='submit' style='font-family:Times New Roman;font-size:14px;height:25px;Width:90px; float:center; ' id='btn_Exit' onclick=" & Chr(34)& "VBScript:me.Value='Vérification....'" & Chr(34)& " title='Vérification....'>OK</button>" & "</body></center>"
    .Document.Body.InnerHTML = strHTML
    .Document.Body.Style.overflow = "auto"
    .Document.Body.style.background="url('http://www.developpez.net/template/images/logo.png') no-repeat right top"
    .Document.All("user").Focus
End With
'on fait une petite boucle en pause tant que la valeur du bouton a la valeur "OK" sinon la fenêtre va se fermer quand
'elle rencontre cette instruction ==> objExplorer.Quit
'une fois on récupère les identifiants; la valeur du bouton change de "ok" ==> "Vérification...." on peut quitter le script et la fenêtre va se fermer
Do While (objExplorer.Document.All.btn_Exit.Value = "OK")
    Wscript.Sleep 250
Loop
user = objExplorer.document.GetElementByID("user").Value
Password = objExplorer.document.GetElementByID("Password").Value
MsgBox "Nom d'utilisateur est : " &USER &VBCR& "Le Mot de passe est : " &Password,64,"Nom d'utilisateur et Mot de Passe"
objExplorer.Quit
Set objExplorer = Nothing

**idvbs** · 05/05/2013, 09h55

Bonjour,
Merci pour ton aide.

Le code que t'as mis affiche directement la fenêtre:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MsgBox "Nom d'utilisateur est : " &USER &VBCR& "Le Mot de passe est : " &Password,64,"Nom d'utilisateur et Mot de Passe"

Sans prendre en compte si on a cliqué sur le bouton OK et se ferme une fois que j'ai cliqué dessus.
Je vais regarder de plus près. Je pense qu'il n'y a qu'un petit détail a rajouter pour que cela fonctionne correctement

.

Edit: j'ai peut être trouver un moyen de contourner ce problème grâce au format .hta. Je fait des tests et je vous tiens au courant.

Edit 2: solution de contournement en hta grâce au tuto de bbil:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
<HTML> 
 <HEAD> 
<TITLE>Connexion aux lecteurs reseaux</TITLE>
 
		<HTA:APPLICATION ID="AppBonjour"
						APPLICATIONNAME="AppliMEF"
		                       SCROLL="no"
                       SINGLEINSTANCE="yes"
					   MaximiZEBUTTON="no"
					   ICON="favicon.ico"
>
<SCRIPT language="VBscript"> 
window.resizeTo 500,268
window.moveTo 500,300
 
 Function afficher(form2)
 test =document. form2.test.value 
 
test1=document. form2.test1.value 
 
msgbox "hello " & test & " " & test1
 
 End Function 
 </SCRIPT> 
</HEAD> 
 <BODY topmargin="5"> 
 
<FORM NAME="form2"> 
Enter your user and password:
 <div style=' float:right; padding: 23px 150px 18px 130px;  '><p><INPUT TYPE="text" NAME="test" VALUE=""> <br>
 <INPUT TYPE="password" NAME="test1" VALUE=""><BR><br><BR></div>
<div style='float:right'><INPUT TYPE="button" NAME="bout" VALUE="Valider"  onClick="afficher(form2)"> &nbsp;   <input type='button' value='Annuler' onClick='self.close()' name="button"> </div>
 
 </FORM>
</BODY> 
 </HTML>

Après reste a savoir si on peut modifier le code pour que ca s'adapte en vbs.

**hackoofr** · 06/05/2013, 10h53

Un exemple en HTA pour mapper un lecteur réseau :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
<head>
<title>Map Network Drive</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Map Drive"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>
</head>
 
<script language="VBScript">
Dim strDrive
' Declare global variable outside the Subs
Dim intMinutes
Dim intSeconds
Dim strTimerStart
 
Sub Window_onLoad
	strDrive = "\\server\share\"
	If Right(strDrive, 1) <> "\" Then strDrive = strDrive & "\"
	intWidth = 800
	intHeight = 600
	Me.ResizeTo intWidth, intHeight
    Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
    txt_drivepath.Value = strDrive
    intMinutes = 30
    intSeconds = 0
    strTimerStart = intMinutes & ":" & Right("0" & intSeconds, 2)
    span_clock.InnerHTML = strTimerStart
    iTimerID = window.setInterval("DisconnectDrive_Timer", 1000)
End Sub
 
Sub Default_Buttons
	If Window.Event.KeyCode = 13 Then
		btn_mapdrive.Click
	End If
End Sub
 
Sub Update_Path
	txt_drivepath.Value = strDrive & txt_username.Value
End Sub
 
Sub MapDrive
	If Trim(txt_username.Value) = "" Then
		MsgBox "Please enter a username."
		txt_username.Focus
	ElseIf Trim(txt_password.Value) = "" Then
		MsgBox "Please enter a password."
		txt_password.Focus
	Else
		Set objNetwork = CreateObject("WScript.Network") 
		uName = txt_username.Value
		pWord = txt_password.Value
		homeDrive = txt_drivepath.value
		On Error Resume Next
		objNetwork.MapNetworkDrive "H:", homeDrive, True, uName, pWord
		If Err.Number = 0 Then
			Err.Clear
			On Error GoTo 0
			MsgBox "Drive mapping complete."
		Else
			Err.Clear
			On Error GoTo 0
			MsgBox "Failed to map network drive."
		End If
	End If
End Sub
 
Sub DisconnectDrive
	Set objNetwork = CreateObject("Wscript.Network")
	'Set colDrives = objNetwork.EnumNetworkDrives
	'strDrives = "You have the following drives mapped:"
	'For intDrive = 0 To UBound(colDrives) - 1 Step 2
	'	strDrives = strDrives & VbCrLf & colDrives(intDrive) & " " & colDrives(intDrive + 1)
	'Next
	'strToDisconnect = InputBox(strDrives, "Disconnect Network Drive")
	'objNetwork.RemoveNetworkDrive strToDisconnect, True
	strToDisconnect = "H:"
	On Error Resume Next
	----> objNetwork.RemoveNetworkDrive strToDisconnect, True, True
	If Err.Number = 0 Then
		On Error GoTo 0
		MsgBox "Drive has been disconnected."
	Else
		Err.Clear
		On Error GoTo 0
		MsgBox "Failed to disconnect " & strToDisconnect
	End If
End Sub
 
Sub DisconnectDrive_Timer
      If intSeconds = 0 Then
            If intMinutes = 0 Then
                  Call DisconnectDrive
                  span_clock.InnerHTML = strTimerStart
            Else
                  intMinutes = intMinutes - 1
            End If
            intSeconds = 59
      Else
            intSeconds = intSeconds - 1
      End If
      span_clock.innerHTML = intMinutes & ":" & Right("00" & intSeconds, 2)
End Sub
 
Sub ResetForm
	txt_username.Value = ""
	txt_password.Value = ""
	txt_drivepath.Value = "\\server\share\"
End Sub
</script>
 
<body STYLE="font:14 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=1, StartColorStr='#000033', EndColorStr='#0000FF')" onkeypress='vbs:Default_Buttons'>
	<table width='90%' height = '100%' align='center' border='0'>
		<tr>
			<td align='center'>
				<h2>Map a Drive</h2>
			</td>
		</tr>
		<tr>
			<td>
				User Name:<br>
				<input type="text" maxlength="30" size="40" id="txt_username" name="txt_username" onchange="vbs:Update_Path"><br><br>
			</td>
		</tr>
		<tr>
			<td>
				Pasword:<br>
				<input type="password" maxlength="30" size="40" id="txt_password" name="txt_password"><br><br>
			</td>
		</tr>
		<tr>
			<td>
				Drive Path:<br>
				<input type="text" maxlength="30" size="40" id="txt_drivepath" name="txt_drivepath" readonly><br><br>
			</td>
		</tr>
		<tr>
			<td align='center'>
				<input type="button" value="Reset" name="btn_resetform"  onClick="vbs:ResetForm">&nbsp&nbsp&nbsp&nbsp&nbsp
				<input type="button" value="Disconnect Network Drive" name="btn_disconnectdrive"  onClick="vbs:DisconnectDrive">&nbsp&nbsp&nbsp&nbsp&nbsp
				<input type="button" value="Map Drive" name="btn_mapdrive"  onClick="vbs:MapDrive">&nbsp&nbsp&nbsp&nbsp&nbsp
				<input type="button" value="Exit" name="btn_exit"  onClick="vbs:window.close"><br><br>
			</td>
		</tr>
		<tr>
			<td align='center'>
			   Drive will be disconnected in 
               <span id="span_clock">
               </span>
               &nbspminute(s)
            </td>
        </tr>
	</table>
 
</body>

**idvbs** · 06/05/2013, 18h55

Super script qui va surement me servir plus tard

J'ai fait un script qui me permet de faire la même chose mais sans trop de conditions et surtout lorsqu'on clique sur entrer il ne se passe rien contrairement au script que t'as mis.

Edit: après avoir regardé de plus près j'ai réussi a faire ce que je voulais, essentiellement activer la touche entrée. Merci

J'ai même réussi a changer le logo de la fenêtre dans la barre des taches et dans la barre de fenêtre. Par contre pour l'icone du bureau on est obligé de créer un raccourci pour pouvoir modifier l'icone.
La syntaxe est simple (icon="chemin de l'icone au format .ico") mais pour quelqu'un comme moi qui ne connait rien en script c'est beaucoup

Script d'authentification vbs

VBScript

Discussions similaires

Partager

Partager