Batch Index du Forum
S’enregistrerRechercherFAQMembresGroupesConnexion
Répondre au sujet Page 1 sur 1
Exportation du Code avec coloration syntaxique en HTML
Auteur Message
Répondre en citant
Message Exportation du Code avec coloration syntaxique en HTML 
Tout est dans le titre :



Code:
[lang=vb]<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 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 : 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, "<", "&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
    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>




Dernière édition par Hackoo le Dim 24 Mar 2013 - 22:54; édité 1 fois

______________________________________________________
Mes Contributions en Téléchargement
Message Publicité 
PublicitéSupprimer les publicités ?


Répondre en citant
Message Exportation du Code avec coloration syntaxique en HTML 
Hello Mr. Green

Intéressant, faudra que j'essai ça Okay

Bien joué Wink




______________________________________________________
│Øδ@π.
Visiter le site web du posteur Skype
Répondre en citant
Message Exportation du Code avec coloration syntaxique en HTML 
Merci Hackoo pour ce code ^^
C'est plus du VBS qui est mis dans du html mais bref. Smile




______________________________________________________
Skype
Répondre en citant
Message Exportation du Code avec coloration syntaxique en HTML 
Salut
Voici la sortie de la nouvelle Version : Conversion par lot càd conversion des fichiers contenus dans un dossier et non pas un par un Laughing
J'attends vos tests pour Code2Folder.vbs et non pas en HTA
Code:
[lang=vb]Copyright = "      Hackoo © 2013"
ext = Array("htm","hta","html","vbs","txt","js","php","bat","cmd","asp","reg","jsp")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier qui contient les extensions suivantes : (htm,hta,html,vbs,txt,js,php,bat,cmd,asp,reg,jsp) "&vbcr&vbTab&vbTab&Copyright, 1, "c:\Programs")
If objFolder Is Nothing Then
    Wscript.Quit
End If
NomDossier = objFolder.title
CheminDossier = objFolder.self.path
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(CheminDossier)
 
    MyFolder = fso.GetAbsolutePathName(".")
    TabFolder = Split(MyFolder,"\")
    DossierCourant = TabFolder(UBound(TabFolder))
    DossierCourantHTML = DossierCourant&"_HTML"
    FolderOutPutHTML = fso.GetAbsolutePathName(".") & "\" & DossierCourantHTML & "\" & OutPutHTML
For each Fichier in Dossier.files
        For i=LBound(ext) To UBound(ext)
           If (UCase(ext(i)) = UCase(fso.GetExtensionName(Fichier.Name))) Then
              xPortCode "Hackoo","14",Fichier,OutPutHTML
              PatchScript(Fichier)
           End If
        Next
Next
 
Call Explorer(FolderOutPutHTML)
 
Function Explorer(PathFolder)
Set Ws = CreateObject("Wscript.Shell")
WS.Run "explorer.exe /e," & PathFolder, 1, False
End Function
 
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
    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, "<", "&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
    PatchScript(InputFile)
'libération des objets mémoire
    Set reg = Nothing 
'Ouverture du fichier HTML
    ws.Popup "La Conversion du fichier "&qq(InputFile)&" en HTML est terminé avec Succés !","2","La Conversion du fichier en HTML est terminé avec Succés !",vbInformation
    'Set Ws = Nothing
End Function
 
Sub PatchScript(InputFile)
    set fso = CreateObject("Scripting.FileSystemObject")
    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





______________________________________________________
Mes Contributions en Téléchargement
Répondre en citant
Message Exportation du Code avec coloration syntaxique en HTML 
Hello,

marche pas chez moi.
Un conseil, explications (un aperçu en photo) sera le bienvenue.

Merci Wink




______________________________________________________
Le batch est mon joujou de tout les jours,
plus pour le loisir que pour le travail,
et avec j'apprend presque tout les jours,
comment programmer et le travailler,
pour avoir enfin un résultat cool.

Ed la poignée du 93 (^_^)
Yahoo Messenger MSN Skype
Répondre en citant
Message Exportation du Code avec coloration syntaxique en HTML 
Salut ! Cool
@Blouquin Eddy
Pour le 1er Code en HTA : les explications se trouve ici
Pour le second code il faut l’enregistrer au lieu de l'extension .hta par l'extension .vbs Okay




______________________________________________________
Mes Contributions en Téléchargement
Répondre en citant
Message Exportation du Code avec coloration syntaxique en HTML 
Merci Embarassed

Maintenant que j'ai ceci, ça va changer ma vision de voir les choses dans les programmations à venir.
Merci bien Okay




______________________________________________________
Le batch est mon joujou de tout les jours,
plus pour le loisir que pour le travail,
et avec j'apprend presque tout les jours,
comment programmer et le travailler,
pour avoir enfin un résultat cool.

Ed la poignée du 93 (^_^)
Yahoo Messenger MSN Skype
Répondre en citant
Message Exportation du Code avec coloration syntaxique en HTML 
Fantastique aimait le code.



Visiter le site web du posteur
Message Exportation du Code avec coloration syntaxique en HTML 


Montrer les messages depuis:
Répondre au sujet Page 1 sur 1
  



Index | créer un forum | Forum gratuit d’entraide | Annuaire des forums gratuits | Signaler une violation | Conditions générales d'utilisation
Copyright 2008 - 2016 // Batch