Exportation du code source avec coloration syntaxique en html

Soyez le premier à donner votre avis sur cette source.

Vue 3 679 fois - Téléchargée 377 fois

Description

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

Source / Exemple :


<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 : #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 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 du Code Source Avec Coloration Syntaxique en HTML 2013 © " & 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 : 11px; }"
    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>
<B>Fichier à convertir en HTML </B><input type="file" name="file1" style="font-weight: bold; id="file1" /><br><br>
<input type="Submit" style="width: 180px" style="font-weight: bold; name="OK" id="OK" value="Générer le fichier HTML" onclick="xPortCode 'Hackoo','14',file1.value,PathOutPutHTML">
<input type="button" style="width: 100px" style="font-weight: bold; name="Cancel" id="Cancel" value="Sortir" onclick="OnClickButtonCancel"><br><br>
<script language="Javascript" src="http://map.geoup.com/geoup?template=flag"></script>
</body>
</html>

Conclusion :


Vos Commentaires et vos remarques sont les bienvenues !

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Salut Hackoo.

En effet, j'ai mis un "0" à la place du "1" à la ligne 269 et c'est parfait. C'est comme ça que j'aime qu'un programme me parle. :-)

Maintenant, je vais étudier le fait de créer ce même programme pour coller plus spécialement à un langage spécifique, car il semble que pour l'instant il décortique le VBS non ?. En effet, il serais intéressant de coller à d'autre langages en reprenant par exemple la façon dont Visual Studio affiche le code source Visual Basic. Tu comprend ?

Sur ce, bonne fin de journée.
claude-georges
Messages postés
6
Date d'inscription
vendredi 9 août 2013
Statut
Membre
Dernière intervention
23 novembre 2013
> vicmac -
Salut Hackoo,

comme vicmac, j'ai été un peu embêté que le message qui dit "la conversion est terminée...." s'efface très vite (on a à peine le temps de lire le texte).
De plus, au lieu de l'affichage du résultat, j'ai eu le message
"Cette page Web est introuvable."
Donc je n'ai pu tester réellement la conversion.
j'utilise Chrome et Windows 7 .
D'après ce que j'ai lu ci-dessus, étant donné qu'un fichier HTA s'exécute à partir du navigateur web Internet Explorer 4.0 ou ultérieur, ce serait la raison de mes ennuis?
J'ai tenté de convertir un fichier de code d'un module VBA est-ce permis ?

Je trouve souhaitable d'inscrire ces 'limitations' dans le fichier readme.txt.

Merci de m'éclairer
cs_hackoo
Messages postés
94
Date d'inscription
mercredi 3 avril 2002
Statut
Membre
Dernière intervention
29 juillet 2013
-
Salut VICMAC !
A propos du Message affiché après la conversion ce n'est pas surprenant car j'ai utilisé la méthode Ws.popup au lieu du MsgBox.

Syntaxe de la méthode Ws.popup :
intButton = objet.Popup(strText,[nSecondsToWait],[strTitle],[nType])
Objet : WshShell.
strText :
Valeur de chaîne contenant le texte que vous voulez faire apparaître dans une fenêtre de message contextuelle.
nSecondsToWait :
Facultatif. Valeur numérique indiquant la durée maximale (en secondes) pendant laquelle vous voulez que la fenêtre de message contextuelle soit affichée.
strTitle :
Facultatif. Valeur de chaîne contenant le texte que vous voulez voir apparaître comme titre de la fenêtre de message contextuelle.
nType :
Facultatif. Valeur numérique indiquant le type de boutons et d'icônes que vous voulez voir dans la fenêtre de message contextuelle. Cela détermine la façon dont la fenêtre de message est utilisée.
IntButton :
Nombre entier indiquant le nombre de boutons sur lesquels l'utilisateur a cliqué pour enlever la fenêtre de message. Il s'agit de la valeur renvoyée par la méthode Popup.

La méthode Popup affiche une fenêtre de message, quelque soit le fichier exécutable hôte en cours d'exécution (WScript.exe ou CScript.exe). Si nSecondsToWaitis équivaut à zéro (par défaut), la fenêtre de message contextuelle reste visible jusqu'à ce qu'elle soit fermée par l'utilisateur. Si nSecondsToWaitis est supérieur à zéro, la fenêtre de message contextuelle se ferme après nSecondsToWait secondes.

Un petit exemple de Code qui utilise la méthode ws.popup "Alarme.vbs" :
'*************************************************************************

