1. Présentation de DeployBin

La première partie de l'article précité fournissait un exemple (section 3.3) illustrant la façon d'appeler, à partir de VBScript, une DLL en évitant toute intervention préalable sur l'ordinateur concerné. Cette solution avait toutefois l'inconvénient de faire intervenir trois fichiers supplémentaires, en complément du script lui-même, le fichier batch hello.bat ainsi que deux fichiers binaires : wscript.exe et dynwrapx.dll.

Il était donc tentant de rechercher une solution plus compacte, qui réunirait au sein d'un même fichier script, le code proprement dit ainsi que les deux binaires cités plus haut. Cette solution aurait en outre l'avantage de rendre inutile le fichier batch.

Inclure un fichier binaire dans un fichier script suppose de résoudre deux difficultés : la première est le choix du format de stockage qui doit être compatible avec celui du script hôte, la seconde, corollaire de la précédente, est de retenir la routine de décodage et de sauvegarde la plus performante possible tout en lui conservant une grande polyvalence. Cette inclusion a toutefois un prix : la taille minimale du script le plus simple sera de l'ordre de 225 ko et le temps de démarrage en cas de création des binaires sera allongé de deux à trois secondes.

Afin de faciliter la compréhension du code, vous trouverez ci-dessous son analyse succincte.

L'exécutable wscript.exe correspond à la version 5.7 et la DLL dynwrapx.dll à la version 1.0. Vous noterez que ces fichiers incorporent une ressource manifest SxS grâce à l'utilitaire MS mt.exe dont l'usage sera évoqué dans la deuxième partie de l'article consacré à ce sujet.

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 4.

2. Analyse

Les scripts VBS sont des fichiers au format texte et qui, à ce titre, ne peuvent contenir sans encodage préalable des données binaires brutes dont certaines valeurs sont incompatibles avec ce format. Ce problème, aussi vieux que l'informatique ou presque, a donné naissance à de nombreux algorithmes dont le plus répandu est le Base64. Ce n'est pas le plus performant, particulièrement en termes d'encombrement (+33%), mais il est disponible dans des composants très souvent présents sur les postes de travail Windows et il répond ainsi au critère de polyvalence.

Ainsi, le script définira deux constantes imgWScript et imgDynWrapX qui contiendront les deux fichiers binaires qui auront été préalablement encodés en Base64 par un outil quelconque.

Pour garantir la bonne exécution de notre script quelque soit le contexte de l'ordinateur, nous devons assurer l'instanciation de l'objet wrapper exposé par le composant DynamicWrapperX. La fonction Initialize a pour seul objet de garantir cette instanciation et de renvoyer la valeur True lorsque celle-ci est effective.

À l'appel de la fonction Initialize deux cas de figure peuvent se présenter :
- la DLL est déjà enregistrée dans la BDR, l'instanciation est immédiate et la fonction renvoie True ;
- la DLL n'est pas enregistrée, il faut donc vérifier l'existence des fichiers binaires sur le disque et, le cas échéant, les générer à partir des données embarquées. VBScript n'a pas d'accès natif au système de fichiers et doit s'appuyer sur des composants COM externes. DeployBin essaie d'utiliser en priorité l'objet ADO.Stream et seulement à défaut l'objet FileSystem qui peut sous certaines réserves générer des fichiers binaires.
L'absence simultanée de ces deux objets entraine l'affichage d'un message d'échec.

Si l'un au moins des fichiers binaires est absent, DeployBin teste la présence de l'objet Microsoft.XMLDOM. Ce composant est très souvent installé et contient une fonction de décodage beaucoup plus performante que la fonction script B64ToBin utilisée à défaut.

L'existence des fichiers binaires étant désormais acquise, il convient maintenant de relancer le script dans un contexte d'exécution capable de reconnaitre l'objet wrapper que nous souhaitons mettre en œuvre. Il suffit de demander au script de se relancer dans un nouveau processus à partir de son emplacement courant afin que l'hôte wscript.exe généré en assure l'exécution.

La bonne exécution de votre script est désormais garantie quel que soit son environnement (ou presque).

3. Le script VBS

 
Sélectionnez

