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!

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

[HTA] Txt2HTML + Numbers of Lines Issues ?

Status
Not open for further replies.

crackoo

Programmer
Feb 17, 2011
132
TN
Hi !
I'm trying with this code in HTA to convert any text file to HTML file and i would like to add with it the numbers of lines in the code , but i have this issue that when the code contents a comment like after "'" character the output with numbers of lines becomes incorrect.
So how can i modifiy this code to correct this little bug !
Thnak You !
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)
    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:moccasin;"
    f.Writeline "margin-top:0; 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: #993399;"
    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 "</HEAD>"
    f.Writeline "<BODY>"
    f.Write "<pre class=""alt2"" dir=""ltr"" style=""clear: both; margin: 20px; padding: 5px; border: 1px inset; width: 1200px; height: 1000px; text-align: left;overflow: auto""><table cellspacing=""0"" cellpadding=""0""><tr><td valign=""top"" width=""33""><div style=""border: 1px dashed gray; padding-left: 5px; padding-right: 5px; margin-right: 5px; text-align: right; 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>"
    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 !","2","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><br>
<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">
</body>
</html>
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top