xGUICOM : composant COM (GUI) portable pour langage Active Scripting (VBScript/JScript)

omen999

Oubliez les applications HTML (HTA) pour définir les interfaces graphiques de vos scripts VBS/JS. xGUICOM est un composant WSC qui fournit une interface graphique aux langages de script capables d'exploiter les composants COM. Sa syntaxe est très simple et familière aux utilisateurs du VBA.
Le code du composant étant lui-même écrit en VBScript, xGUICOM peut être adapté et complété sans difficulté. Il est en outre totalement autonome puisqu'il ne requiert aucune inscription dans la base de registre. Enfin, un éditeur visuel de ressources comme Resource Hacker permet de concevoir rapidement et sans peine les boîtes de dialogue de cette interface.

Vous pouvez également poser vos questions et laisser vos commentaires et suggestions sur le forum : Commentez

- Titre : xGUICOM : composant COM (GUI) portable pour langage Active Scripting (VBScript/JScript)

- Auteur : omen999

- Parution : 4 avril 2011

- Licence : Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright ® 2011 omen999. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Sommaire

- 1. Introduction

- 2. Présentation de xGUICOM

- 3. Référence

- 3-1. Objet

- 3-1-1. Dialog

- 3-2. Méthodes

- 3-2-1. CreateForm(sCaption, lLeft, lTop, lWidth, lHeight)

- 3-2-2. AddControl(iID, sClass, lLeft, lTop, lWidth, lHeight[, sData, iStyle])

- 3-2-3. LoadLayoutFromRes(sData)

- 3-2-4. Show(iIDD, bOnTaskBar)

- 3-2-5. GetValueFromID(iID, hWndDlg)

- 3-2-6. SetValueFromID(iID, hWndDlg, vData)

- 3-2-7. AddItem(iID, hWndDlg, sData, iIndex)

- 3-2-8. RemoveItem(iID, hWndDlg, iIndex)

- 3-2-9. BinToB64(sFileName)

- 3-3. Evénements

- 3-3-1. Launch

- 3-3-2. Create(iIDD, hWndDlg)

- 3-3-3. Close(iIDD, hWndDlg,iID)

- 3-3-4. Click(iIDD, hWndDlg, iID)

- 3-3-5. Change(iIDD, hWndDlg, iID)

- 3-3-6. Open(iIDD, hWndDlg, iID, sFileName)

- 3-3-7. Save(iIDD, hWndDlg, iID, sFileName)

- 3-4. Contrôles

- 3-4-1. CommandButton

- 3-4-2. OptionButton

- 3-4-3. CheckBox

- 3-4-4. Frame

- 3-4-5. Edit

- 3-4-6. EdPswd

- 3-4-7. Memo

- 3-4-8. Label

- 3-4-9. Image

- 3-4-10. ListBox

- 3-4-11. ScrollBar

- 3-4-12. ComboBox

- 3-4-13. HotKey

- 3-4-14. IPControl

- 3-4-15. ProgressBar

- 3-4-16. FileDlgBox

- 4. Création de boîtes de dialogue avec l'éditeur de ressources

- 5. Analyse

- 6. Liens

- 7. Remerciements

- 8. Le script VBS

1 - Introduction

Microsoft n'a pas jugé utile de doter ses langages VBScript/Jscript de la faculté de gérer une interface graphique sérieuse, y compris lorsque ceux-ci sont exécutés dans le contexte Windows Script Host. À ceux qui souhaitent, malgré tout, pouvoir en bénéficier, l'éditeur propose une solution à partir de pages DHTML interprétées par le moteur de rendu d'Internet Explorer.

Cette solution est clairement un pis-aller qui présente, à mon sens, deux inconvénients majeurs :
- le rendu final est susceptible de varier en fonction des évolutions qui sont ou seront apportées au moteur de rendu d'un produit aussi stratégique qu'IE ;
- l'interprétation effective de la page n'est pas vraiment conforme à la logique de la programmation impérative suivie par le langage lui-même et nécessite une écriture souvent verbeuse.

Pour y remédier, il existe déjà sur le net plusieurs composants COM gratuits qui permettent la création et la gestion d'une interface graphique :
- WshDialog écrit en VB6 qui utilise plusieurs autres composants ActiveX ce qui ne simplifie malheureusement pas le déploiement ;
- Quick prompts, simple, sans dépendances particulières, mais limité par sa licence à un usage non commercial ;
- WindowSystemObject (WSO) le composant de loin le plus puissant et complet (presque trop) offrant notamment la possibilité d'insérer les composants ActiveX visuels de son choix. La documentation est rigoureuse et complète mais uniquement en anglais (ou russe).

Pourquoi un "yet another" alors qu'il existe une telle offre ? Tout simplement parce que ces solutions présentent toutes les mêmes faiblesses :
- obligation préalable d'inscrire le composant dans la base de registre, sauf à rédiger un manifest, mais la complexité de l'interface ne facilite pas son écriture ;
(pour plus de détails, voir cet article)
- la disposition des contrôles dans la boîte de dialogue se fait à l'aveuglette ce qui rend très pénible la création des masques même si le composant QuickPrompts propose un "automatic form layout" utile pour les dialogues simples.

xGUICOM évite ces deux écueils puisqu'il n'a pas besoin d'être obligatoirement enregistré s'il est référencé par un moniker. Par ailleurs, si les méthodes traditionnelles de création et d'ajout de contrôles sont présentes dans le composant, celui-ci a la capacité d'exploiter des ressources binaires créées par des éditeurs externes, ce qui autorise une création confortable et visuelle de la boîte de dialogue.

Bien évidemment, il ne s'agit pas de rivaliser avec des librairies comme QT ou wxWidgets mais plus modestement de permettre l'écriture rapide d'une interface efficace pour des scripts ponctuels. Cette version 1.0 supporte néanmoins une quinzaine de contrôles de base dont vous trouverez la description détaillée ci-dessous.

2 - Présentation de xGUICOM

xGUICOM se présente sous la forme d'un Windows Script Component (WSC), c'est-à-dire un composant COM écrit dans un langage de script interprété, en l'occurrence le VBScript. C'est un simple fichier texte dénommé xGuiCom.wsc. Cela permet à xGUICOM de proposer plusieurs niveaux d'utilisation :
- le niveau (très) basique qui consiste à traiter le dialogue créé par xGUICOM comme une MsgBox géante dont il reproduit le comportement sans se soucier de gérer les évènements de celui-ci ;
- le niveau intermédiaire qui s'attache à gérer les évènements déclenchés par les actions de l'utilisateur et de récupérer les valeurs des contrôles avant la fermeture du dialogue ;
- le niveau avancé qui ne concerne a priori qu'une petite minorité d'utilisateurs et qui consiste à modifier directement le contenu du composant, soit pour le simplifier, soit au contraire pour y ajouter des fonctionnalités comme de nouveaux évènements. Les sections 5 et 8 s'adressent tout particulièrement à ces utilisateurs avancés ;

xGUICOM crée ses boîtes de dialogues en faisant appel à l'API Win32 de Windows. La gestion des DLL est nativement impossible en VBScript et il est donc nécessaire de recourir à un composant tiers pour y parvenir (DynamicWrapperX). Afin d'assurer son déploiement sans inscription dans la base de registre, le code du composant reprend la quasi-totalité du code décrit dans un précédent article. Seule la fonction de décodage Base64 a été légèrement modifiée pour pouvoir renvoyer une variable chaîne et pas seulement un fichier.

La section 3 contient la documentation de référence pour la mise en œuvre pratique du composant. La section 4 contient un bref tutoriel sur la manière d'utiliser un éditeur de ressources pour créer rapidement des boîtes de dialogue. Enfin, les sections 5 et 8 ne présentent d'intérêt que pour les développeurs qui voudront adapter le composant à leur convenance.

Pour des raisons d'encombrement, le code des fichiers binaires n'a pas été reproduit dans le script ci-dessous mais il est présent dans l'exemplaire téléchargeable dont le lien se trouve à la section 6.

3 - Référence

3-1 - Objet

La conception d'xGUICOM s'écarte volontairement du paradigme POO pour n'en conserver que le strict minimum. Ainsi, le modèle objet du composant est réduit à un objet racine Dialog doté de neuf méthodes et de sept évènements.

3-1-1 - Dialog

L'instanciation de l'objet se fait au moyen du moniker de composant, c'est-à-dire un identifiant chaîne unique composé de "script:" suivi du nom complet du fichier qui peut être une URL et terminé éventuellement par "#nomducomposant" si le fichier .wsc contient plusieurs composants distincts. La connexion sortante de l'objet n'est pas supportée dans cette configuration. Elle doit donc être réalisée séparément au moyen de la fonction ConnectObject afin de pouvoir gérer les évènements dans le script client.

L'instanciation correcte de l'objet est ainsi assurée en VBScript de la façon suivante (oDlg est le nom de l'instance de l'objet Dialog et "ev_" le nom du préfixe) ou son équivalent dans un autre langage :

Set oDlg = GetObject("script:" & Left(WScript.ScriptFullName,Len(WScript.ScriptFullName) - Len(WScript.ScriptName)) & "xGuiCom.wsc")
WScript.ConnectObject oDlg,"ev_"

3-2 - Méthodes

Les paramètres obligatoires sont mentionnés en gras. Les autres paramètres ne peuvent être omis et doivent être au moins représentés soit par une chaîne nulle, soit par la valeur zéro.

3-2-1 - CreateForm(sCaption, lLeft, lTop, lWidth, lHeight)

Crée une boîte de dialogue vierge sans l'afficher.
sCaption : chaîne - titre de la boîte.
lLeft, lTop : numérique - coordonnées relatives de l'angle haut gauche du dialogue (twips).
lWidth, lHeight : numérique - largeur et hauteur du dialogue (twips).
Valeur retournée : numérique - ID du dialogue créé (incrément automatique à partir de zéro). En cas d'erreur, renvoie -1.

Note :
La boîte créée devient le dialogue courant. Toute méthode AddControl appelée ultérieurement s'appliquera automatiquement à ce dialogue.

3-2-2 - AddControl(iID, sClass, lLeft, lTop, lWidth, lHeight[, sData, iStyle])

Ajoute un contrôle à la boîte de dialogue courante.
iID : numérique - identifiant unique entre 1..65535.
sClass : chaîne - nom de classe du contrôle (casse indifférente).
Noms supportés : commandbutton ;
optionbutton ;
checkbox ;
frame ;
edit ;
edpswd ;
memo ;
label ;
image ;
listbox ;
scrollbar ;
combobox ;
hotkey ;
ipcontrol ;
progressbar ;
filedlgbox.
lLeft, lTop : numérique - coordonnées relatives de l'angle haut gauche du contrôle (twips).
lWidth, lHeight : numérique - largeur et hauteur du contrôle (twips).
sData : chaîne - données initiales du contrôle.
iStyle : numérique - style propre du contrôle.
Valeur retournée : booléenne - True en cas de succès, False si l'ajout a échoué.

Note :
Selon les contrôles concernés, la syntaxe de sData sera différente :
commandbutton, optionbutton, checkbox, frame, label : légende du contrôle, chaîne libre.
edit, edpswd, memo : contenu initial du contrôle, chaîne libre.
listbox, combobox : liste des items du contrôle, chaque item est séparé par le caractère |. (ex : "poire|pomme|cerise")
hotkey : valeur initiale du contrôle, syntaxe identique à celle de la fonction VbScript SendKeys. (ex : "{^?}" équivaut à Ctrl + Alt + F2)
ipcontrol : valeur initiale du contrôle, chaîne conforme au format IPv4. (ex : "120.52.255.255")
filedlgbox : paramètres de la boîte de dialogue fichier séparés par le caractère | selon le format "caption|type|iodata|filename|initialdir|titre".
caption : chaîne, libellé du bouton d'ouverture du dialogue fichier.
type : 0 = OpenFileDlgBox, 1 = SaveFileDlgBox.
iodata : nom de variable ou ID du contrôle contenant les données en entrée (open) ou en sortie (save).
filename : chaîne, nom de variable ou ID du contrôle contenant le nom par défaut du fichier.
initialdir : chaîne, nom de variable ou ID du contrôle contenant le répertoire par défaut.
titre : chaîne, nom de variable ou ID du contrôle contenant le titre du dialogue.
image, scrollbar, progressbar : non exploité, peut être une chaine nulle.
Par défaut, il est assigné un style standard pour chaque contrôle et iStyle est alors égal à zéro. Le contrôle listbox est une liste classée et doté d'un ascenseur vertical, le contrôle combobox est du type dropdown avec ascenseur vertical. Il est possible d'assigner une combinaison différente de styles au contrôle en donnant au paramètre iStyle une valeur supérieure à zéro.
Néanmoins, iStyle peut avoir une signification particulière pour certains contrôles. (voir infra)

