IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Vos Contributions VBScript Discussion :

[HTA sans fichier .hta] l'ultimate progressbar


Sujet :

Vos Contributions VBScript

  1. #1
    Rédacteur
    Avatar de omen999
    Profil pro
    Inscrit en
    février 2006
    Messages
    1 276
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2006
    Messages : 1 276
    Points : 3 448
    Points
    3 448
    Par défaut [HTA sans fichier .hta] l'ultimate progressbar
    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
    nomen omen, nemo non omen - Consultez la FAQ VBScript et les cours et tutoriels VBScript
    le plus terrible lorsqu'une voiture renverse un piéton, c'est que ce sont les freins qui hurlent. (ramón)
    pas de questions techniques par mp

  2. #2
    Membre à l'essai
    Profil pro
    Inscrit en
    juillet 2009
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juillet 2009
    Messages : 11
    Points : 19
    Points
    19
    Par défaut Ultimate Progress
    Bonjour,

    En premier lieu, je dois dire que je ne suis pas un expert de la programmation, mais plutôt un autodidacte qui apprends sur le tas (un très gros tas, depuis le temps... que j'apprends...) grâce à des personnes comme vous, à des sites comme celui ci. VB6, VBA, VBSCRIPT, un peu HTML, un peu tout, car je suis un éternel optimiste passionné qui croit naïvement que tout s’apprend et que rien n'est inatteignable... mais bon, qu'est ce que c'est bon !!!

    J'ai du, ces derniers mois, travailler sur un projet de traitement de données afin d'aboutir à un genre de "planning" genre "Gantt". C'est pour le CE de ma boite qui gère une foultitude d'appartements en loc et qui a besoin d'un visuel rapide de ce qui est déjà occupé, ou non, à quel moment etc.

    Les données exportées au départ d'un soit disant logiciel "Pro" sont vraiment en vrac, et j'ai du, entre autre, recourir aux expressions régulières pour aboutir.

    Du coup, ce traitement est relativement long, et c'est ce qui m'a conduit à cette page...
    Comment indiquer ce qu'il se passe... pendant que rien ne se passe à l'écran...

    Mon travail de traitement des données s'exécute à travers un VBScript (transformable en "exe"), puis lance Excel en mode invisible (avec USF et vérif d'erreurs de saisie dates etc.) pour finir avec un fichier "xlsx", un autre en "csv" et enfin un dernier en "xlsm" --> le Planning qui est créé par code dans la foulée (Mise en place d'un TCD + simili Gantt).

    Du coup, à mon piti niveau, je trouve l'idée présentée ici vraiment sympa !

    Un VBscript qui crée, et gère, un HTA... un "indicateur" d'activité"... j'adore !!!

    Génial, c'est ce qu'il me fallait !

    Mais... GRABOUILLA !!!. --> c'est du VBSRIPT qui traite un piti peu de html et qui prévoit d'écrire du JSCRIPT dans le HTA... c'est ça ?
    Et là, c'est légèrement au dessus de mes compétences, même si à la lecture assidue du truc, je "conceptualise"...
    Hélas, cela ne suffit pas pour modifier ou améliorer...
    Alors je me tourne vers l'auteur (:>)

    J'ai tourné beaucoup autour de cette présentation.
    Et, j'ai quelques questions :

    Soit, je n'ai pas su utilisé le truc comme il faut, soit je demande à comprendre :

    1) Je me suis débrouillé pour adapter à mes besoins, mais ce n'est pas optimum :
    --> suivre l'évolution de mon script : --> Mode "continu"
    Préparation des répertoires
    Je tue le process HTA ... pas glop !
    Répertoires OK
    Je tue le process HTA ... pas glop !
    Préparation des fichiers
    Je tue le process HTA...
    Fichiers Ok
    Je tue le process HTA...
    Extraction et traitement des données
    ... etc ...


    Et ça clignote pas mal à l'écran !

    a) En mode "programmé" je n'arrive pas à enchainer les messages plus d'une fois.
    b) En "mode continu", hormis en "tuant" HTA, pas moyen de mettre à jour le sMsg
    c) en mode "programmé", si j'enchaine plus d'une fois, la barre "déborde" du HTA --> message d'erreur... Sauf à dire de gérer le "Change" à - 100... mais la barre de prog ne redevient pas vierge

    2) Là où je me suis régalé, et avec l'aide de l'un de mes fiston (qui est de la partie) nous avons trouvé une soluce, c'est sur le look du truc :
    a) Intégration d'une image GIF encodée en "Base 64" comme image de fond.
    Image crée par mes soins, à la dimension voulue, animée, et, du coup, sans recours à une adjonction dans un répertoire quelconque, puisque '"embed" dans le code. Encodée, intégrée dans le code lui même. ça fonctionne nickel ! (il faut virer le background color et le gradient, car selon la config de IE selon les postes utilisés, des fois c'est le gradient qui prends le dessus)

    b) Transfo et intégration du script de l'auteur en Module de classe pour VBA Excel... ça fonctionne NICKEL !!!


    Vala, je crois que je suis au bout de mes questions.

    Ah si, une de plus... pourquoi le "About" est limité en octets ?


    S'il faut que je joigne quelque fichier ou code que ce soit, pas de souci, le partage est l'unique ressource de connaissance universelle qui tirera l'ensemble vers le haut... alors ce sera sans hésitation. ... heu, même si au moment ou j'écris ces lignes, je ne sais pas comment on fait.... loool (:>)


    A tout bientôt,

    François.

  3. #3
    Rédacteur
    Avatar de omen999
    Profil pro
    Inscrit en
    février 2006
    Messages
    1 276
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2006
    Messages : 1 276
    Points : 3 448
    Points
    3 448
    Par défaut
    bonjour,

    il s'agit d'un exemple de programmation asynchrone entre
    deux process qui n'est pas évident à résumer en quelques lignes...

    il devait illustrer un article sur l' "undocumented vbscript" qui est toujours
    en chantier

    avant toute chose, je constate que l'essentiel de ton travail à l'air d'être exécuté par une
    instance "silencieuse" d'Excel
    ne serait-il pas plus simple d'écrire l'ensemble du code sous la forme d'une macro vba
    sous Excel, macro qui pourrait alors gérer directement la progressbar dans une
    "form" du tableur ?

    ceci dit je n'avais pas, dans cet exemple, de travail particulier à faire exécuter à mon code
    c'est pourquoi dans la boucle principale (lignes 92-98), je me suis contenté d'un simple Sleep 500 (ligne 97)
    bien évidemment, dans le cadre d'un travail concret il faut remplacer cette dernière ligne par l'ensemble
    du code fonctionnel en prenant soin de le fractionner par étape pour que la boucle soit effective

    dans mon exemple, la boucle comporte 10 étapes mais c'est complètement arbitraire
    il faut donc l'adapter à la situation réelle en prenant soin d'exécuter successivement les différentes étapes
    du code fonctionnel en adaptant à chacune d'entre elles le pourcentage de progression de la barre - simple...

    Ah si, une de plus... pourquoi le "About" est limité en octets ?
    la limite de 508 octets du protocole "about:" n'est pas documentée mais elle existe également pour d'autres URI
    mon avis - purement personnel - est que le parser de la ligne de commande URI a été volontairement
    limité - pour ne pas à devoir gérer la fragmentation - à la plus petite taille de données que le protocole UDP/IP
    accepte à savoir un MTU de 576 octets qui déduction faite des headers de 68 octets donne 508...
    et voilà pourquoi votre fille est muette
    nomen omen, nemo non omen - Consultez la FAQ VBScript et les cours et tutoriels VBScript
    le plus terrible lorsqu'une voiture renverse un piéton, c'est que ce sont les freins qui hurlent. (ramón)
    pas de questions techniques par mp

  4. #4
    Membre à l'essai
    Profil pro
    Inscrit en
    juillet 2009
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juillet 2009
    Messages : 11
    Points : 19
    Points
    19
    Par défaut Dernière question sur le sujet
    Merci de ces réponses.

    J'ai compris le fonctionnement en mode "progression" tout au long de mon code.
    y compris dans la partie Excel.

    Ci-dessous, et en PJ, l'image de fond utilisée avec mise à l'échelle du HTA, sans bordure etc. etc.
    J'ai adapté les couleurs du sMsg et de la barre de progression.
    L'image est intégrée encodée en base 64 dans la parti JS de la fonction "Display"... :
    "function window.onload(){bdy.style.backgroundImage=""url(data:image/gif;base64,R0lGODlh3AA8APf/AKCQKHJxXpK......


    Nom : BackGround.gif
