Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to integrate a Javascript in HTA written in Vbscript ?

Status
Not open for further replies.
crackoo

crackoo

Programmer
Feb 17, 2011
132
0
0
TN
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="[URL unfurl="true"]http://map.geoup.com/geoup?template=flag"></script>[/URL]
</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 ?
 
Sort by date Sort by votes
Thank you ! Geates
PROBLEM SOLVED [2thumbsup]
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="[URL unfurl="true"]http://map.geoup.com/geoup?template=flag"></script>[/URL]
</body>
</html>
As you can see how should be the output in HTML like this one Code2HTML.hta [2thumbsup]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

bdwilcox
  • Question
Trying to adapt VBScript to search if machine is in an AD group 6
Replies
8
Views
444
SoftwareRT
SoftwareRT
K
  • Question
VBSCRIPT dont work windows 11 23h2 ???
Replies
2
Views
176
SoftwareRT
SoftwareRT
bdwilcox
  • Locked
  • Question
HTA fails with Syntax Error when working VBScript inserted
Replies
2
Views
208
bdwilcox
bdwilcox
lunter
  • Locked
  • Question
How to create vbArray+vbByte (8209) in *.vbs stript
Replies
0
Views
140
lunter
lunter
bdwilcox
  • Locked
  • Question
Validate that HTA text input boxes aren't blank on submission
Replies
1
Views
173
bdwilcox
bdwilcox

Part and Inventory Search

Sponsor

Back
Top