Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "0{00020906-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "boucle"
''Copyright Emmanuel Beaudouin-Lafon

'Option Private Module
Option Explicit '(execution bloquee s'il y a des variables non declarees)

'parametres :
Private versionVba As String '= 0.0.6, renseigne par Parametrage()
Private nom1CeModele As String '= gm.dotm, renseigne par Parametrage()
Private nom2CeModele As String '= gmDev.dotm, renseigne par Parametrage()
Private nom3CeModele As String '= gmObf.dotm, renseigne par Parametrage()

Private rafraichirSelection As Boolean '= False, renseigne par Parametrage()
'Private autoriserPanneauRecherche As Boolean '= True, renseigne par Parametrage()
Private identifierRetraits As Boolean '= True, renseigne par Parametrage()
Private identifierCommentaires As Boolean '= True, renseigne par Parametrage()
Private identifierItaliques As Boolean '= True, renseigne par Parametrage()
Private economiserTestsItalique As Boolean '= True, renseigne par Parametrage()

Private NLN '= vbCr, renseigne par Parametrage(), valeur pouvant eventuellement etre ajustee selon le systeme (vbCr, vbLf, vbCrLf)
Private sep '=Application.PathSeparator, 'IMPORTANT : sert a determiner si l'on est sous Windows ou MacOSX, renseigne par Parametrage()

Private retraits As String ' liste des retraits (sous forme de chaine pour le fichier txt)
Private commentaires As String 'liste des commentaires (sous forme de chaine pour le fichier txt)
Private italiques As String ' liste des numeros de paragraphes italiques (sous forme de chaine pour le fichier txt)

'cle'
'Private cleDecryptage '= "AiHnKlPxVhDmIu", renseigne par Parametrage()

'cloud de developpement (pour la fonction DossierCloud() qui n'est finalement pas utilisee) :
'Private Const cloud As String = "iCloud"
'Private Const cloud As String = "DropBox"

'emplacements :
Private fichierAppliGm As String
Private dossierDivers As String
'Private locAppleScripts As String 'renseigne par Parametrage() localisation utilisee seulement avec Wordmac2011
Private fichierAppleScripts As String
Private problemeAppleScript As Boolean

'utilisateur :
'Private nomCompte As String 'renseigne par Parametrage() et utilise par InfosConfig()

'ordinateur :
Private systExp As String 'systeme d'exploitation ex : MacOSX 10.15.3
Private versionWord As String
Private anneeWord As Long
Private encodageTxt As String
Private pilotageJs As Boolean 'les actualisations de texte.txt sont demandees periodiquement par Gm

'identification du modele courant (template) :
Private objCeModele As Object
Private objCeModeleTrouve As Boolean

'document traite :
Private docTraite As String '(=chemin+nom)

'boucle principale :
Private continuerGm As Boolean
Private tpsIniHandler As Single
Private exporterMaintenant As Boolean
Private exportEnCours As Boolean
Private dureeExportMax As Single ' duree d'execution pour le 1er export (le plus long) du texte en ms
Private dureeExport As Single ' duree d'execution pour exporter le texte en ms

Private resul As Variant ' sert a recuperer les valeurs des fonctions appelees


'Variables du handler :
Private dureeHandler As Single ' duree d'execution du handler en ms
Private premierTour As Boolean

Private anciennete As Single ' anciennete du dernier changement de position/texte de la selection
Private periode '= 501 'renseigne par Parametrage(), periode souhaitee, de comparaison de la selection (en ms).
Private pauseMini '= 501 'renseigne par Parametrage(), pause souhaitee, sans changement de selection avant ecriture du fichier txt (en ms).
Private pause As Single

Private debutSel As Long ' position du debut de la selection
Private finSel As Long ' position de la fin de la selection
Private txtSel As String ' texte de la selection
Private debutSelActif As Boolean
Private texteBrut As String 'texte pour comparaison avant export

'revisions :
Private nbRevisions As Long
Private affichageTexteFinal As Boolean ' utilise par le handler : vrai si Word affiche le texte "final" et faux si c'est le texte "original"

'commentaires :
Private nbCommentaires As Long

'Paragraphes italiques :
Private nvPrgItaliques() As Long
Private prgItaliques() As Long
Private lngTexteCourant As Long 'sert a etendre la selection dans ParagraphesItaliques()
Private lngTexteDernierExport As Long 'sert a etendre la selection dans ParagraphesItaliques()

Private italiqueSel As Boolean ' selection en italique ou pas : Devenu INUTILE.


'----------------------------------------
'A RESOUDRE :

' Activer l'ancienne boite de dialogue avec Ctrl-F :
'http://www.alphr.com/realworld/383761/how-to-switch-back-to-the-old-find-and-replace-menu-in-word