3-2-3 - LoadLayoutFromRes(sData)

Crée une boîte de dialogue avec ses contrôles à partir de ressources binaires issues d'un éditeur externe.
sData : chaîne - nom de constante ou nom de fichier contenant les ressources. S'il s'agit d'une constante du script, les ressources sont codées en Base64.
Valeur retournée : numérique - ID du dialogue créé (incrément automatique à partir de zéro). En cas d'erreur, renvoie un nombre négatif :
-1 : objets ADO.Stream et FileSystem absents si sData est un nom de fichier existant ;
-2 : fichier et constante inexistants ;
-3 : format fichier binaire incorrect ;
-4 : erreur initialisation.

Note :
La boîte créée devient le dialogue courant. Toute méthode AddControl appelée ultérieurement s'appliquera automatiquement à ce dialogue.

3-2-4 - Show(iIDD, bOnTaskBar)

Affiche la boîte de dialogue portant l'ID correspondant.
iIDD : numérique - identifiant de la boîte de dialogue préalablement créée par la méthode CreateForm ou LoadLayoutFromRes.
bOnTaskBar : booléen - flag d'affichage du script dans la barre des tâches, True = affiché False = non affiché, par défaut False.
Valeur retournée : numérique
-1 : erreur ;
0 : fermeture bouton système ;
1 : fermeture bouton par défaut ;
2 : fermeture touche Esc ou bouton "Annuler";
3..7 : ID du bouton contrôle actionné.

Note :
Les valeurs renvoyées reproduisent le comportement de la boîte de dialogue native de VbScript appelée par la fonction MsgBox. Cela implique qu'il existe des valeurs réservées pour le choix des ID (voir infra).

3-2-5 - GetValueFromID(iID, hWndDlg)

Lit la valeur du contrôle iID contenu dans le dialogue d'handle hWndDlg.
iID : numérique - identifiant du contrôle ;
hWndDlg : numérique - handle de la boîte de dialogue ;
Valeur retournée : dépend de la nature du contrôle (voir infra pour chaque contrôle). Si erreur renvoie VbNull.

Note : cette méthode permet notamment lors de l'évènement Close de récupérer les valeurs de certains contrôles du dialogue. S'applique aux contrôles OptionButton, CheckBox, Frame, Edit, EdPswd, Memo, ListBox, ComboBox, Image, HotKey et IPControl.

3-2-6 - SetValueFromID(iID, hWndDlg, vData)

Assigne la valeur sData au contrôle iID contenu dans le dialogue d'handle hWndDlg.
iID : numérique - identifiant du contrôle ;
hWndDlg : numérique - handle de la boîte de dialogue ;
vData : chaîne/numérique - valeur assignée au contrôle, elle dépend de sa nature (voir infra pour chaque contrôle) ;
Valeur retournée : True ou False en cas d'erreur.

Note : cette méthode est particulièrement utile lors des évènements Create, Click ou Change pour mettre à jour certains contrôles du dialogue. S'applique aux contrôles OptionButton, CheckBox, Frame, Edit, EdPswd, Memo, ListBox, ComboBox, Image, HotKey et IPControl.

3-2-7 - AddItem(iID, hWndDlg, sData, iIndex)

Ajoute un item sData à un contrôle ListBox ou ComboBox au rang d'iIndex.
Si iIndex = -1, l'item sera placé en fin de liste.
iID : numérique - identifiant du contrôle ;
hWndDlg : numérique - handle de la boîte de dialogue ;
sData : chaîne - contenu de l'item ;
iIndex : rang d'insertion de l'item (base 0) ;
Valeur retournée : rang effectif de l'item inséré ou -1 si erreur.

3-2-8 - RemoveItem(iID, hWndDlg, iIndex)

Retire un item sData de rang iIndex d'un contrôle ListBox ou ComboBox.
iID : numérique - identifiant du contrôle ;
hWndDlg : numérique - handle de la boîte de dialogue ;
iIndex : rang de l'item à supprimer (base 0) ;
Valeur retournée : nombre d'items après suppression ou -1 si erreur.

3-2-9 - BinToB64(sFileName)

Convertit un fichier binaire en une chaîne au format B64.
sFileName : nom complet du fichier binaire cible ;
Valeur retournée : chaîne au format B64 contenant les données binaires.