' ************************************************************************************
' DeployBin v1.0 par omen999 - (omen999.developpez.com) octobre 2010
' déploiement de fichiers binaires embarqués 
' exemple de déploiement de composant COM sans inscription avec la DLL DynamicWrapperX 
' ************************************************************************************
Option Explicit
Const _
MB_ICONWARNING = &H30, _
MB_YESNO = &H4
Dim _
oWrap, _
iRep
Function Initialize
' vérifie si dynamicwrapperx est installé
' extraction éventuelle de wscript.exe, dynwrapx.dll et instanciation des objets et variables
' temps de creation sur HD < 4 secs
' l'écriture se fait en priorité avec l'objet ado stream (avec éventuellement l'objet xmldom) et seulement à défaut
' par l'objet filesystem qui n'est pas conçu pour écrire des fichiers binaires
Const _
GWL_HINSTANCE = -6, _
adTypeBinary = 1, _
adTypeText = 2
Dim _
oStream, _
oShell, _
oFso, _
oXml, _
oElm   
  'test existence objet dynamicwrapperx
  On Error Resume Next
  Set oWrap = CreateObject("DynamicWrapperX")
  If oWrap Is Nothing Then 
    'la lib dynwrapx n'a pas été référencée dans la bdr
    'on teste d'abord l'existence d'ado
    Set oStream = CreateObject("ADODB.Stream")
    If oStream Is Nothing Then
      'pas bon, on teste ensuite le filesystem object
      Set oFso=CreateObject("Scripting.FileSystemObject")
      If oFso Is Nothing Then
        'cas désespéré, on laisse tomber 
        MsgBox "Le composant DynamicWrapperX indispensable au bon fonctionnement du script est absent." & Chr(13) & _
               "Veuillez procéder à son enregistrement avant de continuer.",vbCritical,"Erreur DeployBin 1.0"
        Exit Function
      Else
        'l'objet fso existe, on extrait après décodage la dll et wscript pour les enregistrer comme fichiers
        'sauf s'ils existent déjà...
        If Not oFso.FileExists("dynwrapx.dll") Then 
          Set oStream = oFso.CreateTextFile("dynwrapx.dll")
          B64ToBin imgDynWrapX,oStream,False
          oStream.Close
        End If
        If Not oFso.FileExists("wscript.exe") Then 
          Set oStream = oFso.CreateTextFile("wscript.exe",True)
          B64ToBin imgWScript,oStream,False
        End If
      End If
    Else
      'l'objet adostream existe, test de l'objet XMLDOM
      'puis extraction éventuelle après décodage de la dll et wscript pour les enregistrer comme fichiers
      'pour éviter de faire un SetEOS on commence par le + petit
      oStream.Open
      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"
      End If
      oStream.LoadFromFile "dynwrapx.dll"
      If oStream.Size = 0 Then ' le fichier n'existe pas
        If oXml Is Nothing Then 
          B64ToBin imgDynWrapX,oStream,True
        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,True
        Else
          oElm.Text = imgWScript
          oStream.Write oElm.NodeTypedValue
        End If
        oStream.SaveToFile "wscript.exe",2
      End If	
	End If
    oStream.Close
    Set oStream = Nothing
    Set oShell = CreateObject("WScript.Shell")
    oShell.Run "WScript.exe " & Chr(34) & WScript.ScriptFullName & Chr(34)
    Initialize = False
    Exit Function
  End If
  Initialize = True
End Function

Sub B64ToBin(ByRef sB64, ByRef oStrm, ByVal bAdo)
' pas de contrôle de conformation de la chaine d'entrée
' sB64 : chaine d'entrée en base64
' oStrm : objet textstream ado ou filesystem pour écrire le fichier binaire
' bAdo : flag objet - true ado, false filesystem
Const cB64Charset = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim iPointer   'index du groupe traité
Dim iGSize     'taille du groupe décodé en binaire (gestion du caractère terminal '=')
Dim iOffset    'index dans le groupe
Dim cChar      'caractère courant
Dim cBin       'valeur binaire du caractère
Dim iGBuffer   'buffer numérique du groupe
Dim hGBuffer   'buffer hexa du groupe
Dim cGBuffer   'buffer binaire du groupe			
  'on commence par traiter la chaine d'entrée par groupes de 4 octets
  'chaque groupe de 4 caractères encode pour 3 octets binaires
  iGSize = 3
  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 caractère courant
      cChar = Mid(sB64,iPointer + iOffset,1)
      If cChar = "=" Then
      	'le complément n'entre pas dans le décodage
      	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 ajoutée après décalage gauche de deux caractères
      iGBuffer = 64 * iGBuffer + cBin
    Next
    'l'entier long est maintenant converti en une valeur chaine hexa de 6 caractères max
    hGBuffer = Hex(iGBuffer)
    'formatage par ajout de zéros à droite pour obtenir les 6 caractères (2 x 3)
    hGBuffer = String(6 - Len(hGBuffer), "0") & hGBuffer
    'chaque groupe de 2 caractères 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)))
    If bAdo Then
      oStrm.WriteText Left(cGBuffer,iGSize)
    Else
      oStrm.Write Left(cGBuffer,iGSize)
    End If
  Next
End Sub

' on se contente de tester la fonction Initialize qui se charge de relancer le script au besoin avec le bon contexte
If Initialize Then
' le code de chaque script doit être inséré ici en remplacement des deux lignes suivantes
  oWrap.Register "user32.dll", "MessageBoxW", "i=hwwu","r=l"
  iRep = oWrap.MessageBoxW(0, "Hello world !", "RegFreeSxS par omen999", MB_YESNO + MB_ICONWARNING)
End If

Const imgWScript = <code disponible dans le script à télécharger dans la section ci-dessous>
Const imgDynWrapX = <code disponible dans le script à télécharger dans la section ci-dessous>
			

4. Lien

Téléchargement du script complet DeployBin.zip

5. Remerciements

Je tiens à remercier mahefasoa, wachter et jacques_jean pour leur relecture attentive et leurs observations pertinentes.