' Approfondir l'interet de l'option 'overtype' qui semble correspondre a l'etat du mode 'insertion' de la frappe

'- lorsque la boucle tourne le bouton Word "reproduire la mise en forme (pinceau)" ne marche pas...

'- prendre aussi en compte le premier caractere a gauche du curseur dans le handler ;
'- exporter la position du curseur Word ;


'- pour suivre l'activite du clavier afin d'interrompre un export en cours lors de la frappe, il y a
'quelques infos la (il s'agit de faire un 'Keyboard hook'...) :
'https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-setwindowshookexa

'- trouver la cause de ce qui qui sous Wordmac2011 crashe vba apres execution (correcte) de la boucle
'For Each laRev In lesRevisions dans la fonction DocVersTxt()...
'

'--------------
'Texte Outillage EBL (30 revisions) avec Windows/MacOSX :
'export = 165/1600 ms pour 30 revisions dont 14 retraits executes
'export = 155/1600 ms pour 30 revisions sans appliquer les retraits
'export =  45/40 ms sans obtenir les revisions ni appliquer les retraits

'--------------
'Texte Rouet EBL (beaucoup d'italique) avec Windows/MacOSX :
'export = 215/700 ms (x17) avec retrait des paragraphes italiques sans economiser les tests
'export = 140/160 ms (x4) avec retrait des paragraphes italiques en economisant les tests
'export =  45/40 ms sans retirer les paragraphes italiques

'---------------
'Texte Ejecteur (50 pages) avec Windows/MacOSX :
'export = 900/2000 ms (x14) avec retrait des paragraphes italiques sans economiser les tests
'export = 550/450 ms (x3) avec retrait des paragraphes italiques en economisant les tests
'export = 145/140 ms sans retirer les paragraphes italiques

'----------------------------------------


Sub ConfigGm()
    
    'affiche une boite d'infos donnant la configuration courante
    '(systeme, versions, chemins etc)
    
    Initialisation

    Dim infos As String
    'Dim nomDomaine As String
    
    'On Error Resume Next
    'nomDomaine = Environ("USERDOMAIN")
    
    'If nomDomaine <> "" Then
    '    infos = infos & NLN & "domaine = " & nomDomaine
    'End If
    'infos = infos & NLN & "compte = " & nomCompte
    
    infos = infos & Entete("0", "")
    
    infos = Replace(infos, "---------------------", "")
    infos = Replace(infos, "///", "")
    
    'Affichage des chemins utilises
    Dim lesCh As String
    lesCh = lesCh & NLN & "divers :" & NLN & dossierDivers & NLN
    lesCh = lesCh & NLN & "application :" & NLN & fichierAppliGm & NLN
    
    infos = infos & lesCh
    
    MsgBox infos

End Sub





''===================================================================
''
''                           LANCEMENT
''
''===================================================================


Sub GmWord() 'lancement pour traiter le doc Word courant afin d'en extraire une nomenclature :
    LancerGm
End Sub

Sub GmWeb() 'lancement pour recuperer et traiter le texte de doc(s) publie(s) mentionne(s) dans le doc word actif :
    EcrireDocActif ("txtWeb")
    LancerAppliGm
End Sub

'Sub GmPdfWeb() 'lancement pour recuperer le(s) pdf de doc(s) publie(s) mentionne(s) dans le doc word actif :
'    EcrireDocActif ("pdfWeb")
'    LancerAppliGm
'End Sub

Private Function LancerGm()

    'Arreter
    Initialisation
    LancerAppliGm
    BoucleGm

    LancerGm = 1

End Function

Private Function LancerAppliGm() 'lance l'application "Goligom.nwjs"

    'executer une commande shell sans etre detecte par un antivirus :
    '
    'en utilisant CallByName, ici :
    'https://twitter.com/johnlatwc/status/1224705491839934467
    'https://docs.microsoft.com/fr-fr/office/vba/Language/Reference/User-Interface-Help/callbyname-function
    'https://www.codegrepper.com/code-examples/vb/vba+callbyname
    '
    'methodes de hackers, ici :
    'https://docs.microsoft.com/fr-fr/office/vba/Language/Reference/User-Interface-Help/callbyname-function
    'http://ropgadget.com/posts/abusing_win_functions.html
    'https://blog.sevagas.com/Launch-shellcodes-and-bypass-Antivirus-using-MacroPack-Pro-VBA-payloads
    'https://www.certego.net/en/news/advanced-vba-macros/
    'https://www.decalage.info/files/eu-19-Lagadec-Advanced-VBA-Macros-Attack-And-Defence.pdf

    If sep = "\" Then
        'Shell (fichierAppliGm)
        CallByName CreateObject("Shell.Application"), "ShellExecute", VbMethod, fichierAppliGm, "open", 1
    Else
        resul = AppleScript("ouvrirAppli", fichierAppliGm)
    End If

    LancerAppliGm = 1

