Bonjour,
la lecture de ce fil, m'a rappelé que j'avais en préparation un exemple de barre de progression/témoin d'activité
qui avait l'avantage d'illustrer en pratique plusieurs points non documentés du vbs et du FSO.
il s'agit d'un script vbs mais qui utilise dans un process séparé le moteur de rendu IE sans pour autant nécessiter l'écriture d'un fichier .hta
il ne réclame aucune configuration particulière ni composant additionnel et supporte les versions IE 5.5 à 9.
la compatibilité avec la v10 imposera sans doute du code supplémentaire
l'exemple est livré avec la doc minimum en attendant un article plus détaillé sur cette techno qui donne une interface graphique certifiée 100% MS® tout en conservant une séparation stricte entre le code et les éléments visuels à la différence de la prog HTA traditionnelle
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
Class pgBar
'************************************************************************************************************************************************************
'affiche une barre de progression à l'écran pendant l'exécution d'une tâche en parallèle - http://omen999.developpez.com -janvier 2013
'toutes versions Windows - seul prérequis exigé 5.5 > IE > 10
'propriétés de l'objet pgBar :
'lShift : pas de progression (px)(de 1 à lWidth - 28) - par défaut : 10 (témoin d'activité) 1 (barre de progression)
'lRfRate : valeur de rafraichissement de la barre (ms) par défaut : 50
'lHeight,lWidth : hauteur et largeur de la fenêtre d'affichage - par défaut : 92, 428
'note : la largeur de la barre est égale à lWidth - 28
'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 <opgb> = New pgBar  (opgb est un nom de variable quelconque)
'Méthodes :
' Display(sTitle,sMsg,bIsPgBar,bCan) - affiche la pgb dans un processus distinct. Méthode par défaut
'                                      sTitle : libellé de la barre de titre 
'                                      sMsg : libellé des messages du dialogue, peut être actualisé en mode "progression"
'                                      bIsPgBar : vrai, mode "progression programmée" - faux, mode "témoin d'activité" (la barre tourne en boucle jusqu'à sa fermeture commandée) (pas de valeur par défaut)
'																		   bCan : vrai, affiche un bouton 'Annuler' - faux pas de bouton
'																			 Renvoie l'objet StdOut du process mshta
' Change(lPos,sMsg)            			 - met à jour la pgb en mode "progression"
'                                			 lPos : prochaine position relative (en %) entre 0 et 100
'																 			 sMsg : nouveau libellé du message. si chaine vide, le précédent message est conservé
'																			 Renvoie une valeur numérique nulle sauf si 
' Close()                      			 - ferme la pgb après lecture de tous les messages "Change"
' Kill()														 - ferme la pgb immédiatement		
' v1.0 non public release - AtEndOfStream loop and hugly hack for processing messages queue
' v2.0 non public release - no more AtEndOfStream loop which freezes message pump. changt de format des commandes ajout d'un champ header pour le label du msg. 
'                           format msg cmd : PPPHHHLLLLLLL..L
'                           PPP : valeur numérique entre 000 et 100
'                           HHH : header taille du label message entre 000 et 999
'                           L..L : label message
' v2.1 : no more timer loop reading stdin commands
'************************************************************************************************************************************************************
  Private sScript,sAbout,bUserShft,lpShift,spTitle,oHta
  Public lRfRate,lSampling,lHeight,lWidth,lLeft,lTop
	Private Sub Class_Initialize()
		'maj des valeurs par défaut
		lpShift=10
		lRfRate=10
		lHeight=92
		lWidth=428
		lLeft=0
		lTop=0
		spTitle="Progressbar - http://omen999.developpez.com"
	End Sub
	Public Property Get lShift(lParam) 
		lpShift=lParam
		bUserShft=True
	End Property
	Public Default Function Display(sTitle,sMsg,bIsPgBar,bCan)	
		If sTitle<>"" Then spTitle=sTitle
		If bIsPgBar And Not(bUserShft) Then lpShift=1		
		sScript="var f=0,cOut,p;var aT=new Array();var aP=new Array();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.style.filter=""progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#CFCFCF',EndColorStr='#E8E8E8')"";bdy.style.fontFamily='MS Sans Serif';"&_
						"bdy.style.fontSize='9pt';pgb.style.position='absolute';pgb.style.width='100%';pgb.style.bottom='10px';pgb.style.lineHeight='8px';pgb.style.borderWidth=1;pgb.style.borderStyle='inset';"&_
						"pgb.style.backgroundColor='#F5F5F5';lab.innerText='"&sMsg&"';bar.style.posWidth=0;if("&bCan&"){lab.style.width='80%';btn.style.position='absolute';btn.style.bottom='28px';btn.style.right='10px';"&_
						"btn.style.height='22px';btn.style.width='70px';btn.accessKey='a';btn.style.fontSize='8pt';btn.attachEvent('onclick',btn_onclick);cOut=new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1);}else{btn.style.visibility='hidden';}"&_
						"if("&bIsPgBar&"){bar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#FFFFFF',EndColorStr='#00CC00')"";readIn();}"&_
						"else {bar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(GradientType=1,StartColorStr='#FFCCFFCC',EndColorStr='#FF00CC00')"";rgbar.style.position='absolute';rgbar.style.width=pgb.clientWidth;"&_
						"rgbar.style.posRight=0;rgbar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(GradientType=1,StartColorStr='#FF00CC00',EndColorStr='#FFCCFFCC')"";setInterval(updBar,"&lRfRate&");}}"&_		
						"function updBar(){if(bar.style.posWidth<pgb.clientWidth-2){bar.style.posWidth+="&lpShift&";rgbar.style.posWidth-="&lpShift&";}else{bar.style.posWidth=0;rgbar.style.posWidth=pgb.clientWidth}}"&_
						"function updBarT(iPc,n){if(aP[n]<iPc*pgb.clientWidth/(100*"&lpShift&")){bar.style.posWidth+="&lpShift&";aP[n]++;}else{clearInterval(aT[n]);readIn();}}"&_
						"function updData(iPc,sM){var j;if(sM!=''){lab.innerText=sM;};j=aT.length;aP[j]=0;aT[j]=setInterval(function(){updBarT(iPc,j);},"&lRfRate&");}"&_
						"function readIn(){var b,h,c;if(f==0){b=parseInt(cIn.Read(3),10);if(!isNaN(b)){h=parseInt(cIn.Read(3),10);if(!isNaN(h)){c=cIn.Read(h);if(c=='#cls#'){close();}else{updData(b,c);}}}else f=1;} }"&_
						"function btn_onclick(){clearInterval(aT[aT.length-1]);cOut.Write(Math.round(bar.style.posWidth/pgb.clientWidth*100));close()}"
		'maxsize sAbout string : 508 octets current : 350 octets 
		sAbout= "about:<SCRIPT>var cIn=new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0);eval(cIn.Read("&Len(sScript)&"));</SCRIPT><HTA:APPLICATION SHOWINTASKBAR=""no"" SCROLL=""no"" BORDER=""dialog"" INNERBORDER=""no""><BODY ID=""bdy""><DIV ID=""lab""></DIV><DIV ID=""pgb""><SPAN ID=""bar""></SPAN><SPAN ID=""rgbar""></SPAN></DIV><BUTTON ID=""btn""><U>A</U>nnuler</BUTTON></BODY>"
		Set oShell=CreateObject("WScript.Shell")
		Set oHta=oShell.Exec("mshta.exe """ & sAbout & """")
		oHta.StdIn.Write sScript
		Set Display=oHta.StdOut
	End Function
	Public Function Change(lPerc,sMsg)
		'toute valeur incorrecte de lPerc est ignorée
		If (Not IsNumeric(lPerc)) Or (lPerc<0) Then lPerc=0
		If lPerc>100 Then lPerc=100
		On Error Resume Next
		oHta.StdIn.Write Right("00"&CStr(lPerc),3) & Right("00"&CStr(Len(sMsg)),3) & sMsg
		Change=Err.Number
		On Error GoTo 0
  End Function
  Public Sub Close()
  	Change 0,"#cls#"
	End Sub
	Public Sub Kill()		
		oHta.Terminate
	End Sub
End Class
 
Set oPgb=New pgBar
Set oStatut=oPgb.Display("","",1,1)
For iProg = 1 to 10
  If oPgb.Change(10,"Ceci est un message décrivant la progression d'un script: " & iProg) < 0 Then
  	 MsgBox oStatut.ReadAll
  	 Exit For
  End If
	WScript.Sleep 500
Next
oPgb.Change 0,"Fin de traitement"
WScript.Sleep 3000
oPgb.Close