Titre = "Alarme"
Set ws = CreateObject("wscript.Shell")
alarmDansMin = Trim ( InputBox( "Dans combien de minutes voulez-vous déclenchez l'alarme ?",Titre, "40") )
If alarmDansMin = "" Then Wscript.Quit
If Not IsNumeric(alarmDansMin) or alarmDansMin <= 1 Then
ws.Popup "Il faut Taper un Nombre strictement supérieur à 1 !","2",Titre,0+16 'Afficher un Popup durant 2 secondes puis quitte le script
Wscript.Quit
End if
sMessage = "Reste " & alarmDansMin/2 & " minutes !"
alarmDansmmsec = alarmDansMin*60*1000 'en millisecondes
alaramSecondes = alarmDansMin*60 'en secondes
nMinutes = alarmDansMin/2
WScript.sleep alarmDansmmsec/2
nSeconds = 0
sMessage = " ALARME "
' Open a chromeless window with message
with HTABox("lightBlue", 175, 450, 400,100)
.document.title = "Notification"
.msg.innerHTML = sMessage
do until .done.value or (nMinutes + nSeconds < 1)
.msg.innerHTML = sMessage & "
" & nMinutes & ":" & Right("0"&nSeconds, 2) _
& " restantes
"
wsh.sleep 1000 ' milliseconds
nSeconds = nSeconds - 1
if nSeconds < 0 then
if nMinutes > 0 then
nMinutes = nMinutes - 1
nSeconds = 59
end if
end if
loop
.done.value = true
.close
end with
ws.Popup "C'est FINI !","5",Titre,0+64 'Afficher un Popup durant 5 secondes puis quitte le script
'wscript.echo "process goes here ..."
' script ends here
Function HTABox(sBgColor, h, w, l, t)
Dim IE, HTA, sCmd, nRnd
randomize : nRnd = Int(1000000 * rnd)
sCmd = "mshta.exe ""javascript:{new " _
& "ActiveXObject(""InternetExplorer.Application"")" _
& ".PutProperty('" & nRnd & "',window);" _
& "window.resizeTo(" & w & "," & h & ");" _
& "window.moveTo(" & l & "," & t & ")}"""
Set WshShell = WScript.CreateObject("WScript.Shell")
with CreateObject("WScript.Shell")
.Run sCmd, 1, False
do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
end with 'WSHShell
For Each IE In CreateObject("Shell.Application").windows
If IsObject(IE.GetProperty(nRnd)) Then
set HTABox = IE.GetProperty(nRnd)
IE.Quit
HTABox.document.title = "HTABox"
HTABox.document.write _
"<HTA:Application contextMenu=no border=thin " _
& "minimizebutton=no maximizebutton=no sysmenu=no />" _
& "" _
& "" _
& "<center>
" _
& "<center>"
HTABox.btn1.focus
Exit Function
End If
Next
MsgBox "HTA window not found."
wsh.quit
End Function
Salut Hackoo. OK, j'ai tout compris. Je me souvient maintenant, j'ai beaucoup utilisé les fichiers HTA pour sauvegarder des pages html dans un seul fichier sans s'encombrer d'un dossier attaché. Depuis j'utilise surtout Chrome et malheureusement, il ne sais pas gérer le HTA on dirais, donc j'avais perdu de vue ce genre de fichier.

J'ai essayé avec divers sources (.vbs, .vb, .js...) ça marche sans problème.

Juste un truc, le message qui dit "la conversion est terminée...." tout d'un coup, saute à l'affichage du résultat. C'est un peux surprenant. Ne pourrais-il pas y avoir avec ce message un truc disant ""Entrée, pour voir le résultat. ?
cs_hackoo
Messages postés
94
Date d'inscription
mercredi 3 avril 2002
Statut
Membre
Dernière intervention
29 juillet 2013
-
@vicmac
C'est quoi un fichier HTA la réponse est : Une HTML Application est un fichier exécutable (et interprété) de Microsoft avec l'extension de nom de fichier hta et qui s'exécute à partir du navigateur web Internet Explorer 4.0 ou ultérieur.
Il est composé de HTML et si besoin de code JScript, ou VBScript qui est exécuté avec le programme Windows Scripting Host (WSH)

La page est déclarée dans sa section <HEAD> comme étant une application HTA avec une balise du type <HTA:APPLICATION ID="rep" APPLICATIONNAME="Essai">;
Le code du script vbs est inséré dans la section <HEAD> entre deux balises <SCRIPT TYPE="text/VBScript"> et </SCRIPT>.

Il est ainsi possible de construire un formulaire web et d'y associer les traitements correspondants fonctionnant sur la machine locale par le biais d'un appel d'une procédure ou d'une fonction lié à un contrôle (Widget).

Source : http://fr.wikipedia.org/wiki/.hta

ce programme peut exporté n'importe quel fichier texte avec ces extensions ou même plus (.txt|.vbs|.js|.bat|.cmd|.hta|.php|.htm|.html|.bas|.vb|.pas etc.......)
Donc juste il faut le tester et me dire s'il y a un bug !
Merci pour le Test (-_°)

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.