End Function

Private Function Sandbox(fichiers)
        'la fonction GrantAccessToMultipleFiles() n'est connue que de Wordmac2016 (et versions suivantes).
        'Son appel est donc fait dans une fonction separee, pour de permettre a la macro
        'de tourner sur des versions de Word ne connaissant pas GrantAccessToMultipleFiles().
        
        'pb : en pratique ca marche manifestement mal puisqu'une autorisation est malgre tout demandee a chaque lancement,
        'pour le fichier texte.txt, que l'on invoque GrantAccessToMultipleFiles ou pas...
        'Sandbox = GrantAccessToMultipleFiles(fichiers)
        Sandbox = True

End Function

Private Function Parametrage()

    'Attribue les valeurs aux differents parametres pour qu'ils soient renseignes
    'de maniere cryptee lorsque ce module Vba est dans sa forme obfusqueee.
    'Ceci n'est pas possible dans la section du debut de la macro qui implique
    'de renseigner les variables (ou plutot les constantes) sans utiliser de fonction,
    'c'est-a-dire de facon explicite.

    sep = Application.PathSeparator 'IMPORTANT : sert a determiner si l'on est sous Windows ou MacOSX ou MacOS-Classic

    'cle'
    'cleDecryptage = "AiHnKlPxVhDmIu"

    'version :
    versionVba = "0.0.6" ' = version de ce code Vba
    nom1CeModele = "gm.dotm"
    nom2CeModele = "gmDev.dotm"
    nom3CeModele = "gmObf.dotm"
    
    'nomCompte = NomUtilisateurOFF()
    
    'parametres
    rafraichirSelection = False
    'autoriserPanneauRecherche = True
    identifierRetraits = True
    identifierCommentaires = True
    identifierItaliques = True
    economiserTestsItalique = True
    
    NLN = vbCr 'valeur pouvant eventuellement etre ajustee selon le systeme (vbCr, vbLf, vbCrLf)
    
    'emplacements :
    Dim locAppleScripts As String
    locAppleScripts = "Library:Application Scripts:com.microsoft.Word:WordVersGm.scpt" 'place ici pour une question d'obfuscation
    fichierAppleScripts = DossierHome() & Replace(locAppleScripts, ":", sep)
    
    'handler :
    periode = 501   ' periode souhaitee, de comparaison de la selection (en ms).
    pauseMini = 501    ' pause souhaitee, sans changement de selection avant ecriture du fichier txt (en ms).
    
    
    Parametrage = 1

End Function

Private Sub Initialisation()

    '
    '------ Initialisation d'emplacements de fichiers et autres ----------
    '
    Dim initialisationOk As Boolean
    initialisationOk = True
    
    resul = Parametrage()
    
    resul = TestAppleScript()
    resul = SystExpEtWord()

    'appel periodique de BoucleGm par Vba (Windows) ou par Js (MacOSX)
    If sep = "\" Then
        pilotageJs = False
    Else
        pilotageJs = True
    End If

    'arretExt = "0"

    resul = CheminsGm()
    initialisationOk = resul 'si les chemins essentiels (dossier principal) ne sont pas initialises => initialisation ko

    'Sandbox, pour Wordmac2016 :
    If initialisationOk And sep = "/" Then
        Dim fichiers
        'fichiers = Array(fichierAppleScripts, dossierDivers & "texte.txt", dossierDivers & "brevets.txt")
        fichiers = Array(fichierAppleScripts, dossierDivers & "texte.txt", dossierDivers & "brevets.txt")
        On Error Resume Next
        initialisationOk = Sandbox(fichiers)
    End If

    '
    '------ Initialisation de la boucle principale ----------
    '
    If periode < 0.501 Then
        initialisationOk = False
        MsgBox "Periode inferieure a 0.501 : ca ne peut pas fonctionner... "
    End If


    'Initialisations du handler
    '
    exporterMaintenant = False
    exportEnCours = False
    debutSel = 0
    finSel = 0
    txtSel = "z"
    anciennete = 0
    italiqueSel = False
    texteBrut = ""

    pause = pauseMini
    
    'revisions et commentaires :
    affichageTexteFinal = True
    nbRevisions = 0
    retraits = ""
    commentaires = ""
    
    'initialisations pour la detection de paragraphes italiques :
    italiques = ""
    lngTexteCourant = 0
    lngTexteDernierExport = 0
    ReDim prgItaliques(1 To 1)
    
    resul = ChgmtAffichageFinalOriginal(ActiveDocument, affichageTexteFinal)
    
    'MsgBox handler
    'MsgBox export
    'Pb de depassement de capacite sous Mac a resoudre ????
    dureeHandler = 0 'duree d'execution du handler
    dureeExport = 0 'duree d'etablissement du texte a exporter
    dureeExportMax = 0 'duree d'export maxi
    
    docTraite = CheminDoc(ActiveDocument)
    
    premierTour = True
    
    continuerGm = initialisationOk 'si pb (important) d'initialisation, la boucle ne sera pas lancee

