[HTA sans fichier .hta] Dialogue mot de passe modal et non modal

**omen999** · 04/02/2013, 17h41

bonjour,
un exemple générique de la technique de de l'interface HTA sans fichier.
ce script affiche un premier dialogue modal invitant à la saisie d'un identifiant et d'un mot de passe.
la gestion événementielle permet de contrôler l'identifiant à choisir dans une liste (voir tableau aID) et interdit l'utilisation de chiffre dans le mot de passe.
le deuxième dialogue est non modal et permet au script de poursuivre son exécution pendant son affichage

enjoy

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
Class login
'************************************************************************************************************************************************************
'affiche un dialogue contenant un champ identifiant et un champ mot de passe - http://omen999.developpez.com - février 2013
'toutes versions Windows - aucun prérequis v1.0
'propriétés de l'objet login :
'lHeight,lWidth : hauteur et largeur de la fenêtre d'affichage - par défaut : 140, 300
'lLeft,lTop : coordonnées du bord haut et gauche de la fenêtre - par défaut : autocentré sur l'écran
 
'Syntaxe: création d'un objet progressbar : Set <olog> = New login  (olog est un nom de variable quelconque)
'Méthodes :
' [sStdIn]=Display(sTitle,sMsg,bWithEvents) - affiche le dialogue dans un processus distinct. Méthode par défaut
'                                      				sTitle : libellé de la barre de titre 
'                                      				sMsg : libellé du message du dialogue
'                      								 				bWithEvents : flag activant la gestion des évènements. le dlg devient alors obligatoirement modal
'																			 				Renvoie l'objet StdOut du process mshta (donc le StdIn du script client) qui permettra la lecture des évènements
'
' SetOnEvent(sID,sDataN,sDataS,bSetFocus,bNext  - met à jour le dlg en fonction de l'évènement reçu 
'                                			   				- sID : ID du contrôle concerné
'																 			   				- sDataN : valeur numérique
'																			   				- sDataS : valeur chaine
'																				 				- bSetFocus : flag indiquant que le ctrl ID reçoit le focus - 0 faux, 1 vrai
'																								- bNext : flag indiquant qu'une nouvelle commande SetOnEvent suit 0 faux, 1 vrai
'																			 note : certains contrôles n'exploitent que l'une ou l'autre de ces données
' format des messages : nnnIDnnnsDataNnnnsDataSbSetFocusbNext
' nnn : headers contenant la taille de la chaine ID, sDataN et sDataS
' ID : ID du contrôle
' sDataN : chaine représentant une donnée numérique 
' sDataS : chaine représentant une donnée chaine
' bSetFocus : flag, pas de header
' bNext : flag pas de header
' sEvent=GetEvent(aData) :          - lit les événements envoyés par l'interface HTA - attend jusqu'à réception de l'event
'              												aData : tableau contenant : aData[0] l'ID du contrôle envoyeur, aData[1] la valeur chaine dudit contrôle
'																			renvoie le  nom de l'évènement
' format des messages : nnnsEventnnnIDnnnsValue
' chaque donnée est précédée d'un header numérique de 3 chiffres contenant la taille de la donnée
' sEvent : nom de l'évènement
' ID : ID du contrôle
' sValue : valeur chaine propre à l'évènement
'
' Close()                      			- ferme la pgb après lecture de tous les messages "SetOnEvent"
'
' Kill()														- ferme la pgb immédiatement sans traitement des messages en attente
'
'************************************************************************************************************************************************************
  Private sScript,sAbout,oHta
  Public lHeight,lWidth,lLeft,lTop
	Private Sub Class_Initialize()'maj des valeurs par défaut
		lHeight=164:lWidth=220:lLeft=0:lTop=0
	End Sub
	Public Default Function Display(sTitle,sMsg,bWithEvents)
	Dim spTitle
		spTitle="Login dialog - http://omen999.developpez.com"
		If sTitle<>"" Then spTitle=sTitle
		If bIsPgBar And Not(bUserShft) Then lpShift=1
		sScript="var cOut=new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1),fg=false;document.title='"&spTitle&"';"&_
						"resizeTo("&lWidth&","&lHeight&");moveTo("&lLeft&"+("&lLeft&"==0)*(screen.width-"&lWidth&")/2,"&lTop&"+("&lTop&"==0)*(screen.height-"&lHeight&")/2);"&_
						"function window.onload(){bdy.className='cs';idt.size=14;mdp.size=10;idt.style.height='20px';idt.tabIndex=1;mdp.style.height='20px';"&_
						"mdp.maxLength=10;l1.innerText='"&sMsg&"';l2.innerText='Mot de passe :';btn.style.width='80px';btn.style.height='24px';"&_
						"btn.innerHTML='<U>O</U>k';btn.style.position='absolute';btn.style.right='6px';btn.attachEvent('onclick',btn_onclick);idt.focus();"&_
						"if("&bWithEvents&"==1){mdp.attachEvent('onkeypress',sendEvent);idt.attachEvent('onblur',sendEvent);}}"&_
						"function btn_onclick(){cOut.Write('005close003idt'+('00'+ idt.value.length).slice(-3)+idt.value+'005close003mdp'+('00'+ mdp.value.length).slice(-3)+mdp.value);close()};"&_
						"function sendEvent(){var e=event.type,i=event.srcElement.id,v;switch(e){"&_
						"case 'blur':v=event.srcElement.value;if(v==''){eval(i + '.focus()');return;}break;"&_
						"case 'keypress':v=(event.keyCode).toString();}"&_
						"cOut.Write(('00'+ e.length).slice(-3)+e+('00'+ i.length).slice(-3)+i+('00'+ v.length).slice(-3)+v);readIn()}"&_
						"function readIn(){var h1,h2,h3,id,dn,ds,fo,ne;h1=parseInt(cIn.Read(3),10);if((!isNaN(h1))&&(h1>0)){id=cIn.Read(h1);"&_
						"h2=parseInt(cIn.Read(3),10);if(!isNaN(h2)){dn=parseInt(cIn.Read(h2),10);"&_
						"h3=parseInt(cIn.Read(3),10);if(!isNaN(h3)){ds=cIn.Read(h3);if(ds=='#cls#'){close();}"&_
						"if(eval(id + '.tagName')=='LABEL'){eval(id + '.innerText=""'+ ds +'""');}else{if(id=='mdp'){setTimeout(function(){setInput(id,ds)},10);}else{eval(id + '.value=""' + ds + '""');} }"&_
						"fo=cIn.Read(1);ne=cIn.Read(1);"&_
						"if(fo==1){eval(id + '.focus()');}"&_
						"if(ne==1){readIn();}}}}}"&_
						"function setInput(id,ds){eval(id + '.value=""' + ds + '""');}"
		'maxsize sAbout string : 508 octets current : 507 octets 
		sAbout= "about:<SCRIPT>var cIn=new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0);eval(cIn.Read("&Len(sScript)&"));</SCRIPT><HTA:APPLICATION SHOWINTASKBAR=""no"" SCROLL=""no"" SYSMENU=""no"" BORDER=""dialog"" INNERBORDER=""no""><HEAD><STYLE>.cs{font: 10px MS Sans Serif;background-color:'#E0E0E0';line-height:20px;}</STYLE></HEAD><BODY ID=""bdy""><LABEL ID=""l1"" FOR=""idt""></LABEL><BR><INPUT ID=""idt"" TYPE=""TEXT""><BR><LABEL ID=""l2"" FOR=""mdp""></LABEL><BR><INPUT ID=""mdp"" TYPE=""PASSWORD""><BR><BUTTON ID=""btn""></BUTTON></BODY>"
		Set oShell=CreateObject("WScript.Shell")
		Set oHta=oShell.Exec("mshta.exe """ & sAbout & """")
		oHta.StdIn.Write sScript
		Set Display=oHta
	End Function
	Public Function SetOnEvent(sID,sDataN,sDataS,bSetFocus,bNext)
		On Error Resume Next
		oHta.StdIn.Write Right("00"&CStr(Len(sID)),3) & sID & Right("00"&CStr(Len(sDataN)),3) & sDataN & Right("00"&CStr(Len(sDataS)),3) & sDataS & bSetFocus & bNext
		SetOnEvent=Err.Number
		On Error GoTo 0
  End Function
  Public Function GetEvent(aData)
  	With oHta.StdOut
  		GetEvent=.Read(.Read(3)):aData(0)=.Read(.Read(3)):aData(1)=.Read(.Read(3))
  	End With
	End Function
  Public Sub Close()
  	SetOnEvent "bdy","","#cls#",0,0
	End Sub
	Public Sub Kill()		
		oHta.Terminate
	End Sub
End Class
 
Dim oLog,oEx,oSOut,aData(1)
Dim sID,sEvent,sValue,aID,sIdt,sMdp
Set oLog=New login
aID=Array("mickey","donald","pluto","minnie","daisy")
'********************************* MODAL AVEC EVENEMENTS
Set oEx=oLog.Display("titre","Veuillez entrer votre identifiant :",1)
Set oSOut=oEx.StdOut
Do While oEx.Status=0
	sEvent=oLog.GetEvent(aData)
	sID=aData(0)
	sValue=aData(1)
	Select Case sEvent
	Case "blur"
		If UBound(Filter(aID,LCase(sValue)))=-1	Then
			oLog.SetOnEvent "l1","","Identifiant invalide",0,1
			oLog.SetOnEvent "idt","","",1,0
		Else
			If Filter(aID,LCase(sValue))(0)<>LCase(sValue) Then
				oLog.SetOnEvent "l1","","Identifiant invalide",0,1
				oLog.SetOnEvent "idt","","",1,0
			Else
				oLog.SetOnEvent "l1","","Identifiant accepté",0,0
			End If
		End If
	Case "keypress"	 
		If IsNumeric(Chr(sValue)) Then
			oLog.SetOnEvent "l2","","Le mdp ne doit pas contenir de chiffre",0,1
			oLog.SetOnEvent "mdp","","",1,0
		Else
		 	oLog.SetOnEvent "l2","","Mot de passe :",0,0
		End If
	Case "close"
		sIdt=sValue
		oLog.GetEvent aData
		sMdp=aData(1)
		WScript.Sleep 50 'laisse le temps au flag Status de se maj
	End Select
Loop
MsgBox "l'identifiant : " & sIdt & vbCrLf & "le mot de passe : " & sMdp,,"modal"
 
' ****************************** NON MODAL SANS EVENEMENTS
Set oEx=oLog.Display("titre","Veuillez entrer votre identifiant :",0)
Do While oEx.Status=0
	' insérez ici le code à exécuter pendant l'affichage du dialogue
	WScript.Sleep 50
Loop 
oLog.GetEvent aData
sIdt=aData(1)
oLog.GetEvent aData
sMdp=aData(1)
MsgBox "l'identifiant : " & sIdt & vbCrLf & "le mot de passe : " & sMdp,,"non modal"

**l_autodidacte** · 09/02/2013, 11h23

Merci pour ce code.
Néanmoins, une précision aurait été nécessaire : le fichier doit être exécuté avec CScript.exe(Clic droit et Ouvrir avec l'Invite de commandes) sinon une erreur "Type incompatible:'Read'" se produit à la ligne

Code :

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

GetEvent=.Read(.Read(3)):aData(0)=.Read(.Read(3)):aData(1)=.Read(.Read(3))

**omen999** · 09/02/2013, 17h45

lorsque j'ai commencé à illustrer ce concept, je pensais que j'allais être obligé d'utiliser la version console au lieu de la version gui windows normalement associée à l'extension .vbs
puisque j'avais le souvenir que cette dernière n'était pas compatible avec les entrées/sorties standards console
cette restriction figure d'ailleurs expressément dans la doc wsh 5.6...

à ma grande surprise, j'ai découvert que la v5.7 de WScript avait manifestement fait l'objet d'une maj "silencieuse" sur ce point puisque désormais le process qui héberge WScript
est bien doté de l'attribut console (c'est un simple flag CREATE_NEW_CONSOLE au moment de l'appel de la fonction CreateProcess )

quelle est ta version windows et wsh ?