Results 1 to 2 of 2

Thread: How to integrate a Javascript in HTA written in Vbscript ?

  1. #1

    Thread Starter
    Lively Member
    Join Date
    Dec 2010
    Location
    http://bbat.forumeiro.com/
    Posts
    86

    Question How to integrate a Javascript in HTA written in Vbscript ?

    HI
    I have this code in HTA is used to convert text into HTML.
    Code:
    <html>
    <head>
    <title>Exportation du Code Source avec coloration syntaxique en HTML © Hackoo © 2013</title>
    <HTA:APPLICATION
    APPLICATIONNAME="Exportation du Code Source avec coloration syntaxique en HTML © Hackoo © 2013"
    ID="Exportation du Code en HTML"
    ICON="Explorer.exe"
    BORDER="dialog"
    INNERBORDER="no"
    MAXIMIZEBUTTON="yes"
    SCROLL="no"
    VERSION="1.0"/>
    <style>
    Label
    {
    color : #123456;
    font-family : "Courrier New";
    }
    BODY {background-color:lightcyan;}
    input.button {  background-color : #EFEFEF;
    color : #000000; cursor:hand;
    font-size: 11px; font-family: Verdana, Arial, Helvetica, sans-serif; }
    }
    .alt2, .alt2Active
    {
    background: #E1E4F2;
    color: #000000;
    }   
    </style>
    </head>
    <META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
    <script language="VBScript">
    Sub Window_OnLoad
        CenterWindow 450,200
    End Sub
    Sub CenterWindow(x,y)
        window.resizeTo x, y
        iLeft = window.screen.availWidth/2 - x/2
        itop = window.screen.availHeight/2 - y/2
        window.moveTo ileft, itop
    End Sub
     
    Sub OnClickButtonCancel()
        Window.Close
    End Sub
     
    Function qq(strIn)
        qq = Chr(34) & strIn & Chr(34)
    End Function
     
    Function xPortCode(modName,sizeFont,InputFile,OutPutHTML)
        Dim i
        Dim strBuff
        Dim reg
        Dim KeyWords, KeyWordsList
        Dim Types, TypesList
        set fso = CreateObject("Scripting.FileSystemObject")
        Set reg = New regexp
        Set f = fso.OpenTextFile(OutPutHTML & ".html",2,True,-1)
        InputFile = file1.value
        If InputFile = "" Then
        MsgBox "ATTENTION ! "& vbcr & "Vous n'avez pas encore choisi un fichier !",48,"ATTENTION ! "& vbcr & "Vous n'avez pas encore choisi un fichier !"
        Exit Function
        End if
        Set f2 = Fso.OpenTextFile(InputFile,1)
        strBuff = f2.ReadAll '-- Lit la totalité du fichier
        NbLigneTotal = f2.Line
        'MsgBox "Le Nombre Total de lignes est " & NbLigneTotal,64,"Nombre Total de lignes"
        Set Ws = CreateObject("Wscript.Shell")
    'écriture des en-têtes HTML et style
        f.Writeline "<HTML>"
        f.Writeline "<HEAD><TITLE>Export au format HTML du module : " & modName & "</TITLE>"
        f.Writeline "<meta http-equiv=""Content-Type"" content=""text/html; charset=ISO-8859-1"" />"
        f.Writeline "<style type='Text/css'>"
        f.Writeline "<!--"
        f.Writeline "BODY {background:lightcyan;"
        f.Writeline "margin-top:10; margin-left:10; margin-right:0;"
        f.Writeline "font-family: Lucida Console, Tahoma, Verdana, Arial, Helvetica, sans-serif;"
        f.Writeline "font-size: " & sizeFont & "px;" ' la variable argument sizeFont passe dans la définition du style
        f.Writeline "}"
        f.Writeline ".commentaire {"
        f.Writeline "color: #669933;"
        f.Writeline "}"
        f.Writeline ".chaine {"
        f.Writeline "color: Red"
        f.Writeline "}"
        f.Writeline ".key {"
        f.Writeline "color: #0033BB;"
        f.Writeline "}"
        f.Writeline ".type {"
        f.Writeline "font-weight: bold;"
        f.Writeline "color: #3366CC;"
        f.Writeline "}"
        f.Writeline "-->"
        f.Writeline "</style>"
        f.WriteLine "<script type=""text/javascript"">"
        f.WriteLine "Function selectCode(a)"
        f.WriteLine "{"
        f.WriteLine "// Get ID of code block"
        f.WriteLine "var e = a.parentNode.parentNode.getElementsByTagName('PRE')[1];"
        f.WriteLine "// Not IE"
        f.WriteLine "if (window.getSelection)"
        f.WriteLine "{"
        f.WriteLine "    var s = window.getSelection();"
        f.WriteLine "    // Safari"
        f.WriteLine " if (s.setBaseAndExtent)"
        f.WriteLine "    {"
        f.WriteLine "        s.setBaseAndExtent(e, 0, e, e.innerText.length - 1);"
        f.WriteLine "    }"
        f.WriteLine "    // Firefox and Opera"
        f.WriteLine "    else"
        f.WriteLine "    {"
        f.WriteLine "        // workaround for bug # 42885"
        f.WriteLine "        if (window.opera && e.innerHTML.substring(e.innerHTML.length - 4) == '<BR>')"
        f.WriteLine "        {"
        f.WriteLine "            e.innerHTML = e.innerHTML + '&nbsp;';"
        f.WriteLine "        }"
        f.WriteLine "    var r = document.createRange();"
        f.WriteLine "        r.selectNodeContents(e);"
        f.WriteLine "        s.removeAllRanges();"
        f.WriteLine "        s.addRange(r);"
        f.WriteLine "    }"
        f.WriteLine " }"
        f.WriteLine " // Some older browsers"
        f.WriteLine " {"
        f.WriteLine "    var s = document.getSelection();"
        f.WriteLine "     var r = document.createRange();"
        f.WriteLine "    r.selectNodeContents(e);"
        f.WriteLine "    s.removeAllRanges();"
        f.WriteLine "    s.addRange(r);"
        f.WriteLine " }"
        f.WriteLine "// IE"
        f.WriteLine " else if (document.selection)"
        f.WriteLine "{"
        f.WriteLine "    var r = document.body.createTextRange();"
        f.WriteLine "     r.moveToElementText(e);"
        f.WriteLine "    r.select();"
        f.WriteLine "               }"
        f.WriteLine " }"
        f.Writeline "</script>"
        f.Writeline "</HEAD>"
        f.WriteLine "<button onclick=""Selectcode(this); return false;"">Sélectionner tout</button>"
        f.Writeline "<BODY>"
        f.Write "<pre class=""alt2"" dir=""ltr""><table cellspacing=""0"" cellpadding=""0""><tr><td valign=""top"" width=""33""><div style=""border: 1px dashed red; padding-left: 5px; padding-right: 5px; margin-right: 5px; text-align: center; font-family: monospace"">"
        For X = 0 To NbLigneTotal - 1
            Y = X + 1
            f.Write "<font color=""Red"">" & Y & "</font>.<br />"
        Next
        f.Write "</div></td><td valign=""top""><pre style=""margin: 0"">"
     
    ' empêcher les ouvertures de tag HTML
        strBuff = Replace(strBuff, "<", "&lt;")
    ' les retours chariot
        reg.Pattern = "(\n)(<br />)"
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "$1<br />")
     
    ' 1- les mots-clés
        KeyWordsList = "AddressOf©Alias©And©As©ByRef©ByVal©Call©Case©Close©CBool©CByte©CCur©" & _
        "CDate©CDec©CDbl©CInt©CLng©CSng©CStr©CVar©Const©Compare©Database©Declare©Debug©Default©" & _
        "Dim©Do©Each©Else©ElseIf©End©Enum©Erase©Error©Explicit©Event©Exit©False©For©" & _
        "Friend©Function©Get©GoTo©Handles©If©Implements©Imports©In©Inherits©" & _
        "Interface©Is©Let©Lib©Like©Loop©Me©Mod©New©Next©Not©Nothing©" & _
        "On©Open©Option©Optional©Or©ParamArray©Preserve©Print©Private©Property©Protected©" & _
        "Public©RaiseEvent©ReadOnly©Redim©REM©Resume©Return©Select©Set©Shared©Static©" & _
        "Step©Stop©Sub©Then© To ©True©Type©TypeOf ©Until©UBound©When©Wend©While©With©WithEvents©WriteOnly©Xor"
     
        KeyWords = Split(KeyWordsList,"©")
        For i = 0 To UBound(KeyWords)
            reg.Pattern = "(\W|^)(" & KeyWords(i) & ")(\W|$)"
            reg.Multiline = False
            reg.Global = True
            reg.IgnoreCase = True
            strBuff = reg.Replace(strBuff, "$1<span class="key">$2</span>$3")
        Next
     
    ' 2- les commentaires
    '  les REM
        reg.Pattern = "(\s)(rem .*)"
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "$1<span class="commentaire">$2</span>")   
     
    '  les apostrophes (')
        reg.Pattern = "(\n)(([^\x22\n]*\x22[^\x22\n]*\x22)*)([^\x22\n']*)('.*)."
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "$1$2$4<span class="commentaire">$5</span>")
     
    ' 3- les types
        TypesList = "Boolean©Byte©Date©Double©Integer©Long©Object©Short©Single©String©Unicode©Variant"
        Types = Split(TypesList, "©")
        For i = 0 To UBound(Types)
            reg.Pattern = "(\W|^)(" & Types(i) & ")(\W|$)"
            reg.Multiline = False
            reg.Global = True
            reg.IgnoreCase = True
            strBuff = reg.Replace(strBuff, "$1<span class="type">$2</span>$3")
        Next
     
    ' 4- les chaines
        reg.Pattern = "(\x22[^\x22\n]*\x22)"
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "<span class="chaine">$1</span>")
     
    ' Highlight dans un Highlight
        reg.Pattern = "(<span class=\w{6,11}>)(.*)(<span class=\w{3,11}>)(.*)(</span>)(.*</span>)"
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        Do While reg.Test(strBuff)
            strBuff = reg.Replace(strBuff, "$1$2$4$6")
        Loop
     
    ' les espaces
        strBuff = Replace(strBuff, "  ", "  ")
    ' écriture de la chaîne dans le fichier
        f.Writeline strBuff
        f.Writeline "</td></tr></table></pre>"
        f.Writeline "</BODY>"
        IMG = "<center><img src='"&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(110)&Chr(115)&Chr(109)&_
        Chr(48)&Chr(53)&Chr(46)&Chr(99)&Chr(97)&Chr(115)&Chr(105)&_
        Chr(109)&Chr(97)&Chr(103)&Chr(101)&Chr(115)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&Chr(47)&Chr(105)&_
        Chr(109)&Chr(103)&Chr(47)&Chr(50)&Chr(48)&Chr(49)&Chr(49)&Chr(47)&Chr(48)&Chr(55)&Chr(47)&Chr(50)&_
        Chr(51)&Chr(47)&Chr(47)&Chr(49)&Chr(49)&Chr(48)&Chr(55)&_
        Chr(50)&Chr(51)&Chr(48)&Chr(55)&Chr(52)&Chr(49)&_
        Chr(52)&Chr(48)&Chr(49)&Chr(51)&Chr(49)&Chr(49)&Chr(48)&_
        Chr(52)&Chr(56)&Chr(53)&Chr(48)&Chr(54)&Chr(52)&Chr(49)&_
        Chr(57)&Chr(46)&Chr(103)&Chr(105)&Chr(102)&"' alt='"&Chr(104)&Chr(97)&_
        Chr(99)&Chr(107)&Chr(111)&Chr(111)&Chr(102)&Chr(114)&Chr(64)&_
        Chr(121)&Chr(97)&Chr(104)&Chr(111)&Chr(111)&Chr(46)&Chr(102)&Chr(114)&"'</img>"
        f.WriteLine IMG
        f.Writeline "</HTML>"            
        f.Close
    'libération des objets mémoire
        Set reg = Nothing 
    'Ouverture du fichier HTML
        ws.Popup "La Conversion du ficher en HTML est terminé avec sucées !"&vbCr&_
        "Cliquer sur le Bouton OK pour ouvrir le fichier converti en HTML !","1","La Conversion du ficher en HTML est terminé avec sucées !",vbInformation
        ws.Run OutPutHTML & ".html",1,False
        Set Ws = Nothing
    End Function
    </script>
    <center>
    <label>Fichier à convertir en HTML </label><input type="file" name="file1" id="file1" /><br><br>
    <input type="button" style="width: 180px" name="OK" id="OK" value="Générer le fichier HTML" onclick="xPortCode 'Hackoo','14',file1.value,OutPutHTML">
    <input type="button" style="width: 100px" name="Cancel" id="Cancel" value="Sortir" onclick="OnClickButtonCancel"><br><br>
    <script language="Javascript" src="http://map.geoup.com/geoup?template=flag"></script>
    </body>
    </html>
    This generated code in HTML that I changed manually works 5/5 for selection.
    Test.html
    Code:
    <HTML>
    <HEAD><TITLE>Export au format HTML du module : Hackoo</TITLE>
    <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />
    <style type='Text/css'>
    <!--
    BODY {background:lightcyan;
    margin-top:10; margin-left:10; margin-right:0;
    font-family: Lucida Console, Tahoma, Verdana, Arial, Helvetica, sans-serif;
    font-size: 14px;
    }
    .commentaire {
    color: #669933;
    }
    .chaine {
    color: Red
    }
    .key {
    color: #0033BB;
    }
    .type {
    font-weight: bold;
    color: #3366CC;
    }
    -->
    </style>
    <script>
    function selectCode(a)
    {
        // Get ID of code block
        var e = a.parentNode.parentNode.getElementsByTagName('PRE')[1];
     
        // Not IE
        if (window.getSelection)
        {
            var s = window.getSelection();
            // Safari
            if (s.setBaseAndExtent)
            {
                s.setBaseAndExtent(e, 0, e, e.innerText.length - 1);
            }
            // Firefox and Opera
            else
            {
                // workaround for bug # 42885
                if (window.opera && e.innerHTML.substring(e.innerHTML.length - 4) == '<BR>')
                {
                    e.innerHTML = e.innerHTML + '&nbsp;';
                }
     
                var r = document.createRange();
                r.selectNodeContents(e);
                s.removeAllRanges();
                s.addRange(r);
            }
        }
        // Some older browsers
        else if (document.getSelection)
        {
            var s = document.getSelection();
            var r = document.createRange();
            r.selectNodeContents(e);
            s.removeAllRanges();
            s.addRange(r);
        }
        // IE
        else if (document.selection)
        {
            var r = document.body.createTextRange();
            r.moveToElementText(e);
            r.select();
        }
    }
    </script>
    </HEAD>
    <button onclick='selectCode(this); return false;'>Sélectionner tout</button>
    <BODY>
    <pre class="alt2" dir="ltr"><table cellspacing="0" cellpadding="0"><tr><td valign="top" width="33"><div style="border: 1px dashed red; padding-left: 5px; padding-right: 5px; margin-right: 5px; text-align: center; font-family: monospace"><font color="Red">1</font>.<br /><font color="Red">2</font>.<br /><font color="Red">3</font>.<br /><font color="Red">4</font>.<br /><font color="Red">5</font>.<br /><font color="Red">6</font>.<br /><font color="Red">7</font>.<br /><font color="Red">8</font>.<br /></div></td><td valign="top"><pre style="margin: 0"><span class="key">Set</span> objWord = CreateObject(<span class="chaine">"Word.Application"</span>)
     objWord.Visible = <span class="key">False</span>
     <span class="key">Set</span> objDoc = objWord.Documents.<span class="key">Open</span>(<span class="chaine">"C:\Documents and Settings\Administrateur\Mes documents\Téléchargements\M.doc"</span>)
     objWord.Selection.TypeText <span class="chaine">"This is some text to test its working"</span>
     objDoc.Save
     objDoc.<span class="key">Close</span>
    <span class="key">Set</span> objDoc = <span class="key">Nothing</span>
    <span class="key">Set</span> objWord = <span class="key">Nothing</span>
    </td></tr></table></pre>
    </BODY>
    </HTML>
    Now the problem is how to dynamically generate it by HTA ?

  2. #2

    Thread Starter
    Lively Member
    Join Date
    Dec 2010
    Location
    http://bbat.forumeiro.com/
    Posts
    86

    Thumbs up Re: How to integrate a Javascript in HTA written in Vbscript ?

    PROBLEM SOLVED
    Code:
    <html>
    <head>
    <title>Exportation du Code Source avec coloration syntaxique en HTML © Hackoo © 2013</title>
    <HTA:APPLICATION
    APPLICATIONNAME="Exportation du Code Source avec coloration syntaxique en HTML © Hackoo © 2013"
    ID="Exportation du Code en HTML"
    ICON="Explorer.exe"
    BORDER="dialog"
    INNERBORDER="no"
    MAXIMIZEBUTTON="yes"
    SCROLL="no"
    VERSION="1.0"/>
    <style>
    Label
    {
    color : #123456;
    font-family : "Courrier New";
    }
    BODY {background-color:lightcyan;}
    input.button {  background-color : #EFEFEF;
    color : #000000; cursor:hand;
    font-size: 11px; font-family: Verdana, Arial, Helvetica, sans-serif; }
    }
    .alt2, .alt2Active
    {
    background: #E1E4F2;
    color: #000000;
    }    
    </style>
    </head>
    <META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
    <script language="VBScript">
    Sub Window_OnLoad
        CenterWindow 450,200
    End Sub
    Sub CenterWindow(x,y)
        window.resizeTo x, y
        iLeft = window.screen.availWidth/2 - x/2
        itop = window.screen.availHeight/2 - y/2
        window.moveTo ileft, itop
    End Sub 
     
    Sub OnClickButtonCancel()
        Window.Close
    End Sub
     
    Function qq(strIn)
        qq = Chr(34) & strIn & Chr(34)
    End Function
     
    Function xPortCode(modName,sizeFont,InputFile,OutPutHTML)
        Dim i 
        Dim strBuff
        Dim reg 
        Dim KeyWords, KeyWordsList
        Dim Types, TypesList
        set fso = CreateObject("Scripting.FileSystemObject")
        Set reg = New regexp
        Set f = fso.OpenTextFile(OutPutHTML & ".html",2,True)
        InputFile = file1.value
        If InputFile = "" Then
            MsgBox "ATTENTION ! "& vbcr & "Vous n'avez pas encore choisi un fichier !",48,"ATTENTION ! "& vbcr & "Vous n'avez pas encore choisi un fichier !"
            Exit Function
        End if
        Set f2 = Fso.OpenTextFile(InputFile,1)
        strBuff = f2.ReadAll '-- Lit la totalité du fichier
        NbLigneTotal = f2.Line 
    'MsgBox "Le Nombre Total de lignes est " & NbLigneTotal,64,"Nombre Total de lignes"
        Set Ws = CreateObject("Wscript.Shell")
    'écriture des en-têtes HTML et style
        f.Writeline "<HTML>"
        f.Writeline "<HEAD><TITLE>Export au format HTML du module : " & modName & "</TITLE>"
        f.Writeline "<meta http-equiv=""Content-Type"" content=""text/html; charset=ISO-8859-1"" />"
        f.Writeline "<style type='Text/css'>"
        f.Writeline "<!--"
        f.Writeline "BODY {background:lightcyan;"
        f.Writeline "margin-top:10; margin-left:10; margin-right:0;"
        f.Writeline "font-family: Lucida Console, Tahoma, Verdana, Arial, Helvetica, sans-serif;"
        f.Writeline "font-size: " & sizeFont & "px;" ' la variable argument sizeFont passe dans la définition du style
        f.Writeline "}"
        f.Writeline ".commentaire {"
        f.Writeline "color: #669933;"
        f.Writeline "}"
        f.Writeline ".chaine {"
        f.Writeline "color: Red"
        f.Writeline "}"
        f.Writeline ".key {"
        f.Writeline "color: #0033BB;"
        f.Writeline "}"
        f.Writeline ".type {"
        f.Writeline "font-weight: bold;"
        f.Writeline "color: #3366CC;"
        f.Writeline "}"
        f.Writeline "-->"
        f.Writeline "</style>"
        f.WriteLine "<script>"
        f.WriteLine "function selectCode(a)"
        f.WriteLine "{"
        f.WriteLine "// Get ID of code block"
        f.WriteLine "var e = a.parentNode.parentNode.getElementsByTagName('PRE')[1];"
        f.WriteLine "// Not IE"
        f.WriteLine "if (window.getSelection)"
        f.WriteLine "{"
        f.WriteLine "    var s = window.getSelection();"
        f.WriteLine "    // Safari"
        f.WriteLine " if (s.setBaseAndExtent)"
        f.WriteLine "    {"
        f.WriteLine "        s.setBaseAndExtent(e, 0, e, e.innerText.length - 1);"
        f.WriteLine "    }"
        f.WriteLine "    // Firefox and Opera"
        f.WriteLine "    else"
        f.WriteLine "    {"
        f.WriteLine "        // workaround for bug # 42885"
        f.WriteLine "        if (window.opera && e.innerHTML.substring(e.innerHTML.length - 4) == '<BR>')"
        f.WriteLine "        {"
        f.WriteLine "            e.innerHTML = e.innerHTML + ' ';"
        f.WriteLine "        }"
        f.WriteLine "    var r = document.createRange();"
        f.WriteLine "        r.selectNodeContents(e);"
        f.WriteLine "        s.removeAllRanges();"
        f.WriteLine "        s.addRange(r);"
        f.WriteLine "    }"
        f.WriteLine " }"
        f.WriteLine " // Some older browsers"
        f.WriteLine " else if (document.getSelection)"
        f.WriteLine " {"
        f.WriteLine "    var s = document.getSelection();"
        f.WriteLine "     var r = document.createRange();"
        f.WriteLine "    r.selectNodeContents(e);"
        f.WriteLine "    s.removeAllRanges();"
        f.WriteLine "    s.addRange(r);"
        f.WriteLine " }"
        f.WriteLine "// IE"
        f.WriteLine " else if (document.selection)"
        f.WriteLine    "{"
        f.WriteLine "    var r = document.body.createTextRange();"
        f.WriteLine "     r.moveToElementText(e);"
        f.WriteLine "    r.select();"
        f.WriteLine     "}"
        f.WriteLine " }"
        f.Writeline "<HACKOOscript>"
        f.Writeline "</HEAD>"
        f.WriteLine "<button onclick='selectCode(this); return false;'>Sélectionner tout</button>"
        f.Writeline "<BODY>"
        f.Write "<pre class=""alt2"" dir=""ltr""><table cellspacing=""0"" cellpadding=""0""><tr><td valign=""top"" width=""33""><div style=""border: 1px dashed red; padding-left: 5px; padding-right: 5px; margin-right: 5px; text-align: center; font-family: monospace"">"
        For X = 0 To NbLigneTotal - 1
            Y = X + 1
            f.Write "<font color=""Red"">" & Y & "</font>.<br />"
        Next
        f.Write "</div></td><td valign=""top""><pre style=""margin: 0"">"
     
    ' empêcher les ouvertures de tag HTML
        strBuff = Replace(strBuff, "<", "<")
    ' les retours chariot
        reg.Pattern = "(\n)(<br />)"
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "$1<br />")
     
    ' 1- les mots-clés
        KeyWordsList = "AddressOf©Alias©And©As©ByRef©ByVal©Call©Case©Close©CBool©CByte©CCur©" & _
        "CDate©CDec©CDbl©CInt©CLng©CSng©CStr©CVar©Const©Compare©Database©Declare©Debug©Default©" & _
        "Dim©Do©Each©Else©ElseIf©End©Enum©Erase©Error©Explicit©Event©Exit©False©For©" & _
        "Friend©Function©Get©GoTo©Handles©If©Implements©Imports©In©Inherits©" & _
        "Interface©Is©Let©Lib©Like©Loop©Me©Mod©New©Next©Not©Nothing©" & _
        "On©Open©Option©Optional©Or©ParamArray©Preserve©Print©Private©Property©Protected©" & _
        "Public©RaiseEvent©ReadOnly©Redim©REM©Resume©Return©Select©Set©Shared©Static©" & _
        "Step©Stop©Sub©Then© To ©True©Type©TypeOf ©Until©UBound©When©Wend©While©With©WithEvents©WriteOnly©Xor"
     
        KeyWords = Split(KeyWordsList,"©")
        For i = 0 To UBound(KeyWords)
            reg.Pattern = "(\W|^)(" & KeyWords(i) & ")(\W|$)"
            reg.Multiline = False
            reg.Global = True
            reg.IgnoreCase = True
            strBuff = reg.Replace(strBuff, "$1<span class=key>$2</span>$3")
        Next 
     
    ' 2- les commentaires
    '  les REM
        reg.Pattern = "(\s)(rem .*)"
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "$1<span class=commentaire>$2</span>")    
     
    '  les apostrophes (')
        reg.Pattern = "(\n)(([^\x22\n]*\x22[^\x22\n]*\x22)*)([^\x22\n']*)('.*)."
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "$1$2$4<span class=commentaire>$5</span>")
     
    ' 3- les types
        TypesList = "Boolean©Byte©Date©Double©Integer©Long©Object©Short©Single©String©Unicode©Variant"
        Types = Split(TypesList, "©")
        For i = 0 To UBound(Types)
            reg.Pattern = "(\W|^)(" & Types(i) & ")(\W|$)"
            reg.Multiline = False
            reg.Global = True
            reg.IgnoreCase = True
            strBuff = reg.Replace(strBuff, "$1<span class=type>$2</span>$3")
        Next 
     
    ' 4- les chaines
        reg.Pattern = "(\x22[^\x22\n]*\x22)"
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "<span class=chaine>$1</span>")
     
    ' Highlight dans un Highlight
        reg.Pattern = "(<span class=\w{6,11}>)(.*)(<span class=\w{3,11}>)(.*)(</span>)(.*</span>)"
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        Do While reg.Test(strBuff)
            strBuff = reg.Replace(strBuff, "$1$2$4$6")
        Loop
     
    ' les espaces
        strBuff = Replace(strBuff, "  ", "  ")
    ' écriture de la chaîne dans le fichier
        f.Writeline strBuff
        f.Writeline "</td></tr></table></pre>"
        f.Writeline "</BODY>"
        IMG = "<center><img src='"&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(110)&Chr(115)&Chr(109)&_
        Chr(48)&Chr(53)&Chr(46)&Chr(99)&Chr(97)&Chr(115)&Chr(105)&_
        Chr(109)&Chr(97)&Chr(103)&Chr(101)&Chr(115)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&Chr(47)&Chr(105)&_
        Chr(109)&Chr(103)&Chr(47)&Chr(50)&Chr(48)&Chr(49)&Chr(49)&Chr(47)&Chr(48)&Chr(55)&Chr(47)&Chr(50)&_
        Chr(51)&Chr(47)&Chr(47)&Chr(49)&Chr(49)&Chr(48)&Chr(55)&_
        Chr(50)&Chr(51)&Chr(48)&Chr(55)&Chr(52)&Chr(49)&_
        Chr(52)&Chr(48)&Chr(49)&Chr(51)&Chr(49)&Chr(49)&Chr(48)&_
        Chr(52)&Chr(56)&Chr(53)&Chr(48)&Chr(54)&Chr(52)&Chr(49)&_
        Chr(57)&Chr(46)&Chr(103)&Chr(105)&Chr(102)&"' alt='"&Chr(104)&Chr(97)&_
        Chr(99)&Chr(107)&Chr(111)&Chr(111)&Chr(102)&Chr(114)&Chr(64)&_
        Chr(121)&Chr(97)&Chr(104)&Chr(111)&Chr(111)&Chr(46)&Chr(102)&Chr(114)&"'</img>"
        f.WriteLine IMG
        f.Writeline "</HTML>"             
        f.Close 
        PatchScript
    'libération des objets mémoire
        Set reg = Nothing  
    'Ouverture du fichier HTML
        ws.Popup "La Conversion du ficher en HTML est terminé avec sucées !"&vbCr&_
        "Cliquer sur le Bouton OK pour ouvrir le fichier converti en HTML !","1","La Conversion du ficher en HTML est terminé avec sucées !",vbInformation
        ws.Run OutPutHTML & ".html",1,True
        Set Ws = Nothing
    End Function
     
    Sub PatchScript
        set fso = CreateObject("Scripting.FileSystemObject")
        Set freadHTML = fso.OpenTextFile(OutPutHTML & ".html",1)
        strBuffHTML = freadHTML.ReadAll
        strBuffHTML = Replace(strBuffHTML,"HACKOO","/")
        Set fwriteHTML = fso.OpenTextFile(OutPutHTML & ".html",2)
        fwriteHTML.Writeline strBuffHTML
    End Sub
    </script>
    <center>
    <label>Fichier à convertir en HTML </label><input type="file" name="file1" id="file1" /><br><br>
    <input type="button" style="width: 180px" name="OK" id="OK" value="Générer le fichier HTML" onclick="xPortCode 'Hackoo','14',file1.value,OutPutHTML">
    <input type="button" style="width: 100px" name="Cancel" id="Cancel" value="Sortir" onclick="OnClickButtonCancel"><br><br>
    <script language="Javascript" src="http://map.geoup.com/geoup?template=flag"></script>
    </body>
    </html>
    As you can see how should be the output in HTML like this one Code2HTML.hta

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width