End Sub

''===================================================================
''
''                             ARRETS
''
''===================================================================

Private Sub ArretOFF()

    'Important :
    '
    'Lorsque Nwjs s'apprete a fermer, quelle que soit l'origine de la fermeture
    'il demande a Vba d'executer cette macro.
    '
    'Cette macro arrete la boucle Vba (continuerGm->false), mais incidamment elle
    'demande aussi a Nwjs de fermer car elle reecrit au moins l'entete
    'du fichier txt : l'item "actualisation" de cet entte passe alors a 0,,
    'ce que Nwjs reconnait comme une demande de fermeture, puisque
    'son handler detecte que le fichier txt a ete reecrit, puis qu'il contient
    'actualisation = 0.
    '
    'C'est la raison pour laquelle la reecriture du fichier n'est executee
    'que si la boucle Vba tourne encore (continuerGm = true).
    '
    'Sans ca on a une boucle infinie lors de la fermeture : Vba reecrit a chaquee
    'fois le fichier txt avec actualisation=0, ce que Nwjs interpretet comme une
    'nouvelle demande de fermeture, relance donc la presente macro etc.
    '

    'MsgBox "arret de la boucle Vba" & NLN & "dans Word"

    If continuerGm = True Then
    
        continuerGm = False
        'Initialisation 'remise a 0 de differentes valeurs pour l'entete du fichier texte.txt
        'continuerGm = False 'on assure que la reinitialisation ne provoque pas un redemarrage
        
        EcrireTxt Entete("0", "") & "Pas de traitement en cours.", dossierDivers & "texte.txt", encodageTxt
        
    End If

End Sub

Sub ArretExtGm() 'appelee par Goligom.nwjs pour arreter la boucle Vba
    
    'MsgBox "ArretExtGm..."
    'arretExt = "1"
    continuerGm = False

End Sub

Private Sub ArretVbaEtGm()

    'MsgBox "arret de la boucle Vba" & NLN & "dans Word"
    'continuerGm = False

    If continuerGm = True Then
        continuerGm = False
        'Initialisation 'remise a 0 de differentes valeurs pour l'entete du fichier texte.txt
        EcrireTxt Entete("0", "") & "Pas de traitement en cours.", dossierDivers & "texte.txt", encodageTxt
    End If

End Sub


Sub AutoExit() 'de par son nom, se lance automatiquement a la fermeture de Word.
    ArretVbaEtGm
End Sub

Sub BoucleGm()
   
    If continuerGm Then
    
        Dim docOuv As Boolean
        docOuv = False
        On Error Resume Next
        docOuv = DocOuvert(docTraite)
        
        'MsgBox "docTraite : " & docTraite
        'MsgBox "docOuv : " & docOuv
   
        If Not docOuv Then
        
            'MsgBox "le document a ete ferme..."
            ArretVbaEtGm
        
        Else
    
            Dim docActif As String
            docActif = CheminDoc(ActiveDocument)
    
            If docActif = docTraite And Not exportEnCours Then
                
                'application.ScreenUpdating = False
                
                'Dim tpsIniHandler As Single
                tpsIniHandler = Timer
                
                'If Not autoriserPanneauRecherche Then FermerPanneauRecherche
                
                'A-Exporter maintenant ?
                If premierTour = True Then exporterMaintenant = True
                
                'changement du mode d'affichage (doc final/original) ?
                If Not exporterMaintenant And identifierRetraits Then exporterMaintenant = ChgmtAffichageFinalOriginal(ActiveDocument, affichageTexteFinal)
                
                'changement dans la selection ?
                If Not exporterMaintenant Then exporterMaintenant = ChgmtDansDocument(ActiveDocument, debutSel, finSel, txtSel, italiqueSel, texteBrut)

                dureeHandler = Round(Timer - tpsIniHandler, 3) * 1000  'duree d'execution du handler en ms
                
                'B-Ecriture du fichier si premier tour ou changement possible dans le document ;
                If exporterMaintenant Then resul = Exporter(ActiveDocument)

                exporterMaintenant = False
       
                'on reattribue la selection pour eviter un pb de disparition de selection avec Wordwin 2016 :
                If rafraichirSelection Then resul = RetablirSelection(debutSel, finSel, debutSelActif)

            End If
   
            'C-La boucle se rappelle elle-meme apres ecoulement de la periode
            '
            If Not pilotageJs And periode > 0.5 Then

                Dim msVba As Single
                msVba = 1.157E-08     ' = 1 ms en "temps VBA", soit 1/(24x3600x1000)

                Dim delaiVba As Single
                delaiVba = periode * msVba
                
                Application.OnTime Now + delaiVba, "BoucleGm"
                'Application.OnTime Now + 5.8E-06, "BoucleGm"

            End If
        
        End If
    
    End If
    
