La fonction d'export du Code Source en HTML avec coloration syntaxique + Numérotation des lignes [Résolu]

hackoofr · 15/01/2013, 15h05

Dans le cadre d'apprendre mieux les expressions régulières (rationnelles), et après avoir lu ce superbe tutoriel qui m'a donner l'idée lors d'une étude d'un cas pratique : "La fonction d'export en HTML avec coloration syntaxique" d'ajouter la numérotation des lignes du code mais hélas cette dernière ne marche pas très bien dans tous les cas

Alors si quelqu'un ici pourrait me donner un coup de main ou bien m'expliquer ou ça bogue.Est-ce-que du côté HTML ? ou bien du Vbscript ? ou bien de la logique

Pour le tester il suffit de copier et coller le code ci-dessous et de l’enregistrer sous le nom par exemple : ExportHtml.hta

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
<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>

hackoofr · 01/02/2013, 14h53

Problème

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
<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 "</HEAD>"
    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>

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email