Note : cette méthode n'a pas de rapport direct avec la gestion de la boîte de dialogue. Sa présence permet de simplifier l'intégration d'un dialogue sous forme binaire au sein d'un script client (voir l'exemple fourni BuildConstFromBin.vbs).

3-3 - Evénements

3-3-1 - Launch

Éventuellement déclenché lors du premier appel des méthodes CreateForm et LoadLayoutFromRes. Il ne sera pas activé si le composant COM DynamicWapperX est déjà enregistré dans la base de registre.

Si ce composant DynamicWapperX n'a pas été enregistré, l'évènement doit alors impérativement être géré par le code VBScript suivant ("ev_" est un préfixe arbitraire) ou son équivalent dans un autre langage :

Sub ev_Launch
Set oShell = CreateObject("WScript.Shell")
oShell.Run "WScript.exe " & Chr(34) & WScript.ScriptFullName & Chr(34)
WScript.Quit
End Sub

3-3-2 - Create(iIDD, hWndDlg)

Déclenché lors de la création effective de la boîte de dialogue par Windows. Les contrôles existent et il est donc possible de les initialiser avec des valeurs différentes de celles définies par AddControl ou par les données de ressources binaires.
iIDD : numérique - identifiant unique du dialogue de zéro à n.
hWndDlg : numérique - handle de la fenêtre de dialogue.

Attention, seule la méthode Show crée une boîte de dialogue. Comme son nom ne l'indique pas, la méthode CreateForm construit seulement une structure de données complétée par AddControl qui sera ensuite exploitée par Show.

3-3-3 - Close(iIDD, hWndDlg,iID)

Déclenché à la fermeture de la boîte de dialogue avant sa destruction. Comme la fenêtre existe encore à ce stade, c'est l'endroit idéal pour lire les valeurs utiles du dialogue entrées ou sélectionnées par l'utilisateur.
iIDD : numérique - identifiant unique du dialogue de zéro à n.
hWndDlg : numérique - handle de la fenêtre de dialogue.
iID : numérique - identifiant unique du contrôle qui est à l'origine de la fermeture. Si c'est le bouton de la barre système, iID sera égal à zéro. Cette valeur est également retournée par la méthode Show.

3-3-4 - Click(iIDD, hWndDlg, iID)

Déclenché par l'action du l'utilisateur sur un contrôle gérant cet évènement. Les contrôles concernés sont CommandButton, OptionButton, CheckBox et Frame.
iIDD : numérique - identifiant unique du dialogue de zéro à n.
hWndDlg : numérique - handle de la fenêtre de dialogue.
iID : numérique - identifiant unique du contrôle qui est à l'origine de l'évènement.

3-3-5 - Change(iIDD, hWndDlg, iID)

Déclenché par un changement de la valeur d'un contrôle gérant cet évènement. Les contrôles concernés sont Edit, EdPswd, Memo et ListBox.
iIDD : numérique - identifiant unique du dialogue de zéro à n.
hWndDlg : numérique - handle de la fenêtre de dialogue.
iID : numérique - identifiant unique du contrôle qui est à l'origine de l'évènement.

3-3-6 - Open(iIDD, hWndDlg, iID, sFileName)

Déclenché après la fermeture du dialogue système permettant de sélectionner un fichier à ouvrir.
iIDD : numérique - identifiant unique du dialogue de zéro à n.
hWndDlg : numérique - handle de la fenêtre de dialogue.
iID : numérique - identifiant unique du contrôle qui est à l'origine de l'évènement.
sFileName : chaîne - nom complet du fichier qui a été sélectionné par l'utilisateur.

3-3-7 - Save(iIDD, hWndDlg, iID, sFileName)

Déclenché après la fermeture du dialogue système permettant de sélectionner un nom de fichier à sauvegarder.
iIDD : numérique - identifiant unique du dialogue de zéro à n.
hWndDlg : numérique - handle de la fenêtre de dialogue.
iID : numérique - identifiant unique du contrôle qui est à l'origine de l'évènement.
sFileName : chaîne - nom complet du fichier qui a été sélectionné par l'utilisateur.

3-4 - Contrôles

Les contrôles décrits dans la présente section sont ceux reconnus par la méthode AddControl. Il en existe d'autres qui peuvent être créés par un éditeur de ressources et qui seront reconnus par la méthode LoadLayoutFromRes. Toutefois, le code du composant devra être complété pour permettre leur gestion spécifique.

3-4-1 - CommandButton

Bouton de commande destiné à être actionné ou cliqué par l'utilisateur.
iID : choix libre entre 1 et 65535.

Les valeurs 1 à 7 permettent de créer des boutons de fermeture et d'émuler ainsi le comportement de la fonction MsgBox. Les boutons créés avec des valeurs supérieures à 7 ne déclencheront que l'évènement Click.

sData : chaîne - légende du bouton de commande, le raccourci clavier est précédé du caractère &.
iStyle : une valeur égale à zéro assigne un style standard au bouton. Une valeur égale à un définit le bouton par défaut. Pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

3-4-2 - OptionButton

Bouton radio permettant de définir des options alternatives. À utiliser par groupe de deux minimum.
iID : choix libre entre 8 et 65535.
sData : chaîne - légende du bouton radio, le raccourci clavier est précédé du caractère &.
iStyle : une valeur égale à un initialise le bouton en lui donnant le statut sélectionné. Pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

GetValueFromID : numérique - lit le statut du bouton - 0 : non pressé, 1 : pressé.
vData : numérique - fixe le statut du bouton - 0 : non pressé, 1 : pressé.

Il est nécessaire de regrouper ces contrôles dans un contrôle Frame. Il suffit de les ajouter immédiatement après un Frame.

3-4-3 - CheckBox

Case à cocher permettant de sélectionner des paramètres.
iID : choix libre entre 8 et 65535.
sData : chaîne - légende de la case à cocher, le raccourci clavier est précédé du caractère &.
iStyle : une valeur égale à un initialise la case en lui donnant le statut coché. Pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

GetValueFromID : numérique - lit le statut du bouton - 0 : non pressé, 1 : pressé.
vData : numérique - fixe le statut du bouton - 0 : non pressé, 1 : pressé.

3-4-4 - Frame

Cadre permettant de regrouper visuellement des contrôles dans le dialogue. Ce contrôle est indispensable pour gérer les groupes de contrôles OptionButton.
iID : choix libre entre 8 et 65535.
sData : chaîne - légende du cadre (facultatif), le raccourci clavier est précédé du caractère &.
iStyle : par défaut zéro, pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

3-4-5 - Edit

Contrôle permettant l'édition de valeurs alphanumériques sur une seule ligne.
iID : choix libre entre 8 et 65535.
sData : chaîne - valeur initiale du contrôle.
iStyle : par défaut zéro, pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

GetValueFromID : chaîne - lit le contenu du champ.
vData : chaîne - remplace le contenu du champ par vData.

3-4-6 - EdPswd

Contrôle identique au précédent à l'exception des caractères masqués, ce qui le destine à la saisie des mots de passe.
iID : choix libre entre 8 et 65535.
sData : chaîne - valeur initiale du contrôle.
iStyle : par défaut zéro, pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

GetValueFromID : chaîne - lit le contenu du champ.
vData : chaîne - remplace le contenu du champ par vData.

3-4-7 - Memo

Contrôle identique au contrôle Edit à l'exception de la saisie qui peut s'effectuer sur plusieurs lignes.
iID : choix libre entre 8 et 65535.
sData : chaîne - valeur initiale du contrôle.
iStyle : par défaut zéro, pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

GetValueFromID : chaîne - lit la première ligne du champ.
vData : chaîne - remplace la première ligne du champ par vData.

3-4-8 - Label

Texte statique permettant notamment de placer une légende pour les contrôles qui ne le gèrent pas.
iID : choix libre entre 8 et 65535.
sData : chaîne - contenu du contrôle, le raccourci clavier est précédé du caractère &.
iStyle : par défaut zéro, pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

3-4-9 - Image

Affiche une image stockée dans un fichier au format bmp.
iID : choix libre entre 8 et 65535.
sData : chaîne - nom complet du fichier contenant l'image.
iStyle : par défaut zéro, pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

GetValueFromID : chaîne - renvoie le nom complet du fichier bmp affiché.
vData : chaîne - nom complet du nouveau fichier bmp à afficher.

3-4-10 - ListBox

Contrôle affichant une liste d'items et permettant leur sélection par l'utilisateur. Suivant les dimensions de ce contrôle, une partie seulement de la liste sera affichée à la fois.
iID : choix libre entre 8 et 65535.
sData : chaîne - liste des items séparés par le caractère |.
iStyle : par défaut zéro, la liste est ordonnée et n'autorise qu'une seule sélection, pour modifier en profondeur son style, se reporter à la documentation MSDN Library.

GetValueFromID : chaîne - lit l'item sélectionné.
vData : numérique - place le curseur sur l'item d'indice vData (base zéro).

3-4-11 - ScrollBar

Contrôle affichant un curseur coulissant dans une barre afin de permettre d'afficher l'état d'une action ou de laisser l'utilisateur agir par le biais d'une souris.
iID : choix libre entre 8 et 65535.
sData : numérique - .
iStyle : une valeur égale à zéro définit une barre horizontale, une valeur égale à un, une barre verticale. Pour modifier en profondeur son style, se reporter à la documentation MSDN Library.

Sa mise en œuvre suppose une gestion des notifications envoyées par le contrôle. Cette gestion dépend étroitement des objectifs recherchés. Aussi ce composant ne propose pas de code générique et il appartient à l'utilisateur de l'écrire.

3-4-12 - ComboBox

Contrôle affichant une liste déroulante d'items et l'affichage particulier de l'item sélectionné.
iID : choix libre entre 8 et 65535.
sData : chaîne - liste des items séparés par le caractère |.
iStyle : par défaut zéro, la liste n'est pas modifiable et déroulante, pour modifier en profondeur son style, se reporter à la documentation MSDN Library.

GetValueFromID : chaîne - lit l'item sélectionné.
vData : numérique - place le curseur sur l'item d'indice vData (base zéro).

3-4-13 - HotKey

Contrôle affichant un raccourci clavier et facilitant son édition directement par l'utilisateur.
iID : choix libre entre 8 et 65535.
sData : chaîne - raccourci clavier selon le format reconnu par la fonction SendKeys.
iStyle : par défaut zéro, pour modifier en profondeur son style, se reporter à la documentation MSDN Library.

GetValueFromID : chaîne - lit le raccourci du champ.
vData : chaîne - remplace le raccourci existant par celui défini dans vData (format syntaxe SendKeys()).

3-4-14 - IPControl

Contrôle affichant une adresse selon le format IPv4 et facilitant son édition par l'utilisateur.
iID : choix libre entre 8 et 65535.
sData : chaîne - adresse IPv4 conforme soit quatre groupes de trois chiffres séparés par un point.
iStyle : par défaut zéro, pour modifier en profondeur son style, se reporter à la documentation MSDN Library.

GetValueFromID : chaîne - lit le contenu du champ.
vData : chaîne - remplace le contenu du champ par vData.

3-4-15 - ProgressBar

Contrôle permettant d'afficher visuellement la progression d'une opération normalement invisible.
iID : choix libre entre 8 et 65535.
sData : numérique - (non géré).
iStyle : par défaut zéro, pour modifier en profondeur son style, se reporter à la documentation MSDN Library.

Sa mise en œuvre requiert la création d'un timer gérant l'état d'avancement de l'opération décrite par le contrôle. La nature de ce timer étant étroitement liée à ladite opération, ce composant ne propose pas de code générique et il appartient à l'utilisateur de l'écrire.

3-4-16 - FileDlgBox

Contrôle affichant un bouton de commande destiné à être actionné ou cliqué par l'utilisateur. Lorsqu'il est sollicité, le contrôle affiche un dialogue système, soit pour ouvrir un fichier, soit pour le sauvegarder.
iID : choix libre entre 8 et 65535.
sData : chaîne - paramètres de la boîte de dialogue fichier séparés par le caractère | selon le format "caption|type|iodata|filename|initialdir|titre".
caption : chaîne, libellé du bouton d'ouverture du dialogue fichier.
type : 0 = OpenFileDlgBox, 1 = SaveFileDlgBox.
iodata : nom de variable ou ID du contrôle contenant les données en entrée (open) ou en sortie (save).
filename : chaîne, nom de variable ou ID du contrôle contenant le nom par défaut du fichier.
initialdir : chaîne, nom de variable ou ID du contrôle contenant le répertoire par défaut.
titre : chaîne, nom de variable ou ID du contrôle contenant le titre du dialogue.
iStyle : une valeur égale à zéro assigne un style standard au bouton. Une valeur égale à un définit le bouton par défaut. Pour modifier en profondeur le style du contrôle, se reporter à la documentation MSDN Library.

4 - Création de boîtes de dialogue avec l'éditeur de ressources

La possibilité de définir visuellement les boîtes de dialogue est un avantage notable de xGUICOM. Pour illustrer cette fonctionnalité, j'ai retenu l'éditeur Resource Hacker bien connu de tous les bidouilleurs. Comme il ne permet pas de créer un fichier ressource .res mais seulement de modifier un fichier existant, le pack à télécharger contient un fichier Dialog.res comportant une dialogbox comme seule ressource. L'ajout et le positionnement des contrôles se font à la souris de façon intuitive. Cet article n'est pas une initiation à ce logiciel et il convient de se reporter à l'aide pour plus de détails. L'utilisateur constatera que Resource Hacker propose sur sa palette plusieurs contrôles qui ne figurent pas dans la liste de xGUICOM comme SysTreeView32, SysMonthCal32 ou encore SysTabControl32. Ces contrôles seront acceptés et affichés par xGUICOM mais il appartient à l'utilisateur de compléter le code de la DialogProc afin de gérer les notifications et messages qui leur sont spécifiques.

Après avoir défini les contrôles et leurs ID, la dialogbox peut alors être compilée puis enregistrée dans un fichier sous forme binaire et non comme une ressource (cf. menu Action). Le nom du fichier est ensuite fourni comme paramètre de la méthode LoadLayoutFromRes. Ces données peuvent également être conservées sous la forme d'une constante dont le contenu codé en Base64 sera inséré dans le script client. Pour faciliter cette mise en œuvre, l'exemple fourni dans le pack (BuildConstFromBin.vbs) permet justement de créer ou de compléter un script vbs à partir d'un fichier binaire.

Le champ texte de chaque contrôle permet d'y ajouter les valeurs décrites dans la section référence. Deux contrôles présentent une particularité :
- Image (ou Bitmap) : le style WS_TABSTOP doit impérativement être défini ;
- FileDlgBox : ce contrôle n'existe pas réellement et doit être remplacé par le contrôle CommandButton. C'est le format du texte (caption|type) qui permettra à xGUICOM de l'identifier comme un FileDlgBox.

Resource Hacker, malgré ses qualités, est un programme déjà ancien qui n'est plus mis à jour par son auteur. Il ne prend pas en compte les contrôles plus récents comme IPControl qui est reconnu par xGUICOM. Le deuxième lien concerne un éditeur dénommé Resourcer911 ou TrueResourcer qui est un peu plus complet et qui autorise également la sauvegarde individuelle d'une ressource sous forme binaire.

5 - Analyse

Il est considéré comme acquis que le lecteur maitrise les principes de base de la programmation Win32.

L'interface xGUICOM est constituée par des boîtes de dialogue modales générées par l'API de Windows. Leur logique de fonctionnement est celle décrite dans le chapitre "Dialog Boxes" de la documentation MSDN Library. En conséquence, toute la partie navigation dans l'interface est gérée automatiquement par le dialogue ce qui permet d'alléger le code. Comme le dialogue modal devait pouvoir être créé à partir de données du script et qu'il devait être également possible d'initialiser simplement les contrôles, le choix de la fonction DialogBoxIndirectParam s'imposait.

Après son instanciation, le composant doit appeler une fois la fonction Initialize. Cette dernière permet d'une part, d'assurer l'instanciation du composant DynamicWrapperX quel que soit le contexte, selon une technique décrite dans cet article et d'autre part, de définir les différentes variables globales nécessaires à son fonctionnement. Cet appel est assuré par les méthodes CreateForm ou LoadLayoutFromRes.
Les données de chaque boîte de dialogue sont conservées dans deux buffers chaîne organisés en tableau, chaque dialogue correspondant à un élément de celui-ci. Le premier, DLGTEMPLATEEX(), stocke les structures DLGTEMPLATEEX et DLGITEMTEMPLATEEX définies par Microsoft et attendues par la fonction API DialogBoxIndirectParam - pour plus de détails, voir MSDN Library - et le second aDataDlg() conserve les données d'initialisation de certains contrôles qui seront traitées lors du premier appel de la DialogProc (cf. infra). La taille de ces buffers a été définie arbitrairement à 8192 octets et devra être éventuellement augmentée si les masques comportent de nombreux contrôles.
Les données issues des ressources binaires chargées par LoadLayoutFromRes sont sauvegardées dans le buffer par la fonction ParseBinRes et celles provenant d'AddControl par la fonction BuildDataDlg.

- Initialisation des contrôles

Certains contrôles peuvent recevoir une valeur initiale qu'il est intéressant de gérer lors de la définition des contrôles au lieu d'obliger le concepteur à programmer manuellement cette initialisation lors de l'évènement Create. Elle doit être effective aussi bien en création manuelle avec la méthode AddControl qu'avec la création assistée par un éditeur de ressources.

CommandButton, OptionButton et CheckBox peuvent, outre le paramètre title définissant la légende, recevoir une valeur numérique au moyen du paramètre style que l'on définira aussi bien avec AddControl qu'avec un éditeur.

Label, Frame, Edit, Edpswd et Memo peuvent recevoir le paramètre chaîne title qui sera pris en compte sans traitement particulier.

ListBox, Image, ComboBox, HotKey, IPControl et FileDlgBox nécessitent un code d'initialisation.
ListBox : les données du paramètre title sont accessibles lors de l'appel initial de la DialogProc avec le message WM_INITDIALOG. La chaîne est découpée en items qui alimentent la liste.
Image : les données du paramètre title sont également disponibles. Il doit s'agir du nom complet d'un fichier contenant l'image à afficher au format bmp. La mise à jour est effectuée dans la DialogProc.
ComboBox, HotKey, IPControl : pour des raisons liées à l'interprétation du contenu, le paramètre title n'est pas conservé lors de l'appel initial. Il est donc nécessaire de sauvegarder les données dans un buffer avant d'appeler la fonction DialogBoxIndirectParam. Les fonctions ParseHotKey et ParseIPStr assurent l'encodage de ces données dans un format compréhensible pour ces contrôles.
FileDlgBox : il s'agit d'un pseudo-contrôle qui est traité comme un CommandButton. Le paramètre title contient les données du dialogue système. Elles seront traitées chaque fois que l'utilisateur actionne le contrôle bouton par la fonction BuildOpenFileName.

La fonction DialogProc est strictement celle décrite dans la documentation de la fonction API DialogBoxIndirectParam. Elle reçoit les notifications des contrôles et permet de définir les évènements que l'on souhaite transmettre au script client. Son appel, lors de la création du dialogue, permet d'initialiser les contrôles qui nécessitent un code spécifique.

6 - Liens

Téléchargement du pack complet : composant, exemple et fichier ressource.
Site Resource Hacker.
Editeur Resourcer911 : lien direct package zip.

7 - Remerciements

Je tiens à remercier bbil, ALT et Claude LELOUP pour leur relecture attentive et leurs observations pertinentes.

8 - Le script VBS

Les composants WSC ne supportent pas les caractères accentués lorsqu'ils ne sont pas sauvegardés en Unicode. Les commentaires sont donc volontairement dépourvus de toute accentuation.

<?xml version="1.0"?>
<component>
<?component error="true" debug="false"?>
<registration
description="xGuiCom"
progid="xGuiCom.WSC"
version="1.00"
classid="{e3ba4a33-2e7e-4539-badb-0a141ad397ff}"
>
</registration>
<comment>
composant GUI ecrit en VBScript par omen999 - http://omen999.developpez.com/
la boite de dialogue est creee avec l'api win32 et la bibliotheque dynwrapx.dll
si cette dll n'a pas ete enregistree dans la bdr, elle sera creee automatiquement
dans le meme repertoire que le composant avec l'executable wscript.exe.
ce composant n'est pas ecrit en Unicode, il ne supporte donc aucun caractere accentue
</comment>
<public>
<method name="CreateForm">
<parameter name="sCaption"/>
<parameter name="lLeft"/>
<parameter name="lTop"/>
<parameter name="lWidth"/>
<parameter name="lHeight"/>
</method>
<method name="AddControl">
<parameter name="iID"/>
<parameter name="sClass"/>
<parameter name="lLeft"/>
<parameter name="lTop"/>
<parameter name="lWidth"/>
<parameter name="lHeight"/>
<parameter name="sData"/>
<parameter name="iStyle"/>
</method>
<method name="LoadLayoutFromRes">
<parameter name="sData"/>
</method>
<method name="Show">
<parameter name="iIDD"/>
<parameter name="bOnTaskBar"/>
</method>
<method name="GetValueFromID">
<parameter name="iID"/>
<parameter name="hWndDlg"/>
</method>
<method name="SetValueFromID">
<parameter name="iID"/>
<parameter name="hWndDlg"/>
<parameter name="vData"/>
</method>
<method name="AddItem">
<parameter name="iID"/>
<parameter name="hWndDlg"/>
<parameter name="sData"/>
<parameter name="iIndex"/>
</method>
<method name="RemoveItem">
<parameter name="iID"/>
<parameter name="hWndDlg"/>
<parameter name="iIndex"/>
</method>
<method name="BinToB64">
<parameter name="sFileName"/>
</method>
<event name="Launch"/>
<event name="Create">
<parameter name="iIDD"/>
<parameter name="hWndDlg"/>
</event>
<event name="Close">
<parameter name="iIDD"/>
<parameter name="hWndDlg"/>
<parameter name="iID"/>
</event>
<event name="Click">
<parameter name="iIDD"/>
<parameter name="hWndDlg"/>
<parameter name="iID"/>
</event>
<event name="Change">
<parameter name="iIDD"/>
<parameter name="hWndDlg"/>
<parameter name="iID"/>
</event>
<event name="Open">
<parameter name="iIDD"/>
<parameter name="hWndDlg"/>
<parameter name="iID"/>
<parameter name="sFileName"/>
</event>
<event name="Save">
<parameter name="iIDD"/>
<parameter name="hWndDlg"/>
<parameter name="iID"/>
<parameter name="sFileName"/>
</event>
</public>
<script language="VBScript">
<![CDATA[
Option Explicit

Const _
WS_CHILD = &H40000000, _
WS_VISIBLE = &H10000000, _
WS_TABSTOP = &H10000, _
WS_GROUP = &H20000, _
BM_SETCHECK = &HF1, _
HKM_SETHOTKEY = &H401, _
GWL_USERDATA = (-21), _
SS_BITMAP = &HE, _
STM_SETIMAGE = &H172, _
LR_LOADFROMFILE = &H10, _
IMAGE_BITMAP = 0, _
IPM_SETADDRESS = &H465

Dim bInit              ' flag initialisation du composant
Dim oWrap              ' objet dynamicwrapperx
Dim oStream            ' objet stream
Dim oFso               ' objet filesystem
Dim hIns               ' handle de l'instance
Dim hWsh               ' handle de la fenetre principale WScript (gestion taskbar)
Dim pAdr               ' ptr proxy fonction callback DialogProc
Dim pIDisp             ' ptr interface fonction callback DialogProc
Dim iC                 ' var generale compteur
Dim DLGTEMPLATEEX      ' tableau des structures de donnees binaires du dialogbox
' format : <taille buffer:LONG><DLGTEMPLATE><DLGITEMTEMPLATE_1>..<DLGITEMTEMPLATE_n>
DLGTEMPLATEEX = Array()' pour gerer ubound sans erreur
Dim aDataDlg()          ' tableau des buffers de donnees
' ces donnes servent a initialiser les ctrls combobox, hotkey, ipcontrol et filedlgbox
' format : <taille buffer:LONG><IDD dlgbox:WORD><ID ctrl_1:WORD><data unicode>...<ID ctrl_n:WORD>...
Dim OPENFILENAME       ' structure filedlgbox
Dim sStrFile           ' buffer filedlgbox
Dim sStrFileTitle      ' buffer filedlgbox

Function Initialize()
' appel obligatoire avant toute autre fonction. Assure par CreateForm ou LoadLayoutFromRes
' extraction eventuelle de wscript.exe, dynwrapx.dll et instanciation des objets et variables
' temps de creation sur HD < 3 secs
' l'ecriture se fait en priorite avec l'objet ado stream et seulement a defaut
' par l'objet filesystem qui n'est pas concu pour ecrire des fichiers binaires
Const _
GWL_HINSTANCE = -6, _
adTypeBinary = 1, _
adTypeText = 2
Dim oXml  ' objet xmldom
Dim oElm  ' objet xmlelement
'test existence objet dynamicwrapperx
On Error Resume Next
For iC = 0 To 0 ' puzzling isn't it ;) permet de sortir de la boucle a volonte - comme un goto...
Set oWrap = CreateObject("DynamicWrapperX")
Set oStream = CreateObject("ADODB.Stream")
If oStream Is Nothing Then
'pas bon, on teste ensuite le filesystem
Set oFso=CreateObject("Scripting.FileSystemObject")
If oFso Is Nothing Then
'cas desespere, on laisse tomber
MsgBox "Le composant DynamicWrapperX indispensable au bon fonctionnement de xGuiCOM est absent." & Chr(13) & _
"Veuillez proc" & Chr(233) & "der " & Chr(224) & " son enregistrement avant d'utiliser xGuiCOM.", _
vbCritical,"Erreur xGuiCOM v1.0"
Exit Function
Else
If IsObject(oWrap) Then Exit For  ' sortie de boucle for..next oWrap et oFso sont dispo
'l'objet fso existe, on extrait apres decodage la dll et wscript pour les enregistrer comme fichiers
'sauf s'ils existent deja...
If Not oFso.FileExists("dynwrapx.dll") Then
Set oStream = oFso.CreateTextFile("dynwrapx.dll")
B64ToBin imgDynWrapX,oStream,0
oStream.Close
End If
If Not oFso.FileExists("wscript.exe") Then
Set oStream = oFso.CreateTextFile("wscript.exe",True)
B64ToBin imgWScript,oStream,0
End If
End If
Else
If IsObject(oWrap) Then Exit For ' sortie de boucle for..next oWrap et oStream sont dispo
' l'objet adostream existe, on extrait apres decodage la dll et wscript pour les enregistrer comme fichiers
' pour eviter de faire un SetEOS on commence par le + petit
' mais d'abord a tout hasard test objet ms.xmldom
Set oXml = CreateObject("Microsoft.XMLDOM")
If oXml Is Nothing Then
oStream.Type = adTypeText
oStream.CharSet = "Windows-1252"
Else ' nickel la conversion base64 sera 20 fois + rapide
oStream.Type = adTypeBinary
Set oElm = oXml.createElement("tmp")
oElm.DataType = "bin.base64"
bXml = True
End If
oStream.Open
' test existence de la dll
oStream.LoadFromFile "dynwrapx.dll"
If oStream.Size = 0 Then
If oXml Is Nothing Then
B64ToBin imgDynWrapX,oStream,1
Else
oElm.Text = imgDynWrapX
oStream.Write oElm.NodeTypedValue
End If
oStream.SaveToFile "dynwrapx.dll",2
End If
' au tour de wscript.exe
oStream.Position = 0
oStream.LoadFromFile "wscript.exe"
If oStream.Size < 100000 Then  ' wscript fait au moins 155ko...
If oXml Is Nothing Then
B64ToBin imgWScript,oStream,1
Else
oElm.Text = imgWScript
oStream.Write oElm.NodeTypedValue
End If
oStream.SaveToFile "wscript.exe",2
End If
End If
oStream.Close
fireEvent "Launch"   ' relance du script appelant qui doit contenir l'event Launch
Initialize = False
Exit Function
Next
On Error GoTo 0 ' reactive la gestion des erreurs
' definition des fonctions API
With oWrap
.Register "user32","DialogBoxIndirectParamW","i=hphpp","r=l"
.Register "user32","EndDialog","i=hl","r=l"
.Register "user32","GetNextDlgTabItem","i=hhl","r=h"
.Register "user32","GetDlgItem","i=hl","r=h"
.Register "user32","GetClassNameA","i=hSl","r=l"
.Register "user32","GetWindowTextA","i=hSl","r=l"
.Register "user32","SetWindowTextA","i=hS","r=l"
.Register "user32","FindWindowA", "i=SS","r=l"
.Register "user32","GetWindowLongA","i=ll","r=l"
.Register "user32","SendMessageW","i=hulW","r=l" ' gestion ptr chaine
.Register "user32","SendMessage","i=hupp","r=l"  ' gestion valeurs unsigned
.Register "user32","SendMessageA","i=hupl","r=l" ' gestion valeurs signed
.Register "user32","SetWindowLongW","i=hlp","r=l"
.Register "user32","GetWindowLongW","i=hl","r=l"
.Register "user32","LoadImageW","i=hwullu","r=h"
.Register "comdlg32","GetOpenFileNameW","i=p","r=l"
.Register "comdlg32","GetSaveFileNameW","i=p","r=l"
' definition des params DialogBoxIndirectParam
hWsh = .FindWindowA("WSH-Timer","")              ' recupere le handle de l'instance
hIns = .GetWindowLongA(hWsh,GWL_HINSTANCE)
Set pIDisp = GetRef("DialogProc")                ' interface de la fonction callback appelee par DialogBoxIndirectParam
pAdr = .RegisterCallback(pIDisp,"i=huul","r=l")  ' pointeur vers le code proxy qui appellera l'interface
End With
Initialize = True
End Function

Sub B64ToBin(ByRef sB64, ByRef Strm, ByVal iType)
' extension pour xGuiCom : decode egalement dans un buffer chaine
' pas de controle de conformation de la chaine d'entree
' sB64 : chaine d'entree en base64
' Strm : objet textstream ado, filesystem ou buffer chaine qui recevra les donnees binaires
' si buffer chaine, reserve un header long pour stocker la taille des donnees
' iType : 0 : filesystem ; 1 : ado ; 2 : chaine
Const cB64Charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim iPointer   ' index du groupe traite
Dim iGSize     ' taille du groupe decode en binaire (gestion du caractere terminal '=')
Dim iOffset    ' index dans le groupe
Dim cChar      ' caractere courant
Dim cBin       ' valeur binaire du caractere
Dim iGBuffer   ' buffer numerique du groupe
Dim hGBuffer   ' buffer hexa du groupe
Dim cGBuffer   ' buffer binaire du groupe
Dim iPVar      ' ptr courant si Strm est une chaine
'on commence par traiter la chaine d'entree par groupes de 4 octets
'chaque groupe de 4 caracteres encode pour 3 octets binaires
iGSize = 3
iPVar = 3 ' -1 + 4 (taille header)
For iPointer = 1 To Len(sB64) Step 4
iGBuffer = 0 'raz buffer
For iOffset = 0 To 3 'boucle de traitement du groupe courant
'lecture du caractere courant
cChar = Mid(sB64,iPointer + iOffset,1)
If cChar = "=" Then
'le complement n'entre pas dans le decodage
iGSize = iGSize - 1
cBin = 0
Else
'le rang dans le charset donne la valeur binaire
cBin = InStr(1,cB64Charset,cChar,vbBinaryCompare) - 1
End If
'nouvelle valeur binaire ajoute apres decalage gauche de deux caracteres
iGBuffer = 64 * iGBuffer + cBin
Next
'l'entier long est maintenant converti en une valeur chaine hexa de 6 caracteres max
hGBuffer = Hex(iGBuffer)
'formatage par ajout de zero a droite pour obtenir les 6 caracteres (2 x 3)
hGBuffer = String(6 - Len(hGBuffer), "0") & hGBuffer
'chaque groupe de 2 caracteres est converti en une valeur binaire
cGBuffer = Chr(CByte("&h" & Mid(hGBuffer, 1, 2))) + _
Chr(CByte("&h" & Mid(hGBuffer, 3, 2))) + _
Chr(CByte("&h" & Mid(hGBuffer, 5, 2)))
Select Case iType
Case 0 Strm.Write Left(cGBuffer,iGSize)      ' filesystem
Case 1 Strm.WriteText Left(cGBuffer,iGSize)  ' ado
Case 2 For iC = 1 to 3                       ' buffer chaine
oWrap.NumPut Asc(Mid(cGBuffer,iC,1)),Strm,iC + iPVar,"b"
Next
iPVar = iPVar + 3
End Select
Next
If iType = 2 Then oWrap.NumPut iPVar,Strm  ' maj header avec taille des donnees
End Sub

Function MyASC(sChar)
If sChar = "" Then MyASC = 0 Else MyASC = AscB(sChar)
End Function

Function BinToB64(sFile)
' convertit un fichier binaire en une chaine encodee base64 si erreur renvoie une chaine nulle
' sFileName : nom complet du fichier binaire
' utilise l'objet stream ado et a defaut filesystem defini par Initialize
Const cB64Charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", _
adTypeBinary = 1, _
adTypeText = 2
Dim sBinBuffer  ' work buffer
Dim oFile       ' objet fichier
Dim aB64()      ' tableau de chaines B64
Dim s24         ' groupe de 3 octets
Dim iPointer    ' ptr courant blocs
BinToB64 = ""
If Not bInit Then Exit Function
If IsObject(oStream) Then
With oStream
.Type = adTypeBinary
.Open
.LoadFromFile sFileName
.Type = adTypeText        ' par defaut le charset est deja unicode
If .Size = 0 Then Exit Function
sBinBuffer = .ReadText
.Close
End With
Else
If IsObject(oFso) Then
If oFso.FileExists(sFileName) Then
' fichier existe, lecture du binaire
Set oFile = oFso.GetFile(sFileName)
Set oStream = oFile.OpenAsTextStream(1)
For iC = 0 to oFile.Size - 1
oWrap.NumPut Asc(oStream.Read(1)),sBinBuffer,iC,"t"
Next
End If
Else
Exit Function
End If
End If
ReDim aB64(Int(LenB(sBinBuffer)/3) + 1)
For iPointer = 0 To LenB(sBinBuffer) - 1 Step 3
' lecture bloc 3 octets binaires
s24 = Oct(&H10000 * AscB(MidB(sBinBuffer,iPointer + 1, 1)) + &H100 * _
MyASC(MidB(sBinBuffer,iPointer + 2, 1)) + _
MyASC(MidB(sBinBuffer,iPointer + 3, 1)))
s24 = Right("00000000" & s24, 8)
For iC = 0 To 3
' conversion 3 octets -> 4 caracteres ansi
aB64(iPointer/3) = aB64(iPointer/3) & Mid(cB64CharSet,CLng("&o" & Mid(s24,iC* 2 + 1,2)) + 1,1)
Next
Next
BinToB64 = Join(aB64,"")
Select Case LenB(sBinBuffer) Mod 3
Case 1
BinToB64 = Left(BinToB64,Len(BinToB64) - 2) & "=="
Case 2
BinToB64 = Left(BinToB64,Len(BinToB64) - 1) & "="
End Select
End Function

Function ParseHotKey(ByRef sHK)
' not quite good, but it's enough
' sHK : chaine decrivant la hotkey format sendkeys ex: {^+%X}
' renvoie la valeur hotkey numerique
Const _
HOTKEYF_ALT = &H4, _
HOTKEYF_CONTROL = &H2, _
HOTKEYF_SHIFT = &H1
Dim sFNum  ' hotkey fonction
ParseHotKey = 0
If Left(sHK,1) = "{" And Right(sHK,1) = "}" And Len(sHK) < 9 Then  ' max {^+?n}
sHK = Mid(sHK,2,Len(sHK) - 2) ' trim {}
' weak part
If InStr(sHK,"%") > 0 Then ParseHotKey = HOTKEYF_ALT
If InStr(sHK,"^") > 0 Then ParseHotKey = ParseHotKey + HOTKEYF_CONTROL
If InStr(sHK,"+") > 0 Then ParseHotKey = ParseHotKey + HOTKEYF_SHIFT
If InStr(UCase(sHK),"F") > 0 And InStr(UCase(sHK),"F") < Len(sHK) Then ' touche fonction
sFNum = Mid(sHK,InStr(UCase(sHK),"F")+1) ' tout ce qui suit la lettre f
On Error Resume Next  ' protection si mauvaise syntaxe pas glop...
ParseHotKey = CInt(sFNum) + 111 + ParseHotKey * 256
On Error GoTo 0
Else
ParseHotKey = Asc(UCase(Right(sHK,1))) + ParseHotKey * 256
End If
End If
End Function

Function ParseIPStr(ByRef sIP)
' sIP : valeur chaine au format xxx.xxx.xxx.xxx
' renvoie une valeur dword ou nulle si le format incorrect
Dim aVal ' tableau des groupes d'octets
ParseIPStr = 0
aVal = Split(sIP,".")
If UBound(aVal) = 3 Then
On Error Resume Next ' capture l'erreur format, ParseIPStr renverra zero
' dword n'etant pas supporte nativement par vbs on le "fabrique"
ParseIPStr = oWrap.Space(2,"")
oWrap.NumPut CByte(aVal(1)) * 65536 + CByte(aVal(2)) * 256 + CByte(aVal(3)),ParseIPStr,0,"u"
oWrap.NumPut CByte(aVal(0)),ParseIPStr,3,"b"
ParseIPStr = oWrap.NumGet(ParseIPStr,0,"u") ' cast str -> dword
On Error GoTo 0
End If
End Function

Sub BuildOpenFileName(ByRef pOPENFILENAME,ByRef aBoxData,hWnd)
' definit la structure pOPENFILENAME a partir des donnees aBoxData
Const OFN_OVERWRITEPROMPT = &H2
Dim aFilter(5) ' filtres extension
Dim sFilters   ' chaine filtres
Dim sExt       ' extension par defaut
Dim iUBound    ' nb items aboxdata
Dim hCtrl      ' handle ctrl iodata
Dim sValue     ' contenu ctrl iodata
With oWrap
' definition du filtre
aFilter(0) = "Tous fichiers (*.*)"
aFilter(1) = "*.*"
aFilter(2) = "Fichiers script (*.wsf | *.vbs)"
aFilter(3) = "*.wsf;*.vbs"
aFilter(4) = "Fichiers texte (*.txt)"
aFilter(5) = "*.txt"
sFilters = Join(aFilter,vbNullChar) & vbNullChar & vbNullChar
sExt = "vbs"
iUBound = UBound(aBoxData)
If iUBound < 4 Then ReDim Preserve aBoxData(4)
' les nvx items doivent etre initialises sinon erreur
For iC = iUBound +1 to 4
aBoxData(iC) = ""
Next
.NumPut 76,pOPENFILENAME,0,"u"                    ' taille de la structure
.NumPut hWnd,pOPENFILENAME,4,"h"                  ' le dialogue sera la fenetre parent
' hInstance est ignore +4
.NumPut sFilters,pOPENFILENAME,12,"p"             ' filtres fichiers
' customfilter et nMaxCustomFilter sont ignores +8
.NumPut 2,pOPENFILENAME,24,"u"                    ' nFilterIndex sur "*.wsf;*.vbs"
On Error Resume Next
hCtrl = .GetDlgItem(hWnd,CLng(aBoxData(1)))
If (Err.Number = 0) And (hCtrl > 0) Then          ' iodata correspond a un ctrl du dlgbox
sValue = GetValueFromID(CLng(aBoxData(1)),hWnd)
If Right(sValue,1) <> "\" And Right(sValue,1) <> " " Then sStrFile = sValue & .Space(130 - Len(sValue),"")
.NumPut sStrFile,pOPENFILENAME,28,"p"                           ' lpstrFile
.NumPut 260,pOPENFILENAME,32,"u"                                ' nMaxFile
.NumPut sStrFileTitle,pOPENFILENAME,36,"p"                      ' lpStrFileTitle
.NumPut 128,pOPENFILENAME,40,"u"                                ' nMaxFileTitle
.NumPut Left(sValue,InStrRev(sValue,"\")),pOPENFILENAME,44,"p"  ' lpstrInitialDir
Else ' iodata absent ou incorrect, utilise les 2 items suivants initialdir et file
If (Len(aBoxData(3)) > 0) And (Right(aBoxData(3),1) <> "\") Then aBoxData(3) = aBoxData(3) & "\"
If (Len(aBoxData(2)) > 0) And (aBoxData(2) <> " ") Then _
sStrFile = aBoxData(3) & aBoxData(2) & .Space(130 - Len(aBoxData(3)) - Len(aBoxData(2)),"")
.NumPut sStrFile,pOPENFILENAME,28,"p"                           ' lpstrFile
.NumPut 260,pOPENFILENAME,32,"u"                                ' nMaxFile
.NumPut sStrFileTitle,pOPENFILENAME,36,"p"                      ' lpStrFileTitle
.NumPut 128,pOPENFILENAME,40,"u"                                ' nMaxFileTitle
.NumPut aBoxData(3),pOPENFILENAME,44,"p"                        ' lpstrInitialDir
End If
.NumPut aBoxData(4),pOPENFILENAME,48,"p"           ' lpstrTitle
.NumPut OFN_OVERWRITEPROMPT,pOPENFILENAME,52,"u"   ' Flags pour la liste complete voir MSDN Library
' nFileOffset et nFileExtension sont ignores +4
.NumPut sExt,pOPENFILENAME,60,"p"                  ' lpstrDefExt par defaut .vbs
' le reste de la structure n'est pas utile
On Error GoTo 0
End With
End Sub

Function DialogProc(hWndDlg,uMsg,wParam,lParam)
' callback appelee par DialogBoxIndirectParamA (voir fonction Show)
' permet la gestion des messages du dialogue et donc des evenements
Const _
WM_CLOSE = &H10, _
WM_COMMAND = &H111, _
WM_INITDIALOG = &H110, _
LB_ADDSTRING = &H180, _
CB_ADDSTRING = &H143, _
CB_SETCURSEL = &H14E, _
WM_USER = &H400, _
BST_CHECKED = &H1, _
GWL_STYLE = (-16), _
GWL_EXSTYLE = (-20), _
EN_CHANGE = &H300, _
BN_CLICKED = 0, _
LBN_SELCHANGE = 1

Dim iIDD         ' ID dlgbox
Dim iID             ' ID ctrl courant
Dim hPWnd        ' handle ctrl precedent
Dim hNWnd        ' handle ctrl courant
Dim iCC          ' variable compteur secondaire
Dim sClsName     ' nom classe controle
Dim sWinTxt      ' texte du controle
Dim aList        ' liste items listbox ou combobox
Dim pCur         ' ptr courant aDataDlg()
Dim pEoDD        ' ptr EndofData aDataDlg()
Dim aBoxData     ' tableau donnees filedlgbox
Dim OPENFILENAME ' structure filedlgbox
iIDD = oWrap.GetWindowLongW(hWndDlg,GWL_USERDATA) ' renvoie 0 si WM_INITDIALOG et l'ID du dlg pour les autres msgs
Select Case uMsg
Case WM_CLOSE
fireEvent "Close",iIDD,hWndDlg,0  ' evenement close par convention l'ID egal a zero
oWrap.EndDialog hWndDlg,0         ' fermeture menu systeme ID met fin au dialogue et renvoie 0
DialogProc = True
' ******************************************************************* NOTIFICATIONS DES CTRLS
Case WM_COMMAND
'On Error Resume Next            ' pas d'erreur meme si l'evenement n'a pas ete defini dans le script client
iID = wParam mod 65536             ' low word - contient l'ID du controle auteur du msg
DialogProc = True
Select Case Fix(wParam/65536)   ' high word
Case BN_CLICKED
If (iID < 8 And iID > 0) Then ' seuls les boutons d'ID 1 a 7 ferment le dlg (reproduit comportement MsgBox)
fireEvent "Close", iIDD, hWndDlg,iID ' evenement close
oWrap.EndDialog hWndDlg,iID
Else
If oWrap.GetWindowLongW(lParam,GWL_USERDATA) > 0 Then ' userdata existent : pseudo-ctrl filedlgbox
' format donnes : type|iodata|filename|initialdir|titre
' type : 0 OpenFileDlgBox ; 1 SaveFileDlgBox  > 1 reserve pour d'autres pseudo-ctrls - requis
' iodata : ID du ctrl contenant(open)/recevant(save) le nom fichier - optionnel alternatif
' filename : valeur chaine ou nom de variable ou ID du ctrl contenant le nom par defaut du fichier - optionnel alternatif
' initialdir : valeur chaine ou nom de variable ou ID du ctrl contenant le repertoire par defaut - optionnel
' titre : valeur chaine ou nom de variable ou ID du ctrl contenant le titre du dlg - optionnel
aBoxData = Split(oWrap.StrGet(oWrap.GetWindowLongW(lParam,GWL_USERDATA)),"|")
OPENFILENAME = oWrap.Space(38,"") ' OPENFILENAME_SIZE_VERSION_400 : 76
sStrFile = oWrap.Space(130,"")    ' buffer nom fichier complet
sStrFileTitle = oWrap.Space(64,"")' buffer nom du fichier seul sans chemin
BuildOpenFileName oWrap.StrPtr(OPENFILENAME),aBoxData,hWndDlg
Select Case aBoxData(0)
Case 0
If oWrap.GetOpenFileNameW(oWrap.StrPtr(OPENFILENAME)) <> 0 Then
fireEvent "Open",iIDD,hWndDlg,iID,sStrFile
End If
Case 1
If oWrap.GetSaveFileNameW(oWrap.StrPtr(OPENFILENAME)) <> 0 Then
fireEvent "Save",iIDD,hWndDlg,iID,sStrFile
End If
Case Else
MsgBox "Contr" & Chr(244) & "le inconnu",vbCritical,"Erreur xGuiCOM v1.0"
End Select
Else
fireEvent "Click",iIDD,hWndDlg,iID  ' evenement click avec l'ID du ctrl auteur en parametre
End If
End If
Case EN_CHANGE,LBN_SELCHANGE    ' or CBN_SELCHANGE
fireEvent "Change",iIDD,hWndDlg,iID     ' evenement change avec l'ID du ctrl auteur en parametre
Case Else
DialogProc=False
End Select
' ************************************************************** INITIALISATION  DU DLG
Case WM_INITDIALOG
' la chaine buffer aDataDlg(iIDD) a ete passee en dwInitParam donc lParam pointe vers elle
hPWnd=0
With oWrap
sClsName = .Space(16,"")
sWinTxt =  .Space(4096,"")
iIDD = .NumGet(lParam,4,"t")    ' ID du dialogue stocke dans aDataDlg(iIDD)
' init ctrls listbox, checkbox, radiobutton et image
For iC = 1 to .NumGet(DLGTEMPLATEEX(iIDD),20,"t") ' to nb de controles + offset 4 (header)
hNWnd = .GetNextDlgTabItem(hWndDlg,hPWnd,0)
.GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case "ListBox"
.GetWindowTextA hNWnd,sWinTxt,8192
aList = Split(sWinTxt,"|")
For iCC = 0 to UBound(aList)
.SendMessageW hNWnd,LB_ADDSTRING,0,aList(iCC)
Next
Case "Button"  ' checkbox, radiobutton
' par defaut exStyle = 4 donc si exStyle = 4 + 2  checkbox ou radiobutton coche
If .GetWindowLongA(hNWnd,GWL_EXSTYLE) = 6 Then _
.SendMessageA hNWnd,BM_SETCHECK,BST_CHECKED,0
Case "Static" '  image
.GetWindowTextA hNWnd,sWinTxt,8192
.SendMessageA hNWnd,STM_SETIMAGE,IMAGE_BITMAP,.LoadImageW(0,sWinTxt,IMAGE_BITMAP,0,0,LR_LOADFROMFILE)
.SetWindowLongW hNWnd,GWL_STYLE,SS_BITMAP + WS_CHILD + WS_VISIBLE + WS_GROUP ' supprime le tabstop inutile
End Select
hPWnd = hNWnd
Next
' lecture du buffer aDataDlg, init combobox, hotkey, ipcontrol, dlgfilebox - a little more touchy
' iIDD sauvegarde en userdata attachee au dlg - utilise par les events pour identifier le dlg auteur
.SetWindowLongW hWndDlg,GWL_USERDATA,iIDD
pEoDD = .NumGet(lParam) ' lecture header pour connaitre la taille utile du buffer
If pEoDD > 6 Then ' des donnees controles existent a partir de l'offset 6
pCur = lParam + 6
Do ' lecture aDataDlg(iUp)
iID = .NumGet(pCur,0,"t")      ' ID du ctrl
sWinTxt = .StrGet(pCur + 2)    ' chaine des items a placer dans le combo
hNWnd = .GetDlgItem(hWndDlg,iID)
.GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case "Button" ' pseudo-ctrl filedlgbox (OpenFileDlgBox/SaveFileDlgBox)
aBoxData = Split(sWinTxt,"|")
If (UBound(aBoxData) > 0) Then
If IsNumeric(aBoxData(1)) Then
.SetWindowTextA hNWnd,aBoxData(0) ' maj legende du bouton avec le 1er item
' les donnees doivent etre dispos pour l'event click le pointeur est place en userdata
.SetWindowLongW hNWnd,GWL_USERDATA,pCur + LenB(aBoxData(0)) + 4 ' skip caption|
End If
End If
Case "ComboBox"
aList = Split(sWinTxt,"|")
For iCC = 0 to UBound(aList) ' alimentation de la combobox
.SendMessageW hNWnd,CB_ADDSTRING,0,aList(iCC)
Next
.SendMessageA hNWnd,CB_SETCURSEL,0,0 ' 1er item selectionne
Case "msctls_hotkey32"
.SendMessageA hNWnd,HKM_SETHOTKEY,ParseHotKey(sWinTxt),0
Case "SysIPAddress32"
.SendMessage hNWnd,IPM_SETADDRESS,0,ParseIPStr(sWinTxt)
End Select
pCur = pCur + 4 + LenB(sWinTxt)     ' offset iID + zero terminal = 4
Loop Until pCur >= lParam + pEoDD - 6  ' ne pas oublier de deduire le header et l'iIDD
End If
'On Error Resume Next             ' pas d'erreur meme si l'evenement n'a pas ete defini dans le script client
fireEvent "Create",iIDD,hWndDlg  ' evenement create du script client avec l'ID et le handle du dlg
DialogProc=True
End With
Case Else
DialogProc=False
End Select
End Function

Function CreateForm(sCaption,lLeft,lTop,lWidth,lHeight)
' sCaption : titre du dialogue
' lLeft,lTop: coordonnees relatives de l'angle haut gauche de la feuille
' lWidth, lHeight: dimensions de la feuille
' renvoie l'ID du dlg cree entre 0..n sinon -1
Const _
WS_CAPTION = &HC00000, _
WS_SYSMENU = &H80000, _
DS_MODALFRAME = &H80, _
DS_SETFONT = &H40, _
sFont = "MS Shell Dlg 2"
Dim iUp    ' indice du dlg cree
Dim pEoDT  ' ptr EndofData buffer DLGTEMPLATEEX(iUp)
If not bInit Then
If not Initialize Then
CreateForm = -1
Exit Function
End if
bInit = True
End If
' creation des structure et buffer
iUp = UBound(DLGTEMPLATEEX) + 1 ' comme DLGTEMPLATEEX a ete cree avec array() ubound renvoie -1 si vide
ReDim Preserve DLGTEMPLATEEX(iUp)
ReDim Preserve aDataDlg(iUp)
With oWrap
' le buffer data sera eventuellement alimente lorsque des controles seront ajoutes (fonction AddControl)
aDataDlg(iUp) = .Space(4096,"")               ' buffer 8 Ko pour les donnees init des controles combobox, hotkey, ipcontrol et filedlgbox
.NumPut iUp,aDataDlg(iUp),4,"t"               ' IDD du dlg
.NumPut 6,aDataDlg(iUp)                       ' maj du header la taille utile du buffer = celle du header + l'IDD du dlg  donc 4 + 2
DLGTEMPLATEEX(iUp) = .Space(4096,"")          ' buffer 8 Ko - peut etre aug/dim selon le nb de ctrls
pEoDT = .NumPut(4,DLGTEMPLATEEX(iUp))         ' maj header taille utile = celle du header donc 4
' assemblage structure DLGTEMPLATEEX
pEoDT = .NumPut(4294901761,pEoDT,0,"u")       'EX global header &HFFFF0001
' pas d'HelpID ni d'exStyle, on passe direct au style (offset 8)
pEoDT = .NumPut(WS_SYSMENU + WS_CAPTION + DS_MODALFRAME + DS_SETFONT,pEoDT,8,"u")
pEoDT = .NumPut(0,pEoDT,0,"t")                ' nb de ctrls = 0, maj ulterieurement par AddControl
pEoDT = .NumPut(lLeft,pEoDT,0,"n")
pEoDT = .NumPut(lTop,pEoDT,0,"n")
pEoDT = .NumPut(lWidth,pEoDT,0,"n")
pEoDT = .NumPut(lHeight,pEoDT,0,"n")
' pas de menu et la classe par defaut #32770 est choisie, -> on passe direct au titre (offset 4)
pEoDT = pEoDT + 4
' NumPut n'accepte que les valeurs numeriques, decoupage de sCaption en valeurs 16bits (caractere unicode)
For iC=1 to Len(sCaption)
pEoDT = .NumPut(Asc(Mid(sCaption,iC,1)),pEoDT,0,"t")
Next
pEoDT = .NumPut(0,pEoDT,0,"t") ' zero terminal string unicode
pEoDT = .NumPut(8,pEoDT,0,"t") ' pointsize defaut 8
pEoDT = .NumPut(0,pEoDT,0,"t") ' FW_DONTCARE
pEoDT = .NumPut(0,pEoDT,0,"b") ' italique
pEoDT = .NumPut(1,pEoDT,0,"b") ' charset par defaut (celui decrit dans sFont)
For iC=1 to Len(sFont)
pEoDT = .NumPut(Asc(Mid(sFont,iC,1)),pEoDT,0,"t")
Next
pEoDT = .NumPut(0,pEoDT,0,"t") ' zero terminal string unicode
.NumPut pEoDT - .StrPtr(DLGTEMPLATEEX(iUp)),DLGTEMPLATEEX(iUp) ' maj header taille des donnes utiles
End With
CreateForm = iUp
End Function

Sub BuildDataDlg(iID,ByRef aData, ByRef sData, pCur)
' maj le buffer aDataDlg avec les donnees initiales de certains ctrls
If Len(sData) > 0 Then
With oWrap
pCur = .NumPut(iID,aData,pCur,"t")                 ' ID ctrl
For iC=1 to Len(sData)
pCur = .NumPut(Asc(Mid(sData,iC,1)),pCur,0,"t")  ' data (item0|item1|..|itemn)
Next
pCur = .NumPut(0,pCur,0,"t")                       ' zero terminal
.NumPut pCur - .StrPtr(aData),aData                ' maj header
End With
End If
End Sub

Function AddControl(iID,sClass,lLeft,lTop,lWidth,lHeight,sData,iStyle)
' ajoute un controle sur la feuille creee par la methode CreateForm
' iID: ID unique du controle
' sClass: nom de classe du ctrl
' noms supportes : label, edit, edpsw, memo, commandbutton, listbox, combobox, checkbox, optionbutton,
'                  groupbox, image, scrollbar, hotkey, ipcontrol, progressbar et filedlgbox
' lLeft,lTop: coordonnees relatives de l'angle haut gauche du controle
' lWidth, lHeight: dimensions du controle
' sData: donnees initiales du controle a creer (facultatif)
' listbox et combobox : sData contient la liste des items avec le caractere | comme separateur
' iStyle: style propre du controle (facultatif)
' renvoie true si ok sinon false
Const _
WS_VSCROLL = &H200000, _
WS_HSCROLL = &H100000, _
WS_BORDER = &H800000, _
BS_PUSHBUTTON = &H0, _
BS_DEFPUSHBUTTON = &H1, _
BS_AUTOCHECKBOX = &H3, _
BS_GROUPBOX = &H7, _
BS_AUTORADIOBUTTON = &H9, _
BS_FLAT = &H8000, _
CBS_SIMPLE = &H1, _
CBS_DROPDOWN = &H2, _
CBS_DROPDOWNLIST = &H3, _
CBS_AUTOHSCROLL = &H40, _
ES_AUTOHSCROLL = &H80, _
ES_AUTOVSCROLL = &H40, _
ES_PASSWORD = &H20, _
ES_MULTILINE = &H4, _
ES_WANTRETURN = &H1000, _
ES_LOWERCASE = &H10, _
SS_ICON = &H3, _
LBS_NOTIFY = &H1, _
LBS_SORT = &H2, _
PBS_SMOOTH = &H1, _
SBS_HORZ = &H0, _
SBS_VERT = &H1, _
WS_CTRLSTD = &H50010000  ' WS_CHILD + WS_VISIBLE + WS_TABSTOP
Dim iUp     ' indice du dlg courant
Dim pEoDT   ' ptr EndofData buffer DLGTEMPLATEEX(iUp)
Dim pEoDD   ' ptr EndofData aDataDlg(iUp)
Dim aData   ' tableau donnees des pseudo-controles
Dim iClass  ' system class
Dim bChk    ' flag checked pour radiobox et checkbox
AddControl = False
' composant pas initialise par un appel a CreateForm ou LoadLayoutFromFile donc echec
If Not bInit Then Exit Function
If iID < 1 Then
Err.Raise 10000,"Fonction AddControl","L'identifiant du contr" & Chr(244) & "le doit " & Chr(234) & _
"tre sup" & Chr(233) & "rieur ou " & Chr(233) & "gal " & Chr(224) & " un"
Exit Function
End If
iUp = UBound(DLGTEMPLATEEX) ' derniere structure du tableau (dlg courant)
' offset end of data = taille utile du buffer stocke en header (LONG)
pEoDD = oWrap.NumGet(aDataDlg(iUp)) ' lecture du header (valeur >=6)
Select Case LCase(sClass)
Case "commandbutton"
iClass = 8454143 ' system class button (&h0080)
If iStyle < 2 Then iStyle = iStyle + WS_CTRLSTD ' 0 = pushbutton, 1 = pushbutton defaut
Case "optionbutton"
iClass = 8454143 ' system class button (&h0080)
If iStyle = 1 Then bChk = True
If iStyle < 2 Then iStyle = BS_AUTORADIOBUTTON + WS_CTRLSTD
Case "checkbox"
iClass = 8454143 ' system class button (&h0080)
If iStyle = 1 Then bChk = True
If iStyle < 2 Then iStyle = BS_AUTOCHECKBOX + WS_CTRLSTD
Case "frame"
iClass = 8454143 ' system class button (&h0080)
If iStyle = 0 Then iStyle = BS_GROUPBOX + WS_CTRLSTD + WS_GROUP
Case "edit"
iClass = 8519679 ' system class edit (&h0081)
If iStyle = 0 Then iStyle = ES_AUTOHSCROLL + WS_BORDER + WS_CTRLSTD
Case "edpswd"
iClass = 8519679 ' system class edit (&h0081)
If iStyle = 0 Then iStyle = ES_PASSWORD + ES_AUTOHSCROLL + WS_BORDER + WS_CTRLSTD
Case "memo"
iClass = 8519679 ' system class edit (&h0081)
If iStyle = 0 Then iStyle = ES_MULTILINE + ES_WANTRETURN + WS_BORDER + ES_AUTOHSCROLL + ES_AUTOVSCROLL + WS_CTRLSTD
Case "label"
iClass = 8585215 ' system class static (&h0082)
If iStyle = 0 Then iStyle = WS_CHILD + WS_VISIBLE + WS_GROUP
Case "image"
iClass = 8585215 ' system class static (&h0082)
If iStyle = 0 Then iStyle = SS_BITMAP + WS_CHILD + WS_VISIBLE + WS_GROUP + WS_TABSTOP
' sData contient soit un nom de constante du script client soit un nom de fichier - traite au stade de la dialogproc
' le style WS_TABSTOP normalement inutile pour un ctrl static permettra de le recuperer sans utiliser aDataDlg
Case "icon"
iClass = 8585215 ' system class static (&h0082)
If iStyle = 0 Then iStyle = SS_ICON + WS_CHILD + WS_VISIBLE + WS_GROUP
Case "listbox"
iClass = 8650751 ' system class listbox (&h0083)
If iStyle = 0 Then iStyle = LBS_NOTIFY + LBS_SORT + WS_VSCROLL + WS_BORDER + WS_CTRLSTD
Case "scrollbar"
iClass = 8716287 ' system class scrollbar (&h0084)
If iStyle < 2 Then iStyle = WS_CHILD + WS_VISIBLE + iStyle ' 0 = horizontale, 1 = verticale
Case "filedlgbox" ' traite comme un commandbutton mais aDataDlg est alimente avec les donnees sData
iClass = 8454143 ' system class button (&h0080)
If iStyle < 2 Then iStyle = iStyle + WS_CTRLSTD ' 1 : commandbutton defaut
aData = Split(sData,"|")
If (UBound(aData) > 1) And IsNumeric(aData(1)) Then ' test format donnees - au moins (caption|type)
BuildDataDlg iID,aDataDlg(iUp),sData,pEoDD
Else
Err.Raise 10001,"Fonction AddControl","Erreur de syntaxe : le contr" & Chr(244) & "le filedlgbox n'est pas cr" & Chr(233) & Chr(233)
Exit Function
End If
Case "combobox"
iClass = 8781823 ' system class combobox (&h0085)
If iStyle = 0 Then iStyle = CBS_DROPDOWNLIST + CBS_AUTOHSCROLL + WS_VSCROLL + WS_CTRLSTD
BuildDataDlg iID,aDataDlg(iUp),sData,pEoDD
Case "hotkey"
iClass = "msctls_hotkey32" ' non system class, iClass est une chaine et non une valeur ordinale
If iStyle = 0 Then iStyle = WS_BORDER + WS_CTRLSTD
' idem controle combobox & ipcontrol
BuildDataDlg iID,aDataDlg(iUp),sData,pEoDD
Case "ipcontrol"
iClass = "SysIPAddress32"
If iStyle = 0 Then iStyle = WS_CTRLSTD
'idem controle hotkey & combobox
BuildDataDlg iID,aDataDlg(iUp),sData,pEoDD
Case "progressbar"
iClass = "msctls_progress32"
If iStyle = 0 Then iStyle = WS_CHILD + WS_VISIBLE + PBS_SMOOTH    ' PBS_SMOOTH donne un aspect plein a la barre
Case Else
Err.Raise 10002,"Fonction AddControl","La classe " & LCase(sClass) & " n'est pas une classe support" & Chr(233) & "e"
Exit Function
End Select
' ajout d'une structure DLGITEMTEMPLATEEX a la structure DLGTEMPLATEEX existante
With oWrap
pEoDT = oWrap.NumGet(DLGTEMPLATEEX(iUp)) ' lecture du header - offset fin donnees utiles
pEoDT = pEoDT + pEoDT Mod 4              ' ALIGNEMENT DWORD
If bChk Then  ' exStyle sert a initialiser les check et radiobox (skip helpID offset 4)
pEoDT = .NumPut(2,.StrPtr(DLGTEMPLATEEX(iUp)) + pEoDT,4,"u")  ' checked
Else
pEoDT = .NumPut(0,.StrPtr(DLGTEMPLATEEX(iUp)) + pEoDT,4,"u")  ' unchecked
End If
pEoDT = .NumPut(iStyle,pEoDT,0,"u")
pEoDT = .NumPut(lLeft,pEoDT,0,"n")
pEoDT = .NumPut(lTop,pEoDT,0,"n")
pEoDT = .NumPut(lWidth,pEoDT,0,"n")
pEoDT = .NumPut(lHeight,pEoDT,0,"n")
pEoDT = .NumPut(iID,pEoDT,0,"u")    ' ATTENTION control ID DWORD et non WORD
If VarType(iClass) = 3 Then ' system class
pEoDT = .NumPut(iClass,pEoDT,0,"u")  ' system class FFFF008x
Else                                   ' nom de classe specifique (chaine)
For iC=1 to Len(iClass)
pEoDT = .NumPut(Asc(Mid(iClass,iC,1)),pEoDT,0,"t")
Next
pEoDT = .NumPut(0,pEoDT,0,"t") ' zero terminal
End If
If Len(sData) > 0 Then
For iC=1 to Len(sData)
pEoDT = .NumPut(Asc(Mid(sData,iC,1)),pEoDT,0,"t")
Next
End If
pEoDT = .NumPut(0,pEoDT,0,"u") ' zero terminal + ext data  WORD + WORD = DWORD...
.NumPut .NumGet(DLGTEMPLATEEX(iUp),20,"t") + 1,DLGTEMPLATEEX(iUp),20,"t" ' maj du nb de ctrls dans le header DLGTEMPLATEEX
.NumPut pEoDT - .StrPtr(DLGTEMPLATEEX(iUp)),DLGTEMPLATEEX(iUp)           ' maj header taille des donnes utiles
End With
AddControl = True
End Function

Sub ParseBinRes(ByRef sData)
' analyse et recupere les valeurs d'initialisation des controles combobox, button (filedlgbox), hotkey et ipcontrol
' a partir de la structure DLGTEMPLATEEX dispo sous la forme binaire brute
' ces valeurs alimenteront un buffer aDataDlg(iUp) qui sera lu lors de l'initialisation du dlg
' la DLGTEMPLATEEX est egalement mis a jour
' NOTE : ne gere que les dlg avec la classe system par defaut, style DS_SETFONT et sans menu
' sData : buffer aDataDlg(iUp)
Dim sBuf     ' buffer DLGTEMPLATEEX
Dim sCaption '  titre dlgbox
Dim sFont    ' font dlgbox
Dim pBase    ' adresse de base du buffer de travail puis des structures DLGITEMTEMPLATEEX
Dim iDTE     ' taille DLGTEMPLATEEX
Dim iOffset  ' offset courant
Dim cClass   ' system class (numerique)
Dim sClass   ' nom classe
Dim sInit    ' donnees inits du ctrl
Dim iID      ' ID ctrl
Dim pEoDD    ' offset EndofData aDataDlg(iUp)
Dim iUp
iUp = UBound(aDataDlg)
sBuf = sData
pBase = oWrap.StrPtr(sBuf) + 4  ' skip header taille des donnees
' skip DLGTEMPLATEEX pour atteindre le 1er DLGITEMTEMPLATEEX
' la structure etant de taille variable, il faut la determiner
sCaption = oWrap.StrGet(pBase + 30)  ' no menu & window class system defaut
sFont = oWrap.StrGet(pBase + 38 + LenB(sCaption))
iDTE = 40 + LenB(sCaption) + LenB(sFont)
pBase = pBase + iDTE + iDTE mod 4 ' ne pas oublier l'alignement DWORD...
iOffset = 24
Do ' traitement des differents controles
' offset EndOfData = taille utile du buffer aDataDlg stocke en header (LONG)
pEoDD = oWrap.NumGet(oWrap.StrPtr(aDataDlg(iUp)))
cClass = oWrap.NumGet(pBase,iOffset,"t")
If cClass = 65535 Then
sInit = oWrap.StrGet(pBase + iOffset + 4)
cClass = oWrap.NumGet(pBase,iOffset + 2,"t")
If (cClass = 133) or (cClass = 128) Then           ' combobox ou button filedlgbox
' inclut tous les commandbuttons, pas grave le test filedlgbox se fera dans la dialogproc
iID = oWrap.NumGet(pBase,iOffset - 4)
BuildDataDlg iID,aDataDlg(iUp),sInit,pEoDD
End If
' incremente iOffset pour la structure item suivante
iOffset = iOffset + LenB(sInit) + 32
iOffset = iOffset + iOffset mod 4  ' alignement DWORD
Else
sClass = oWrap.StrGet(pBase + iOffset)
sInit = oWrap.StrGet(pBase + iOffset + LenB(sClass) + 2)
Select Case sClass
Case "SysIPAddress32"
iID = oWrap.NumGet(pBase,iOffset - 4)
BuildDataDlg iID,aDataDlg(iUp),sInit,pEoDD
Case "msctls_hotkey32"
iID = oWrap.NumGet(pBase,iOffset - 4)
BuildDataDlg iID,aDataDlg(iUp),sInit,pEoDD
End Select
' incremente iOffset
iOffset = iOffset + LenB(sInit) + LenB(sClass) + 30
iOffset = iOffset + iOffset mod 4  ' alignement DWORD
End If
Loop Until iOffset >= LenB(sBuf) - iDTE
End Sub

Function LoadLayoutFromRes(ByRef sData)
' utilise des donnees ressources binaires crees par un editeur au lieu d'une creation manuelle
' necessite la presence de l'objet adostream ou a defaut l'objet filesystem
' sData : nom d'une constante du script client contenant la ressource encodee en base64 OU nom du fichier ressource
' la presence du fichier est verifiee avant celle de la constante
' valeur renvoyee -
' 0..n : ID du dlg
' -1 : objets ADO.Stream et filesystem absents si sData est un nom de fichier existant
' -2 : fichier et constante inexistants
' -3 : format fichier binaire incorrect
' -4 : erreur initialisation
Const _
adTypeBinary = 1, _
adTypeText = 2
Dim oFile  ' objet fichier filesystem
Dim iUp    ' indice du dlg cree
If not bInit Then
If Not Initialize Then
LoadLayoutFromRes = -4
Exit Function
End if
bInit = True
End If
iUp = UBound(DLGTEMPLATEEX) + 1 ' comme DLGTEMPLATEEX a ete cree avec array() renvoie -1 si vide ;)
ReDim Preserve DLGTEMPLATEEX(iUp)
DLGTEMPLATEEX(iUp) = oWrap.Space(4096,"")
ReDim Preserve aDataDlg(iUp)
On Error Resume Next
Set oStream = CreateObject("ADODB.Stream")
If oStream Is Nothing Then
' Ado n'existe pas, test filesystem ?
If oFso Is Nothing Then
' si constante pas besoin d'objet stream, DLGTEMPLATEEX est utilise directement
If VarType(sData) = 8 Then
B64ToBin sData,DLGTEMPLATEEX(iUp),2
Else
' abandon pas de constante aucun objet dispo
LoadLayoutFromRes = -1
Exit Function
End If
Else
If oFso.FileExists(sData) Then
' fichier existe, lecture du binaire
Set oFile = oFso.GetFile(sData)
Set oStream = oFile.OpenAsTextStream(1)
For iC = 0 to oFile.Size - 1
oWrap.NumPut Asc(oStream.Read(1)),DLGTEMPLATEEX(iUp),iC + 4,"t"
Next
oWrap.NumPut oFile.Size + 4,DLGTEMPLATEEX(iUp) ' maj header avec taille donnees
Else
If VarType(sData) = 8 Then ' constante chaine existe, pas de test header a ce stade
' objet textstream n'est pas utilisable, DLGTEMPLATEEX est transmis directement
B64ToBin sData,DLGTEMPLATEEX(iUp),2
Else
' pas de fichier, pas de constante abandon
LoadLayoutFromRes = -2
Exit Function
End If
End If
End If
Else
With oStream
.Type = adTypeBinary
.Open
' sData est-il un nom de fichier valide ?
.LoadFromFile sData
.Type = adTypeText              ' par defaut le charset est deja unicode
If .Size = 0 Then               ' fichier absent
If VarType(sData) = 8  Then   ' constante chaine existe, pas de test header a ce stade
.CharSet = "Windows-1252"   ' reclame par B64ToStream
B64ToBin sData,oStream,1
.Position = 0               ' doit etre raz pour changer le charset
.CharSet = "Unicode"
Else
' pas de fichier, pas de constante abandon
LoadLayoutFromRes = -2
Exit Function
End If
End If
DLGTEMPLATEEX(iUp) = oWrap.Space(2,"") & .ReadText
oWrap.NumPut .Size + 4,DLGTEMPLATEEX(iUp)
End With
End If
On Error GoTo 0
If VarType(oStream) = 9 Then oStream.Close
With oWrap
If .NumGet(DLGTEMPLATEEX(iUp),4) <> -65535 Then ' header structure DLGTEMPLATE incorrect (ne pas confondre avec le header du buffer)
LoadLayoutFromRes = -3
Exit Function
End If
' creation du buffer data qui sera eventuellement alimente (fonction ParseBinRes)
aDataDlg(iUp) = .Space(4096,"") ' buffer 8 Ko pour les donnees init des controles combobox, hotkey, ipcontrol et filedlgbox
.NumPut iUp,aDataDlg(iUp),4,"t" ' IDD du dlg
.NumPut 6,aDataDlg(iUp)         ' maj du header la taille utile du buffer = a celle du header + IDD du dlg -> 4 + 2
End With
ParseBinRes DLGTEMPLATEEX(iUp)
LoadLayoutFromRes = iUp
End Function

Function Show(iIDD,bOnTaskBar)
' affiche le dialogue avec la structure DLGTEMPLATEEX + DLGITEMTEMPLATEEX prealablement cree par CreateForm + AddControl ou LoadLayoutFromRes
' iIDD : ID du dialogue renvoye par CreateForm ou LoadLayoutFromRes
' bOnTaskBar : flag affichage du script dans la barre des taches
' valeur renvoyee : -1 erreur ; 0 fermeture bouton systeme ; 2 touche Esc ; ID du bouton clique si entre 1 et 7
Dim hParent
Show = -1
' composant pas initialise par un appel a CreateForm ou LoadLayoutFromFile donc echec
If Not bInit Then Exit Function
' check validite IDD
If (iIDD < 0) Or (iIDD > UBound(DLGTEMPLATEEX)) Then Exit Function
If bOnTaskBar Then hParent = 0 Else hParent = hWsh
' ne pas oublier l'offset header de DLGTEMPLATEEX(iIDD)
' renvoie la valeur definie par EndDialog
Show = oWrap.DialogBoxIndirectParamW(hIns,oWrap.StrPtr(DLGTEMPLATEEX(iIDD)) + 4,hParent,pAdr,aDataDlg(iIDD))
End Function

Function GetValueFromID(iID,hWndDlg)
' renvoie la valeur du controle iID contenu dans le dlg d'handle hWndDlg, si erreur chaine nulle
Const _
EM_GETLINE = &HC4, _
EM_LINELENGTH = &HC1, _
LB_GETCURSEL = &H188, _
LB_GETTEXT = &H189, _
LB_GETTEXTLEN = &H18A, _
CB_GETCURSEL = &H147, _
CB_GETLBTEXT = &H148, _
CB_GETLBTEXTLEN = &H149, _
BM_GETCHECK = &HF0, _
HKM_GETHOTKEY = &H402, _
IPM_GETADDRESS = &H466
Dim hNWnd
Dim sClsName
Dim iLen,iIndex
GetValueFromID = ""
' composant pas initialise par un appel a CreateForm ou LoadLayoutFromFile donc echec
If Not bInit Then Exit Function
With oWrap
sClsName = .Space(16,"")
hNWnd = .GetDlgItem(hWndDlg,iID)
.GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case "Edit"
iLen = .SendMessageA(hNWnd,EM_LINELENGTH,0,0)
GetValueFromID = .Space(iLen,"")
.NumPut iLen,GetValueFromID,0,"t"
.SendMessageW hNWnd,EM_GETLINE,0,GetValueFromID
Case "ListBox"
iIndex = .SendMessageA(hNWnd,LB_GETCURSEL,0,0)
iLen = .SendMessageA(hNWnd,LB_GETTEXTLEN,iIndex,0)
GetValueFromID = .Space(iLen + 1,"")
.SendMessageW hNWnd,LB_GETTEXT,iIndex,GetValueFromID
Case "ComboBox"
iIndex = .SendMessageA(hNWnd,CB_GETCURSEL,0,0)
iLen = .SendMessageA(hNWnd,CB_GETLBTEXTLEN,iIndex,0)
GetValueFromID = .Space(iLen + 1,"")
.SendMessageW hNWnd,CB_GETLBTEXT,iIndex,GetValueFromID
Case "Button"
GetValueFromID = .SendMessageA(hNWnd,BM_GETCHECK,0,0)
Case "Static"  'Image
GetValueFromID = .Space(128,"")
.GetWindowTextA hNWnd,GetValueFromID,256
Case "msctls_hotkey32"
GetValueFromID = .SendMessageA(hNWnd,HKM_GETHOTKEY,0,0)
Case "SysIPAddress32"
' dans cette syntaxe lparam est un pointeur et non une valeur
.SendMessageW hNWnd,IPM_GETADDRESS,0,GetValueFromID
GetValueFromID = CStr(.NumGet(GetValueFromID,3,"b")) & "." & CStr(.NumGet(GetValueFromID,2,"b")) & _
"." & CStr(.NumGet(GetValueFromID,1,"b")) & "." & CStr(.NumGet(GetValueFromID,0,"b"))
End Select
End With
End Function

Function SetValueFromID(iID,hWndDlg,vData)
' assigne la valeur vData au controle iID contenu dans le dlg d'handle hWndDlg
' renvoie true si OK
Const _
WM_SETTEXT = &HC, _
LB_SETCURSEL = &H186, _
CB_SETCURSEL = &H14E
Dim hNWnd
Dim sClsName
Dim iLen,iIndex
Dim pData
SetValueFromID = False ' inutile juste pour la clarte du code
' composant pas initialise par un appel a CreateForm ou LoadLayoutFromFile donc echec
If Not bInit Then Exit Function
With oWrap
sClsName = .Space(16,"")
hNWnd = .GetDlgItem(hWndDlg,iID)
.GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case "Edit"
SetValueFromID = .SendMessageW(hNWnd,WM_SETTEXT,0,vData)
Case "ListBox"
SetValueFromID = .SendMessageA(hNWnd,LB_SETCURSEL,vData,0)
Case "ComboBox"
SetValueFromID = .SendMessageA(hNWnd,CB_SETCURSEL,vData,0)
Case "Button"
pData = .GetWindowLongW(hNWnd,GWL_USERDATA)
If pData > 0 Then ' userdata existe : filedlgbox (a developper)
Else ' chkbox, optionbutton et cmdbutton
SetValueFromID = .SendMessageA(hNWnd,BM_SETCHECK,vData,0)
End If
Case "Static"
SetValueFromID = .SendMessageA(hNWnd,STM_SETIMAGE,IMAGE_BITMAP,.LoadImageW(0,vData,IMAGE_BITMAP,0,0,LR_LOADFROMFILE))
Case "msctls_hotkey32"
SetValueFromID = .SendMessageA(hNWnd,HKM_SETHOTKEY,ParseHotKey(vData),0)
Case "SysIPAddress32"
SetValueFromID = .SendMessage(hNWnd,IPM_SETADDRESS,0,ParseIPStr(vData)) ' syntaxe lparam DWORD
End Select
End With
End Function

Function AddItem(iID,hWndDlg,sData,iIndex)
' ajoute un item sData a un ctrl listbox ou combobox au rang iIndex (base 0) - dernier si -1
' renvoie le rang effectif ou -1 si erreur
Const LB_INSERTSTRING = &H181, _
CB_INSERTSTRING = &H14A
Dim hNWnd
Dim sClsName
AddItem = -1
' composant pas initialise par un appel a CreateForm ou LoadLayoutFromFile donc echec
If Not bInit Then Exit Function
With oWrap
sClsName = .Space(16,"")
hNWnd = .GetDlgItem(hWndDlg,iID)
.GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case "ListBox"
AddItem = .SendMessageW(hNWnd,LB_INSERTSTRING,iIndex,sData)
Case "ComboBox"
AddItem = .SendMessageW(hNWnd,CB_INSERTSTRING,iIndex,sData)
End Select
End With
End Function

Function RemoveItem(iID,hWndDlg,iIndex)
' retire un item de rang iIndex dans un ctrl listbox ou cbbox
' renvoie le nb d'items restant ou -1 si erreur
Const LB_DELETESTRING = &H182, _
CB_DELETESTRING = &H144
Dim hNWnd
Dim sClsName
RemoveItem = -1
' composant pas initialise par un appel a CreateForm ou LoadLayoutFromFile donc echec
If Not bInit Then Exit Function
With oWrap
sClsName = .Space(16,"")
hNWnd = .GetDlgItem(hWndDlg,iID)
.GetClassNameA hNWnd,sClsName,32
Select Case sClsName
Case "ListBox"
RemoveItem = .SendMessageA(hNWnd,LB_DELETESTRING,iIndex,0)
Case "ComboBox"
RemoveItem = .SendMessageA(hNWnd,CB_DELETESTRING,iIndex,0)
End Select
End With
End Function

Const imgWScript = <code disponible dans le script à télécharger dans la page précédente>
Const imgDynWrapX = <code disponible dans le script à télécharger dans la page précédente>
</script>
</component>