End Sub


Function ChgmtDansDocument(objDoc, debutSel, finSel, txtSel, italiqueSel, texteBrut)

    'determine si le document vient probablement d'etre modifie ou pas, si :
    '   - la pause s'est ecoulee apres changement de la position ou du texte de la selection.
        
    Dim chgmt As Boolean
    chgmt = False
    
    Dim rng As Range
    Set rng = Selection.Range.Duplicate
    
    debutSelActif = Selection.StartIsActive
    
    'pause ecoulee apres changement de la position ou du texte de la selection ?
    '
    'changement de la position de la selection ?
    Dim nvDebutSel As Long
    nvDebutSel = rng.Start
    'nvDebutSel = Selection.Start
    
    
    Dim nvFinSel As Long
    nvFinSel = rng.End
    'nvFinSel = Selection.End
    
    'changement du texte de la selection ?
    'On Error Resume Next 'Attn : probleme si pas de texte a droite du curseur (ex = document vide ou curseur a la fin du doc)
    Dim nvTxtSel As String
    nvTxtSel = rng.Text
    'nvTxtSel = Selection.Text
    
    Dim chgmtSelectionPuisPause As Boolean
    
    'pause ecoulee depuis le dernier changement de la selection ?
    If (nvFinSel <> finSel) Or (nvTxtSel <> txtSel) Then
        anciennete = 0
    Else
        'actualisation de l'anciennete du dernier changement de la selection :
        If anciennete < periode + pause Then 'N.B. : on evite que l'anciennete augmente indefiniment lorsque rien ne se passe
            anciennete = anciennete + periode
        End If
        'pause ecoulee (sans changement de la selection) depuis le dernier changement de la selection ?
        chgmtSelectionPuisPause = (pause <= anciennete) And (anciennete < periode + pause)
    End If
    
    If chgmtSelectionPuisPause Then
        Dim nvTexteBrut As String
        nvTexteBrut = objDoc.Range.Text
        If nvTexteBrut <> texteBrut Then 'N.B. : 70 ms pour 50 pages avec MacOSX
            chgmt = True 'export seulement si le texte a change lorsque sa longueur est identique
            texteBrut = nvTexteBrut
            lngTexteCourant = Len(nvTexteBrut) 'necessaire pour ParagraphesItaliques()
        End If
    End If
    
    'actualisations pour la prochaine iteration (et aussi pour retablir la selection) :
    debutSel = nvDebutSel
    finSel = nvFinSel

    
    txtSel = nvTxtSel
'    italiqueSel = nvItaliqueSel
    
    'Selection.Range = rng

    ChgmtDansDocument = chgmt

End Function




''===================================================================
''
''                        EXPORT DU TEXTE POUR PDF ET TXT BREVETS
''                               - ExportDocActif()
''
''                        EXPORT DU TEXTE POUR NOMENCLATURE
''                               - Exporter()
''                               - DocVersTxt()
''                               - NettoyerTxt()
''                               - Entete()
''                               - Horodate()
''
''===================================================================

Function EcrireDocActif(txtOuPdf)
    
    'recuperation du texte du document actif :
    Dim txt As String
    txt = ActiveDocument.Range.Text
    txt = NettoyerTxt(txt)

    'Etablissement de l'entete court (selection, pdf ou texte, date, et heure) :
    Dim ettc As String
    ettc = "------------------------------------------" & NLN
    ettc = ettc & "document = " & ActiveDocument.Path & NLN
    ettc = ettc & "demande = " & txtOuPdf & NLN
    ettc = ettc & "selection = [" & Selection.Start & "-" & Selection.End & "]" & NLN

    ettc = ettc & "horodate = " & Horodate & NLN
    ettc = ettc & "------------------------------------------" & NLN
    ettc = ettc & NLN & NLN & "///" & NLN
    
    'on s'assure que dossierDivers, systExp, encodageTxt etc sont renseignes
    'pour pouvoir ecrire valablement le texte :
    If dossierDivers = "" Then
        SystExpEtWord
        CheminsGm
    End If

    'ecriture du texte :
    EcrireTxt ettc & txt, dossierDivers & "brevets.txt", encodageTxt

    'MsgBox debut
    'EcrireTxtSimple = txtPropre