Affichages : 711
Taille : 4,4 Ko


    J'ai bien lu les fonctions readIn, upData etc. et sans maitriser totalement la syntaxe du langage, j'en comprends à peu près le sens et l'objet.
    j'ai bien pigé que cette partie est écrite "à la volée" lors de la création du HTA et que tout ça sert au fonctionnement de l'ensemble.

    Du coup je me demande si il existe un moyen, une fonction ou autre, qui permettrait de modifier le message en cours de fonctionnement en mode "Témoin d'activité"... ?

    En tout cas merci encore.

    Et ci dessous 2 images encore dans l'esprit "témoin d'activité"

    Nom : PgrBComplet.gif
Affichages : 708
Taille : 11,7 Ko


    Nom : PgrBComplet2.gif
Affichages : 721
Taille : 18,0 Ko


    A bientôt,

  5. #5
    Rédacteur
    Avatar de omen999
    Profil pro
    Inscrit en
    février 2006
    Messages
    1 276
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2006
    Messages : 1 276
    Points : 3 448
    Points
    3 448
    Par défaut
    joli custom, poste le code

    Du coup je me demande si il existe un moyen, une fonction ou autre, qui permettrait de modifier le message en cours de fonctionnement en mode "Témoin d'activité"... ?
    non, la fonction Change n'est prévue que pour le mode "progressbar"

    il faudrait remanier le code js du script...

    faire une vraie doc sur ce type de prog "hta sans hta" fait partie de ma to-do list
    nomen omen, nemo non omen - Consultez la FAQ VBScript et les cours et tutoriels VBScript
    le plus terrible lorsqu'une voiture renverse un piéton, c'est que ce sont les freins qui hurlent. (ramón)
    pas de questions techniques par mp

  6. #6
    Membre à l'essai
    Profil pro
    Inscrit en
    juillet 2009
    Messages
    11
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : juillet 2009
    Messages : 11
    Points : 19
    Points
    19
    Par défaut HTA sans HTA
    Bonjour,

    Oui, une vraie doc sur ce concept serait intéressante.
    Mais un sacré boulot !

    Si ça peut être utile, ou intéresser quelqu'un, je pourrai ajouter aussi le truc pour VBA/VBE --> Module de Classe.
    Cela permet d'utiliser ton concept directement depuis MS Office sans recours externe.
    Je l'ai testé sous Excel 2007/2013 en 32 & 64 bits et sous Windows 32 & 64 bits aussi évidemment.


    Pour le moment :
    Le code VbScript - PgrBar HTA sans HTA - avec image embarquée :
    Tu va voir que pour comprendre au mieux le fonctionnement de ton travail, j'ai bien "étalé" ton code...
    Sans aucune déstructuration, bien entendu.


    A bientôt,

    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
    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
     
    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,bUserShft,lpShift,spTitle,oHta
      Public lRfRate,lSampling,lHeight,lWidth,lLeft,lTop,sAbout
     
    	Private Sub Class_Initialize()
    		'maj des valeurs par défaut
    		lpShift=10
    		lRfRate=25
    		lHeight=60
    		lWidth=220
    		lLeft=0
    		lTop=0
    		spTitle="Traitement"
     
    	End Sub
    	Public Property Get lShift(lParam) 
    		lpShift=lParam
    		bUserShft=True
    	End Property
     
    		'Image codée - sur une seule ligne pas facile à travailler
    		'background-image:url(data:image/gif;base64,R0lGODlh3AA8APf/AKCQKHJxXpKRgzMyIpGQgo6OfxgYBouKeCgnFSopF5WUhZSShEVCKouKdyIhDhcWBYaFcmJhT21kGnt7aWxrVmhkUSAeDp6cj6CPJnxwI4yMenptIQs9DJqLJpGPgBYVA5SRglKLUj48JALKAqWUKEFAKlNLCzEtGm9sVhUUAkA+J5aVhXFuU5iXiCYlFHBtXZqYimtoUlRTOp2bjoSCb4eFdIiGdHBtWJOQgk9NOYyNfiUkEYuIdm1nKoKBbmZNQoqKdiwqGUpJNHJwYUVEK4yNfKORJTEwH5SGKWRiUSIgESooGW5tWcjIAoJ3KZeVhR0cCpyOKWZdEoB0J5ybjImHdm9qQW9rOBQTAVlXQRMRApuZjFpSDSknF0ZFLRwaCJ4BBZCOfp6ajkRCMTMyFJGQgVMOEYyKdxoZB3RyYjg3J5yMKYmJdXZ0ZWZkT01FCFJMEaqZLYWDcSQiEI2LeEY9B6WUJh4eC5OLUm9uWJKSg21sUqSTJZ+dkK2cMIWEcf/WAJuNKUNBLi0pHKmYJW1rWIqJdYmIdnV0YYeFc2ppUy4sHXBvXllWPzw6IJKRgI2NfBcKF2NhUW9tWm1sV5mJK5eIKDc1IH0DCBgWCH9+bGtmVBIdDYyOfTEvH42Me6mXJYmFdW9sTBQSBJWTg2xpUoaEcx8UGS4rGUhFMiwqDycjFhwaCysqFy4pIAlSBhcSCx8uGxMUAVVUQhUPCighD42Of4+Qgo+PgY+PgI2OfoyOfo+Rgo+Qg4+Pgo+Rg4yOfwZkB52OK4+OgI6Pf5OThY2OgBcYBoyPf46OgMEBBIuLeWhjUJmMLY6NfpaGJo+OgQC3AAh4CWplRGplUKWTKBISA3FtTwcJAGZkVH+AcWBYEoGCczAvEl9dSJmLLIZ6KJiWhmdoVGtpWI6Oe0dHLlNSQFNTRVNUR1RTQURCK46PfnN1ZI6OfY+QgXNyX5KAGnRwV4mHdY2OfIKAbFdURo6PgXV1aHp2YKGQIhgXBkM7Bf/XAKWTJhkYBv///yH/C05FVFNDQVBFMi4wAwEAAAAh+QQFBQD/ACwAAAAA3AA8AAAI/wD5CRxIsKBAQIAMKlzIsKHDhxAjSpxIsaLFiwq5mNjIsWNHOCBziLzzBaPJkyhTqhwopJ6EDTAzyJwiM8OUmzed5HTCUydPcD174swAc0PNom/2CZTSBt+VKxKiSujR44qVa/HisRA1LU+eG2TQEBoLigQJO2bT9gPVL201EoTKpiUBoG5dugD4mNVLgo8dO3z42LWLAQAGDEbqYuBjxMjhKFGE1Y1CuDCGQFECYf4WOTNkyJM7S44sbA2AKJYPH86nulKgb82aRVmzpkOHNZaeWUKCxJJv2x2ePYP3hcwLRu8CKF+u/J3z584RBWA0nVGa60OyB3gnfXuAIdfTgP9v04YdOwkmlr5gYaW9FVEsWNyY/+IGij1X9uz5mqebvzAe4LAAKQSSAsKBpChAygIDKrDCEwmuIKECTzzh4AoKOPiEhBVWGM6HHX4oYgsklgjDiS2cCAOJJ26hIgxbbEHFjDTWSMUMOOaoI443zkDFBUDmeMEMQF7QR5E7EglkH0cWeeQMYmxhCzdQkJHNC1gyoSUlFFBQiJdaFkLJmF2OM44kEUiSxJpoRuBmBElkk4Sac65Zp5vipMfPNhLc4NV8/KEwyaAvTHLDJEwUUohXeajiDz2a0EOPDzRUSgOllFYqxx9/yCGHKRD8YUoipEKQiA012FAFD1UccsAhQBz/IOsBPJxxwBln0LHMrrouowEdnwAL7CfEQvKJM2EA6MGyHpThLLPNPkKAACBQO2CB2CaYYYYRYqgtgQ5mWEwx4pIbrrnbLmCLLdp80Y0iWPrRz7z01mvvvfjmq++8Su3ZQx5dUjKffSgUPGgehhb8pSJ5MOGAP5HS8IepEJiaCAQ22JDIqKdmLM/HPITMgyFnkEzHySdr8ImxK0PissvkzFNEES6v3I4zzuiigw4FOFPAMLkEHXQZBBRNANFGE/AIDiDoUcwCT0M9rtNPo7ttuXoIMK0AAmTNNdfTep110gSsa4smaAhRCiWFyNvKAAMcAfcllzjQRT9qwB233EfI/61GP3IP4IknfcPdN+B7H7HI4kr4I0g/dQjEhQQolBLD5ZhjXgoFpVhOzSagU+AVBV/4MwE9EstRsSk11MB66xubakMoH7NxyMiGkHxGAw3guqsGwAM/8846QEK8LrbsskvyuwADjA67QI/8usQUYMvPP68jdNAe5OJLGbj4govQuLiTCy7o41JG19UKsADY4uPCCwHo2zMMNL74cgv6vkCTyzDJSMYwiLEuY0wADaqghiIiIC9UFK5vhXMAAvpxiSN4wnCEs+AAECe4uA3Ogp4AnCcWR8JFNO5vb5CcBKhBjRhQww1uoEYFZFiBCjDDhhWAYQ0rwCg3PGwCmqDU6v9aB4FUuc5TGMuYDeRxCDbYznYjAwIQltEAIFTxdxqY2Tx00Ild6OKLtgCGF734POVFTxfPswUygGEMYyADGQUkoC2MYYt1VK8AyAOGLao3vS/iggC+GAYAx0cMoRGDGOMLWvWAJsfr7Wxdj1zXBPwhBDRlQV4IQEUQEtCKTrYiCEtwwBL64YkuLKELplzCKbuwCMQtYgmgdIELUHm3I9CyC7Psgj8W8Tc97WNfwGyLG7zijTuYThOqw1irqlCFjFUhFMxclch4x7tZHQBYKvvEzIoFCe2dL5Hnu8UveEHOcd7inLfoxS0IgM5z8uKcveCFOn+RTl78gp3s1F/+9Nf/C3rewp69iOf+0pnOXxj0oAaV5z8DOk517g8XAljXPeawA29kQQbycoAD5uCAO9zBAhpVgkaD0I8lWMACUIDCR++ghDvMAXAmtIASZnrSmQJupkqoqQX8sYQQppAfvzwBKjQZBE0SNQhILWpSE5AAkpKAYXvwwhfMMYuqWvWqWM2qVrfK1a569atgDatYtZoOfzigETJohLzQgAZ96IOt+vAHGvxhVgcMoh9z0MIoPpCJBzwgE8ewBisAFwRWvLWtmcgEKwZ7BL/yNbF0VWU/+vVLVHRyk11o6iaXwNTMZjYBt+xHHCjBiCGogAyXcIQjRKCC1rrWtSVggAoYoA4i/3jBC0RQx21ri9vceqEcv71tKlIBXAYwgAjITa5xl8vc5dZWucclQnOZK13qIne61MWudqvbXCKU47RkKAcZcpBWefnDr5n4wAP8EVf2ZkKjDujHDlKQWPR+IAWjgAJh9aHeD/jXr/oA3AdGsVe6+gOVLpisQH6JSwQgwAU7cMGDZTlLCsvSwZ3thx/GcA50HKEbqFWtiEVAYhK3lrUohm0JVFCCFrdYHYJosSAEMYYaq8PFOM6xjnfM4x77+MdA1rE6REJkkaTCvH79ayb08QC3uvUBWHBAK/rhghQAmL1PvgPgunDfJKcAC2AGnJI/YOAlyFLBQA2mmtfM5ja7+f/NcI6znOdM53tRth8nha8DQLrnOcwBpH4ONEc3Omj4cvQLX7iDA3awA4o2eg6yjDCEd+BgCSNYll1AACdB2wrQanoQg9g0J5HK1FKb+tSoTrWqV83qVp/awLCOtaxnTeta2/rWBkbzL+UKBUSrNKUp9fUdUjpsYCPa18DudenQ8FELePSje1a0Rk+a50ITWtAcDfRMV9FobrtgFauwsLjHbeFwP7jSDk63utfNbnZLGN3rnvUosOGPXi+WFW2NtQGcLFe5svXfaEA0rmXN1i+wItjH/oKyEa3rfgz84RCPuMQnTvGKW/ziGI94w53M8Y57/OMgD7nIR07ykpv85Cj/T7nKV87yjzecrbC+r3ofkIIU+Lfm6v0yFnCuc5z318pM9u9//WrzoQtd6DVPul93XnSe7/wB9625LG6uczA3XRY253nSkX7zo/tXFmCWhditDmYwa0GvBD67NaxB4Laf/e1YaPsozI4FrCe97GfHetzBzHZraMHvb9cCFpAu+KR/2edfPjsW1s54xv+94QSn677bC2uOY9nycnWr5AkO8LnGGuSXDz3l6cpvA1Me5AbwhwFWn3pYt77ycdU8e02veic32cmTb/m+c2+AY/Ae5JnwfOlhf3nZ5/7JTYZ8xpfP/OY7f/P6WD2WSa/6ydPe9NJ//sXjqnxat/f12g+///jHT/7yc//O5U+/+tfP/ua7tfvtj7/85z//5KNf36kHP/33z//+R9z+C+Zwn6d//leABniA5xVg91d57EWACPiAEKh+AJhmshZ9oxeBGJiB4TeBu/Z5GviBIOh8HCiAxBeCJniCEjeCFXiBKNiCLgh78Ed6LPiCNHiC77eABrZvNbiDLXiDAShr1seDQviBPkiBnzeDQ5iEBliEHeh6SviEEMiEJJiDDgiFVih/UgiEVXiFXCiBCviDHtiFYhh/KqhvY3iG61eGsHYMaNiG5KeGBuZ7bjiHzweHpLeFdJiH//eFRhiGeviHFGeHtQeIhJiCfNiEpoeEhbiIRxiD05XHiJDofYc4hXTVZNkXiZiIZY44fJkYiVmIf53YiZ/IgKGYiaOYiHhYinR4ijKYiqrohqz4iK+4iLH4AK44i2hYi7eIi2MYi4rIi7BoAA1XZ8RYjMZ4jMiYjMV4Z8rYjM74jNAYjWtGWftQjdZ4jdiYjdq4jdzYjd74jeAYjuI4juRYjuZ4jtq4Euq4juzYju74jg4REAAh+QQFCgD/ACyrAAUAKwAHAAAIZQD//Rt0KtIpTwPmCFzIsKHDhxA9XcLTpMkJiBgzMhyEyQymVQLVUKyosSREMz+UKTOjhFWkiiRNyhRYC5NKMJgERnpTsZbAIDNNmlFmM+e/Oyb2WYAVVCYWWJg6Mm1KVaA+hgEBACH5BAUKAP8ALKsABQArAAcAAAhiAP8JHPjvkgOCCBMqXIhwQKwQwYLFYkix4r9FGDEKDBZixIhgXSyKRNili4uSDu4E8zhC2siX/5QosWBh5sAR0UZwmgNz5IdMQP0J5PSKA6eeI0eN+uCv6cAHAj8gFZmJYEAAIfkEBQoA/wAs0AAGAAYABgAACCYA/w3CZAbTqn9mfihTZqYWpoVgMCFU9hATFliYCML6p++fx38BAQAh+QQFCgD/ACy3AAUAHwAHAAAIWQD//Rt0KtIpVwITKlzIkOElPE2anGhIUeGiixcFqoEYsaLHLl1cgLxTMGJHjw2VKLFgYeW/D5HeRKz1bxRKhh8y6fT37wEUE/ss0LrJcNSoD/6SEiWaSWFAACH5BAUKAP8ALLcABgAfAAYAAAhZAD0NiBUiWLBY/xIqXMhw4SBMZjCtShgsxIgRwRpqbGjmhzJlZixYCHZxhLSNKP/VwvQRDKZ/o/6NiDaCU0qUZpSxxPThA6dXHGze1IgFFiaIsIYq/advYUAAIfkEBQoA/wAs0AAGAAYABgAACB8AFwkc2KWgi4JKlFiwoPDBh0wQ/Y0a9cGfRYgVLQYEACH5BAUKAP8ALMQABQASAAcAAAhQAP8tORXplKt/CBMqTHgJT5MmJxYiHITJDKZV/9Q4fCjxn5kfypSZsRDpIceFtTCFBIPpX6Q3D2t1NKNMZUsoJvZZoCURCyxMFWF1lKhPYUAAIfkEBQoA/wAsxAAFABIABwAACFMA/3X5R7CgwYP/1MQKESxYLIT/FkmU+C9YiBEjgq1C2KWLi45KgmEcIQ2hEiUWLKAkOCLaCE5oEH7IRNPfP06vOHCChXDUqA/+gv6TBdFgJoMBAQAh+QQFCgD/ACzQAAYABgAGAAAIJgD/DcJkBtOqf2Z+KFNmphamhWAwIVT2EBMWWJgIwvqn75/HfwEBACH5BAUFAP8ALKwABQAqAAcAAAifAP8NODJgwKV/CBMKPELwiMKEnjwxHPCw4r+GDB0qPOKpIEeNCgd05OjJ4qKTJ/+1WtkqyJKKXbosmWlxiUsXLrrA7JJT5x0LDhwosQgFys87Fi0oWWqhIlOlTfX5Q+PPn4N/gxR+yPTgQaZ/1h7qQ4NGX6avD7ee9fdPqj+zD1Oc7Zrpg8UPDz7orThq1IeqbNsifGCxsMIUhhGiRRgQADsAAA==)">
     
    		'Anciens éléments (fonction window.onload du HTA) couleur du fond et dégradé
    		'"bdy.style.backgroundColor='#000000' ;"&_      
    		'"bdy.style.filter=""progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#000000',EndColorStr='#E8E8E8')"";"&_		
     
    	Public Default Function Display(sTitle,sMsg,bIsPgBar,bCan)
    			'Variable string code image gif animée codée en base 64
    		    UrlGif = "R0lGODlh3AA8APf/AKCQKHJxXpKRgzMyIpGQgo6OfxgYBouKeCgnFSopF5WUhZSShEVCKouKdyIhDhcWBYaFcmJhT21kGnt7aWxrVmhkUSAeDp6cj6CPJnxwI4yMenptIQs9DJqLJpGPgBYVA5SRglKLUj48JALKAqWUKEF" & _
    			"AKlNLCzEtGm9sVhUUAkA+J5aVhXFuU5iXiCYlFHBtXZqYimtoUlRTOp2bjoSCb4eFdIiGdHBtWJOQgk9NOYyNfiUkEYuIdm1nKoKBbmZNQoqKdiwqGUpJNHJwYUVEK4yNfKORJTEwH5SGKWRiUSIgESooGW5tWcjIAoJ3KZeVhR0cCpy" & _
    			"OKWZdEoB0J5ybjImHdm9qQW9rOBQTAVlXQRMRApuZjFpSDSknF0ZFLRwaCJ4BBZCOfp6ajkRCMTMyFJGQgVMOEYyKdxoZB3RyYjg3J5yMKYmJdXZ0ZWZkT01FCFJMEaqZLYWDcSQiEI2LeEY9B6WUJh4eC5OLUm9uWJKSg21sUqSTJZ+" & _
    			"dkK2cMIWEcf/WAJuNKUNBLi0pHKmYJW1rWIqJdYmIdnV0YYeFc2ppUy4sHXBvXllWPzw6IJKRgI2NfBcKF2NhUW9tWm1sV5mJK5eIKDc1IH0DCBgWCH9+bGtmVBIdDYyOfTEvH42Me6mXJYmFdW9sTBQSBJWTg2xpUoaEcx8UGS4rGUhF" & _
    			"MiwqDycjFhwaCysqFy4pIAlSBhcSCx8uGxMUAVVUQhUPCighD42Of4+Qgo+PgY+PgI2OfoyOfo+Rgo+Qg4+Pgo+Rg4yOfwZkB52OK4+OgI6Pf5OThY2OgBcYBoyPf46OgMEBBIuLeWhjUJmMLY6NfpaGJo+OgQC3AAh4CWplRGplUKWTK" & _
    			"BISA3FtTwcJAGZkVH+AcWBYEoGCczAvEl9dSJmLLIZ6KJiWhmdoVGtpWI6Oe0dHLlNSQFNTRVNUR1RTQURCK46PfnN1ZI6OfY+QgXNyX5KAGnRwV4mHdY2OfIKAbFdURo6PgXV1aHp2YKGQIhgXBkM7Bf/XAKWTJhkYBv///yH/C05FVF" & _
    			"NDQVBFMi4wAwEAAAAh+QQFBQD/ACwAAAAA3AA8AAAI/wD5CRxIsKBAQIAMKlzIsKHDhxAjSpxIsaLFiwq5mNjIsWNHOCBziLzzBaPJkyhTqhwopJ6EDTAzyJwiM8OUmzed5HTCUydPcD174swAc0PNom/2CZTSBt+VKxKiSujR44qVa/H" & _
    			"isRA1LU+eG2TQEBoLigQJO2bT9gPVL201EoTKpiUBoG5dugD4mNVLgo8dO3z42LWLAQAGDEbqYuBjxMjhKFGE1Y1CuDCGQFECYf4WOTNkyJM7S44sbA2AKJYPH86nulKgb82aRVmzpkOHNZaeWUKCxJJv2x2ePYP3hcwLRu8CKF+u/J3z" & _
    			"584RBWA0nVGa60OyB3gnfXuAIdfTgP9v04YdOwkmlr5gYaW9FVEsWNyY/+IGij1X9uz5mqebvzAe4LAAKQSSAsKBpChAygIDKrDCEwmuIKECTzzh4AoKOPiEhBVWGM6HHX4oYgsklgjDiS2cCAOJJ26hIgxbbEHFjDTWSMUMOOaoI443z" & _
    			"kDFBUDmeMEMQF7QR5E7EglkH0cWeeQMYmxhCzdQkJHNC1gyoSUlFFBQiJdaFkLJmF2OM44kEUiSxJpoRuBmBElkk4Sac65Zp5vipMfPNhLc4NV8/KEwyaAvTHLDJEwUUohXeajiDz2a0EOPDzRUSgOllFYqxx9/yCGHKRD8YUoipEKQiA" & _
    			"012FAFD1UccsAhQBz/IOsBPJxxwBln0LHMrrouowEdnwAL7CfEQvKJM2EA6MGyHpThLLPNPkKAACBQO2CB2CaYYYYRYqgtgQ5mWEwx4pIbrrnbLmCLLdp80Y0iWPrRz7z01mvvvfjmq++8Su3ZQx5dUjKffSgUPGgehhb8pSJ5MOGAP5H" & _
    			"S8IepEJiaCAQ22JDIqKdmLM/HPITMgyFnkEzHySdr8ImxK0PissvkzFNEES6v3I4zzuiigw4FOFPAMLkEHXQZBBRNANFGE/AIDiDoUcwCT0M9rtNPo7ttuXoIMK0AAmTNNdfTep110gSsa4smaAhRCiWFyNvKAAMcAfcllzjQRT9qwB23" & _
    			"3EfI/61GP3IP4IknfcPdN+B7H7HI4kr4I0g/dQjEhQQolBLD5ZhjXgoFpVhOzSagU+AVBV/4MwE9EstRsSk11MB66xubakMoH7NxyMiGkHxGAw3guqsGwAM/8846QEK8LrbsskvyuwADjA67QI/8usQUYMvPP68jdNAe5OJLGbj4govQu" & _
    			"LiTCy7o41JG19UKsADY4uPCCwHo2zMMNL74cgv6vkCTyzDJSMYwiLEuY0wADaqghiIiIC9UFK5vhXMAAvpxiSN4wnCEs+AAECe4uA3Ogp4AnCcWR8JFNO5vb5CcBKhBjRhQww1uoEYFZFiBCjDDhhWAYQ0rwCg3PGwCmqDU6v9aB4FUuc" & _
    			"5TGMuYDeRxCDbYznYjAwIQltEAIFTxdxqY2Tx00Ild6OKLtgCGF734POVFTxfPswUygGEMYyADGQUkoC2MYYt1VK8AyAOGLao3vS/iggC+GAYAx0cMoRGDGOMLWvWAJsfr7Wxdj1zXBPwhBDRlQV4IQEUQEtCKTrYiCEtwwBL64YkuLKE" & _
    			"LplzCKbuwCMQtYgmgdIELUHm3I9CyC7Psgj8W8Tc97WNfwGyLG7zijTuYThOqw1irqlCFjFUhFMxclch4x7tZHQBYKvvEzIoFCe2dL5Hnu8UveEHOcd7inLfoxS0IgM5z8uKcveCFOn+RTl78gp3s1F/+9Nf/C3rewp69iOf+0pnOXxj0" & _
    			"oAaV5z8DOk517g8XAljXPeawA29kQQbycoAD5uCAO9zBAhpVgkaD0I8lWMACUIDCR++ghDvMAXAmtIASZnrSmQJupkqoqQX8sYQQppAfvzwBKjQZBE0SNQhILWpSE5AAkpKAYXvwwhfMMYuqWvWqWM2qVrfK1a569atgDatYtZoOfzigE" & _
    			"TJohLzQgAZ96IOt+vAHGvxhVgcMoh9z0MIoPpCJBzwgE8ewBisAFwRWvLWtmcgEKwZ7BL/yNbF0VWU/+vVLVHRyk11o6iaXwNTMZjYBt+xHHCjBiCGogAyXcIQjRKCC1rrWtSVggAoYoA4i/3jBC0RQx21ri9vceqEcv71tKlIBXAYwgA" & _
    			"jITa5xl8vc5dZWucclQnOZK13qIne61MWudqvbXCKU47RkKAcZcpBWefnDr5n4wAP8EVf2ZkKjDujHDlKQWPR+IAWjgAJh9aHeD/jXr/oA3AdGsVe6+gOVLpisQH6JSwQgwAU7cMGDZTlLCsvSwZ3thx/GcA50HKEbqFWtiEVAYhK3lrU" & _
    			"ohm0JVFCCFrdYHYJosSAEMYYaq8PFOM6xjnfM4x77+MdA1rE6REJkkaTCvH79ayb08QC3uvUBWHBAK/rhghQAmL1PvgPgunDfJKcAC2AGnJI/YOAlyFLBQA2mmtfM5ja7+f/NcI6znOdM53tRth8nha8DQLrnOcwBpH4ONEc3Omj4cvQL" & _
    			"X7iDA3awA4o2eg6yjDCEd+BgCSNYll1AACdB2wrQanoQg9g0J5HK1FKb+tSoTrWqV83qVp/awLCOtaxnTeta2/rWBkbzL+UKBUSrNKUp9fUdUjpsYCPa18DudenQ8FELePSje1a0Rk+a50ITWtAcDfRMV9FobrtgFauwsLjHbeFwP7jSD" & _
    			"k63utfNbnZLGN3rnvUosOGPXi+WFW2NtQGcLFe5svXfaEA0rmXN1i+wItjH/oKyEa3rfgz84RCPuMQnTvGKW/ziGI94w53M8Y57/OMgD7nIR07ykpv85Cj/T7nKV87yjzecrbC+r3ofkIIU+Lfm6v0yFnCuc5z318pM9u9//WrzoQtd6D" & _
    			"VPul93XnSe7/wB9625LG6uczA3XRY253nSkX7zo/tXFmCWhditDmYwa0GvBD67NaxB4Laf/e1YaPsozI4FrCe97GfHetzBzHZraMHvb9cCFpAu+KR/2edfPjsW1s54xv+94QSn677bC2uOY9nycnWr5AkO8LnGGuSXDz3l6cpvA1Me5Ab" & _
    			"whwFWn3pYt77ycdU8e02veic32cmTb/m+c2+AY/Ae5JnwfOlhf3nZ5/7JTYZ8xpfP/OY7f/P6WD2WSa/6ydPe9NJ//sXjqnxat/f12g+///jHT/7yc//O5U+/+tfP/ua7tfvtj7/85z//5KNf36kHP/33z//+R9z+C+Zwn6d//leABniA" & _
    			"5xVg91d57EWACPiAEKh+AJhmshZ9oxeBGJiB4TeBu/Z5GviBIOh8HCiAxBeCJniCEjeCFXiBKNiCLgh78Ed6LPiCNHiC77eABrZvNbiDLXiDAShr1seDQviBPkiBnzeDQ5iEBliEHeh6SviEEMiEJJiDDgiFVih/UgiEVXiFXCiBCviDH" & _
    			"tiFYhh/KqhvY3iG61eGsHYMaNiG5KeGBuZ7bjiHzweHpLeFdJiH//eFRhiGeviHFGeHtQeIhJiCfNiEpoeEhbiIRxiD05XHiJDofYc4hXTVZNkXiZiIZY44fJkYiVmIf53YiZ/IgKGYiaOYiHhYinR4ijKYiqrohqz4iK+4iLH4AK44i2" & _
    			"hYi7eIi2MYi4rIi7BoAA1XZ8RYjMZ4jMiYjMV4Z8rYjM74jNAYjWtGWftQjdZ4jdiYjdq4jdzYjd74jeAYjuI4juRYjuZ4jtq4Euq4juzYju74jg4REAAh+QQFCgD/ACyrAAUAKwAHAAAIZQD//Rt0KtIpTwPmCFzIsKHDhxA9XcLTpMk" & _
    			"JiBgzMhyEyQymVQLVUKyosSREMz+UKTOjhFWkiiRNyhRYC5NKMJgERnpTsZbAIDNNmlFmM+e/Oyb2WYAVVCYWWJg6Mm1KVaA+hgEBACH5BAUKAP8ALKsABQArAAcAAAhiAP8JHPjvkgOCCBMqXIhwQKwQwYLFYkix4r9FGDEKDBZixIhg" & _
    			"XSyKRNili4uSDu4E8zhC2siX/5QosWBh5sAR0UZwmgNz5IdMQP0J5PSKA6eeI0eN+uCv6cAHAj8gFZmJYEAAIfkEBQoA/wAs0AAGAAYABgAACCYA/w3CZAbTqn9mfihTZqYWpoVgMCFU9hATFliYCML6p++fx38BAQAh+QQFCgD/ACy3A" & _
    			"AUAHwAHAAAIWQD//Rt0KtIpVwITKlzIkOElPE2anGhIUeGiixcFqoEYsaLHLl1cgLxTMGJHjw2VKLFgYeW/D5HeRKz1bxRKhh8y6fT37wEUE/ss0LrJcNSoD/6SEiWaSWFAACH5BAUKAP8ALLcABgAfAAYAAAhZAD0NiBUiWLBY/xIqXM" & _
    			"hw4SBMZjCtShgsxIgRwRpqbGjmhzJlZixYCHZxhLSNKP/VwvQRDKZ/o/6NiDaCU0qUZpSxxPThA6dXHGze1IgFFiaIsIYq/advYUAAIfkEBQoA/wAs0AAGAAYABgAACB8AFwkc2KWgi4JKlFiwoPDBh0wQ/Y0a9cGfRYgVLQYEACH5BAU" & _
    			"KAP8ALMQABQASAAcAAAhQAP8tORXplKt/CBMqTHgJT5MmJxYiHITJDKZV/9Q4fCjxn5kfypSZsRDpIceFtTCFBIPpX6Q3D2t1NKNMZUsoJvZZoCURCyxMFWF1lKhPYUAAIfkEBQoA/wAsxAAFABIABwAACFMA/3X5R7CgwYP/1MQKESxY" & _
    			"LIT/FkmU+C9YiBEjgq1C2KWLi45KgmEcIQ2hEiUWLKAkOCLaCE5oEH7IRNPfP06vOHCChXDUqA/+gv6TBdFgJoMBAQAh+QQFCgD/ACzQAAYABgAGAAAIJgD/DcJkBtOqf2Z+KFNmphamhWAwIVT2EBMWWJgIwvqn75/HfwEBACH5BAUFA" & _
    			"P8ALKwABQAqAAcAAAifAP8NODJgwKV/CBMKPELwiMKEnjwxHPCw4r+GDB0qPOKpIEeNCgd05OjJ4qKTJ/+1WtkqyJKKXbosmWlxiUsXLrrA7JJT5x0LDhwosQgFys87Fi0oWWqhIlOlTfX5Q+PPn4N/gxR+yPTgQaZ/1h7qQ4NGX6avD7" & _
    			"ee9fdPqj+zD1Oc7Zrpg8UPDz7orThq1IeqbNsifGCxsMIUhhGiRRgQADsAAA==)"
     
     
    		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.backgroundImage=""url(data:image/gif;base64," + UrlGif + "')"";" & _            						
    						"bdy.style.border='1px solid #FFD700'; "&_						
    						"bdy.style.fontFamily='MS Sans Serif';"&_
    						"bdy.style.fontSize='8pt';"&_
    						"bdy.style.margin='18px';"&_
    						"bdy.style.color='#FFD700';"&_
    						""&_
    						"pgb.style.position='absolute';"&_
    						"pgb.style.width='100%';"&_
    						"pgb.style.bottom='12px';"&_
    						"pgb.style.lineHeight='9px';"&_
    						"pgb.style.borderWidth=1;"&_
    						"pgb.style.borderStyle='inset';"&_
    						"pgb.style.backgroundColor='#FFFFFF';"&_
    						"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='#FFD700')"";"&_
    						"readIn();}"&_
    						"else"&_
    						" {bar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(GradientType=1,StartColorStr='#FFD700',EndColorStr='#FFFFFF')"";"&_
    						"rgbar.style.position='absolute';"&_
    						"rgbar.style.width=pgb.clientWidth;"&_
    						"rgbar.style.posRight=0;"&_
    						"rgbar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(GradientType=1,StartColorStr='#FFFFFF',EndColorStr='#FFD700')"";"&_
    						"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
     
    		'On aurait pu définir la couleur de fond et d'autres éléments ci-dessous aussi dans la partie <BODY>
    		'"bgcolor=""#000000"" "&_
    		'Mais avec la restriction de poids du sAbout que nous avons évoqué, mieux vaut travailler dans la partie window.onload
     
    		sAbout= "about:"&_
    		""&_
    		"<SCRIPT>"&_
    		"var cIn=new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0);"&_
    		"eval(cIn.Read("&Len(sScript)&"));"&_
    		"</SCRIPT>"&_
    		""&_
    		"<HTA:APPLICATION "&_
    		"SHOWINTASKBAR=""no"" "&_
    		"SYSMENU=""no"" "&_
    		"CAPTION=""no"" "&_
    		"SCROLL=""no"" "&_
    		"BORDER=""none"" "&_
    		"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
     
     
    'EXEMPLE D'ORIGINE
     
    Set oPgb=New pgBar
    Set oStatut=oPgb.Display("","",1,0)
    For iProg = 1 to 10
      If oPgb.Change(10,"Décrit la progression d'un script: " & iProg  * 10 & "%") < 0 Then
     	 oStatut.ReadAll
      	 Exit For
      End If
    	WScript.Sleep 100
    Next
    oPgb.Change 0,"Fin de traitement 100%"
    WScript.Sleep 8000
    oPgb.Close
     
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
     
    'Version "Mode Continu"
    'Synchro avec le déroulé d'un code, d'un script
     
    'Set oPgb=New pgBar
    'Set oStatut=oPgb.Display("","Préparation des fichiers",0,0)
     
    	'Du code
    'WScript.Sleep 5000 '--> simulation déroulement code
     
    'oPgb.Kill
     
     
    	'Du code
     
    'Set oPgb=New pgBar
    'Set oStatut=oPgb.Display("","Préparation des Données",0,0)
     
    	'Du code	
    'WScript.Sleep 5000 '--> simulation déroulement code
     
    'oPgb.Kill

  7. #7
    Nouveau Candidat au Club
    Homme Profil pro
    Analyste d'exploitation
    Inscrit en
    janvier 2019
    Messages
    1
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : France, Haute Garonne (Midi Pyrénées)

    Informations professionnelles :
    Activité : Analyste d'exploitation
    Secteur : Communication - Médias

    Informations forums :
    Inscription : janvier 2019
    Messages : 1
    Points : 1
    Points
    1
    Par défaut Bravo omen99
    Bonjour Omen99,

    Simplement pour te remercier de partager tes connaissances, c'est bien expliqué et limpide, ça mérite le respect.

    Bon courage à toi et si je peux t'aider dans le VB (VBS, VBA, VB.net), c'est une partie que je connais pas trop mal.

    Encore merci de partager ton savoir c'est super, je vais m'en servir dans un VBS que je suis en train de développer pour afficher une prgressbar. Et je t'avoue que j'ai bien cherché, et trouvé pas mal de choses, mais là on est au top.

    Merci à toi et bon courage


    Laurent

Discussions similaires

  1. [HTA sans fichier .hta] Dialogue mot de passe modal et non modal
    Par omen999 dans le forum Vos Contributions VBScript
    Réponses: 5
    Dernier message: 11/02/2013, 03h05
  2. [HTA sans fichier .hta] Sélectionner un fichier
    Par omen999 dans le forum Vos Contributions VBScript
    Réponses: 0
    Dernier message: 15/01/2013, 11h51
  3. VBS - Java Script et vbs dans un fichier .hta
    Par Lorponos dans le forum VBScript
    Réponses: 5
    Dernier message: 20/07/2006, 14h11
  4. Les liens dans les fichiers.hta
    Par Lorponos dans le forum Balisage (X)HTML et validation W3C
    Réponses: 5
    Dernier message: 19/07/2006, 13h32

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo