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" |