End Function


Private Function Exporter(objDoc)

    exportEnCours = True

    Dim tpsIni As Single
    tpsIni = Timer

    Dim txt As String
    txt = DocVersTxt(objDoc)

    'duree de l'export :
    dureeExport = Round(Timer - tpsIni, 3) * 1000
    If dureeExport > dureeExportMax Then dureeExportMax = dureeExport

    If premierTour Then
    '    'Si premier tour, passe supplementaire pour etablir immediatement la duree normale d'export,
    '    'qui est tres inferieure a celle du premier tour. C'est entre autres utile pour faire des essais.
        premierTour = False
        'Dim tpIni As Single
        tpsIni = Timer
        txt = DocVersTxt(objDoc)
        dureeExport = Round(Timer - tpsIni, 3) * 1000
        If dureeExport > dureeExportMax Then dureeExportMax = dureeExport
    End If

    'augmentation de la pause pour limiter la nuisance de lag du clavier lorsque le texte est long a exporter :
    'N.B. : seulement si le premier tour est passe et que la duree d'export est superieure a un seuil.
    If dureeExport > 200 And Not premierTour Then
        pause = pauseMini + dureeExport
    Else
        pause = pauseMini
    End If
    
    'premierTour = False
    
    Dim chem As String
    chem = CheminDoc(objDoc)
    
    Dim contenu As String
    contenu = Entete(chem, txt) & txt

    EcrireTxt contenu, dossierDivers & "texte.txt", encodageTxt

    lngTexteDernierExport = lngTexteCourant


    exportEnCours = False

    Exporter = 1

End Function


