Je vous propose un nouvel élément à utiliser : Exportation du Code Source avec coloration syntaxique en HTML
Tout est dans le titre : C'est un outil en HTA pour faire la coloration syntaxique d'un code source et d'exporter le résultat dans un fichier html
Je veux la partager avec vous
Merci
Voici un aperçu d'un code écrit en Vbscript généré par cette application :
► Afficher le texteCode2HTML.hta
Code : Tout sélectionner
<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="No"
SCROLL="no"
VERSION="1.0"/>
<style>
Label
{
color : !!
font-family : "Courrier New";
}
BODY {background-color:lightcyan;}
input.button { background-color : !!
color : !! 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 640,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
Sub CreateFolder(strPath)
set fso = CreateObject("Scripting.FileSystemObject")
If strPath <> "" Then
If Not fso.FolderExists(fso.GetParentFolderName(strPath)) then Call CreateFolder(fso.GetParentFolderName(strPath))
fso.CreateFolder(strPath)
End If
End Sub
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
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
MyFolder = fso.GetAbsolutePathName(".")
TabFolder = Split(MyFolder,"\")
DossierCourant = TabFolder(UBound(TabFolder))
DossierCourantHTML = DossierCourant&"_HTML"
If Not fso.FolderExists(DossierCourantHTML) Then
CreateFolder(DossierCourantHTML)
End if
Tab = Split(InputFile,"\")
OutPutHTML = Tab(UBound(Tab))
PathOutPutHTML = fso.GetAbsolutePathName(".") & "\" & DossierCourantHTML & "\" & OutPutHTML & ".html"
Set f = fso.OpenTextFile(PathOutPutHTML,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>Exportation au format HTML © " & 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 ".genmed { font-size : !! }"
f.Writeline ".code { font-family: Comic sans MS, 'Courier New', sans-serif; font-size: 11px; color: #006600;"
f.WriteLine "background-color: #FAFAFA; border: #D1D7DC; border-style: solid;"
f.WriteLine "border-left-width: 1px; border-top-width: 1px; border-right-width: 1px; border-bottom-width: 1px }"
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 "<table width=""90%"" cellspacing=""1"" cellpadding=""3"" border=""0"" align=""center"">"&_
"<tr><td><span class=""genmed""><b>CODE:</b></span></td></tr><tr><td class=""code""><tr><td><pre><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></pre></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
'MsgBox PathOutPutHTML
ws.Run qq(PathOutPutHTML),1,True
Set Ws = Nothing
End Function
Sub PatchScript
set fso = CreateObject("Scripting.FileSystemObject")
InputFile = file1.value
Tab = Split(InputFile,"\")
OutPutHTML = Tab(UBound(Tab))
MyFolder = fso.GetAbsolutePathName(".")
TabFolder = Split(MyFolder,"\")
DossierCourant = TabFolder(UBound(TabFolder))
DossierCourantHTML = DossierCourant&"_HTML"
PathOutPutHTML = fso.GetAbsolutePathName(".") & "\" & DossierCourantHTML & "\" & OutPutHTML & ".html"
Set freadHTML = fso.OpenTextFile(PathOutPutHTML,1)
strBuffHTML = freadHTML.ReadAll
strBuffHTML = Replace(strBuffHTML,"HACKOO","/")
Set fwriteHTML = fso.OpenTextFile(PathOutPutHTML,2)
fwriteHTML.Writeline strBuffHTML
fwriteHTML.Close
End Sub
</script>
<center>
<label>Fichier à convertir en HTML </label><input type="file" name="file1" id="file1" /><br><br>
<input type="Submit" style="width: 180px" name="OK" id="OK" value="Générer le fichier HTML" onclick="xPortCode 'Hackoo','14',file1.value,PathOutPutHTML">
<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>
- Code2HTML.zip
- [HTA] Exportation du Code Source Avec Coloration Syntaxique en HTML
- (4.14 Kio) Téléchargé 90 fois



bien pour ces liens 