Private Function DocVersTxt(objDoc) As String

    'Retourne la chaine de caracteres de tout le document Word dans laquelle :
    '   - chaque paragraphe est numerote selon la numerotation de Word ;
    '   - les paragraphes initialement en italiques sont vides mais numerotes [*] ;
    '   - les caracteres ont ete nettoyes (suppression des caracteres 'parasites' (invisibles) issus de Word).
    
    '[*] comme les tests 'italique' sont couteux cette fonctionnalite est optimisee avec 'economiserTestsItalique' (necessaire avec MacOSX).

    'recuperation/etablissement du texte sous forme d'un string avec numerotation des paragraphes :
    'https://msdn.microsoft.com/en-us/vba/word-vba/articles/range-object-word
    
    '-------------------------------------------------------------------------------------------
    'Etablissement de la liste des retraits :
    
    retraits = ""

    If identifierRetraits Then
        nbRevisions = objDoc.Revisions.Count
        If nbRevisions <> 0 Then retraits = ListeRetraits(objDoc, affichageTexteFinal)
    End If

    If identifierCommentaires Then
        'MsgBox objDoc.Comments(2).Scope.Start & " " & objDoc.Comments(2).Scope.End
        'MsgBox objDoc.Comments.Count
        nbCommentaires = objDoc.Comments.Count
        If nbCommentaires <> 0 Then commentaires = ListeCommentaires(objDoc)
    End If
    
    '--------------------------------------------------------------------------------------------
    
    'Cette partie ajoute chaque tag de paragraphe ({p5c135}), elle actualise un tableau indiquant pour chaque paragraphe
    's'il est en italique (+1) ou non (-1), et elle etablit une liste (sous forme de chaine) des numeros de paragraphes italiques.
    '
    'L'actualisation est assuree en utilisant le tableau qui a ete actualise lors de l'appel precedent pour ne tester
    'que les paragraphes faisant partie de la selection, car tester tous les paragraphes a chaque appel est trop couteux en temps.
    'Lors du premier tour, tous les paragraphes sont testes puisqu'il n'y a pas de paragraphe precedent.
    '
    'On cree d'abord le nouveau tableau, contenant uniquement des 0 et dont la taille peut differer de celle du precedent.
    'Les cellules du nouveau tableau correspondant aux paragraphes de la selection sont renseignees en testant ces paragraphes dans le texte.
    'Les cellules du debut et de la fin du nouveau tableau sont renseignees en copiant celles du debut et de la fin du tableau precedent.
    '
    'Le tout est fait en une seule passe pour gagner du temps, et on utilise une selection etendue en amont pour l'ajuster a
    'l'ecart de longueur entre le texte courant et le texte precedement exporte, afin que cela fonctionne valablement lorsque
    'l'utilisateur colle un nouveau paragraphe (pouvant etre en italique).
    
    'Determination de la selection etendue :
    Dim debutSelEtendue As Long
    Dim finSelEtendue As Long
    If debutSel <= finSel Then
        debutSelEtendue = debutSel
        finSelEtendue = finSel
    Else
        debutSelEtendue = finSel
        finSelEtendue = debutSel
    End If
    
    If lngTexteDernierExport <> 0 Then
        Dim debutCorrige As Long
        debutCorrige = finSelEtendue - (lngTexteCourant - lngTexteDernierExport)
        If debutCorrige < debutSelEtendue Then debutSelEtendue = debutCorrige
    End If
    
    debutSelEtendue = debutSelEtendue - 5
    
    italiques = ""
    
    Dim texteSale As String
        
    Dim nbParagraphes
    nbParagraphes = objDoc.Paragraphs.Count
    
    ReDim nvPrgItaliques(1 To nbParagraphes) 'N.B. : le redimensionnement met toutes les valeurs a zero
    
    Dim rangDernierPrgSel As Long
    rangDernierPrgSel = nbParagraphes 'sera actualise jusqu'a valoir le rang du dernier paragraphe de la selection
    
    Dim Prg As Object
    Dim i As Long
    i = 1
    
    Dim delta As Long 'ecart de longueur entre nvPrgItaliques et prgItaliques
    delta = 1
    If Not premierTour Then delta = UBound(nvPrgItaliques, 1) - UBound(prgItaliques, 1)
    
    'N.B. : la boucle For Each (pour autant qu'elle veuille bien fonctionner sous WordMac)
    'permet de gagner un temps enorme par rapport a la boucle For i=1 etc :
    'L'export de ejecteur.doc passe a 110ms au lieu de 900ms...
    '
    'For i = 1 To nbParagraphes
    For Each Prg In objDoc.Paragraphs
        
        'Set Prg = objDoc.Paragraphs(i)
        
        'ajout du paragraphe precede de son tag (numero de paragraphe + rang de son 1er caractere) :
        texteSale = texteSale & "{p" & i & "c" & Prg.Range.Start & "}" & " " & Prg.Range.Text
                
        If identifierItaliques Then
            If premierTour Or (Not economiserTestsItalique) Or Recouvrement(Prg.Range.Start, Prg.Range.End, debutSelEtendue, finSelEtendue) Then
            
                rangDernierPrgSel = i
                If Prg.Range.Font.Italic = True Then 'N.B. : prg.Range.Italic peut aussi valoir wdUndefined
                    nvPrgItaliques(i) = 1
                Else
                    nvPrgItaliques(i) = -1
                End If
                
            Else
            
                If i > rangDernierPrgSel Then
                    On Error Resume Next
                    nvPrgItaliques(i) = prgItaliques(i - delta)
                Else
                    On Error Resume Next
                    nvPrgItaliques(i) = prgItaliques(i)
                End If
                'If nvPrgItaliques(i) = 0 Then MsgBox "zero au rang " & i & " ..."
            
            End If
            
            'si le paragraphe est en italique, ajout de son numero a la liste :
            If nvPrgItaliques(i) = 1 Then italiques = italiques & CStr(i) & ", "

        End If
        
        i = i + 1
        
    'Next i
    Next Prg
    
    If identifierItaliques Then
        'on termine la liste :
        italiques = "[" & italiques & "]"
        italiques = Replace(italiques, ", ]", "]")
        italiques = Replace(italiques, "[]", "") 'N.B. : si la liste est vide on renvoie une chaine vide
        
        'If InStr(1, listeStr, "[0") Or InStr(1, listeStr, " 0") Then MsgBox "zeros : " & NLN & listeStr
        'MsgBox "debutSel : " & debutSel & " finSel : " & finSel & NLN & "liste : " & listeStr & NLN & ListeVersChaine(nvPrgItaliques)
        
        'actualisation du tableau :
        prgItaliques = nvPrgItaliques
    
    End If
    
    Dim txtNettoye As String
    txtNettoye = NettoyerTxt(texteSale)
    
    DocVersTxt = txtNettoye

End Function

Private Function NettoyerTxt(texteSale)

    'Le 'nettoyage' supprime des caracteres non visibles qui compromettent le traitement ulterieur..
    'Ce traitement est fait avec la fonction CleanString qui retourne une chaine tronquee si la chaine qui
    'lui est adressee est trop longue. C'est pourquoi on procede par tronons..

    'Nettoyage de la chaine y compris si elle est trop longue
    'pour la fonction CleanString() :
    '
    Dim lngTrEntier As Long
    lngTrEntier = 30000     ' longueur max d'un troncon (= paramtre))
   
    Dim lngTexte As Long ' longueur du texte
    lngTexte = Len(texteSale)   ' Attn : cette longueur a en fait deja ete calculee pour lngTexteCourant...
        
    Dim nbTrEntiers As Integer
    nbTrEntiers = Int(lngTexte / lngTrEntier) ' Int designe la fonction partie entiree
    
    Dim textePropre As String
    Dim trSale As String
    Dim trPropre As String
    
    Dim debut As Long
    Dim fin As Long
    Dim longueur As Long
    
    'Passes executees lorsque le texte est trop long :
    '
    Dim i As Integer
    For i = 1 To nbTrEntiers
                
        debut = (i - 1) * lngTrEntier + 1
        fin = i * lngTrEntier
        longueur = fin - debut + 1
         
        trSale = Mid(texteSale, debut, longueur)
        trPropre = CleanString(trSale)              ' & "(coupure)"
        textePropre = textePropre & trPropre
        
   Next i
    
    'Passe pour le dernier troncon ou pour l'uniquee
    'tronon (lorsque le texte n'est pas trop long) ::
    '
    debut = lngTrEntier * nbTrEntiers + 1
    fin = lngTexte
    longueur = fin - debut + 1

    trSale = Mid(texteSale, debut, longueur)
    trPropre = CleanString(trSale)
    textePropre = textePropre & trPropre

    'Nettoyages supplementaires :
    '
    textePropre = Replace(textePropre, vbTab, " ")
    textePropre = Replace(textePropre, vbCr, NLN)

    NettoyerTxt = textePropre

End Function


Private Function Entete(cheminDocWord, txt)

    ' ajouter a un fichier :
    'http://www.devhut.net/2011/06/06/vba-append-text-to-a-text-file/

    'MsgBox Len(txt)
    'MsgBox cheminDocWord

    Dim ett As String

    ett = ett & NLN

    Dim Wrd As String
    Wrd = CStr(anneeWord)
    If versionWord <> "" Then Wrd = Wrd & " [" & versionWord & "]"
    
    ett = ett & "vba = " & versionVba & NLN
    ett = ett & "Word = " & Wrd & NLN
    ett = ett & "systeme = " & systExp & NLN
    
    ett = ett & NLN
    
    If cheminDocWord <> "0" Then
    
        Dim repertoire As String
        Dim nom As String
        If InStr(1, cheminDocWord, sep) Then
            repertoire = DossierParent(cheminDocWord)
            nom = Replace(cheminDocWord, repertoire, "")
        Else
            nom = cheminDocWord 'ex : Document1 sous Wordmac
        End If

        Dim suffixe As String
        If InStr(1, nom, ".") Then suffixe = Right(nom, InStr(1, StrReverse(nom), "."))
        If Len(suffixe) > 0 Then nom = Replace(nom, suffixe, "")
        
        If Len(nom) > 0 Then ett = ett & "nom = " & nom & NLN
        If Len(suffixe) > 0 Then ett = ett & "suffixe = " & suffixe & NLN
        If Len(repertoire) > 0 Then ett = ett & "dossier = " & repertoire & NLN

        'ett = ett & "selection = [" & Selection.Start & "-" & Selection.End & "]" & NLN

        ett = ett & NLN

        ett = ett & "caracteres = " & Len(txt) & NLN
        If commentaires <> "" Then ett = ett & "commentaires = " & commentaires & NLN
        If retraits <> "" Then ett = ett & "retraits = " & retraits & NLN
        If italiques <> "" Then ett = ett & "italiques = " & italiques & NLN
        ett = ett & "revisions = " & nbRevisions & NLN

        ett = ett & NLN

        ett = ett & "export = " & dureeExport & NLN   'duree courante d'etablissement du texte exporte
        ett = ett & "exportMax = " & dureeExportMax & NLN   'duree maxi d'etablissement du texte exporte (1er export)
        If Not pilotageJs Then ett = ett & "pause = " & pause & NLN 'Attn : pause en ms
        ett = ett & "handler = " & dureeHandler & NLN 'duree d'execution du handler
    
        ett = ett & NLN
    
    End If
        
    ett = ett & "horodate = " & Horodate & NLN
    ett = ett & "----------------------------------------"
    ett = ett & "----------------------------------------" & NLN
    'ett = ett & NLN & NLN
    ett = ett & "///" & NLN

    Entete = ett

'    MsgBox entete

End Function


Function Horodate()
    
    Dim hrdt As String
    hrdt = Replace(Format(Now(), "dd.mm.yyyy"), ".", "/") & " @ " & Time
    
    'ajout des ms :
    Dim ms As String
…