API tools faq
paste
Advertisement
omegastripes

XportCode2HTML.hta

omegastripes
Mar 3rd, 2014
368
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 14.09 KB | None | 0 0
raw download clone embed print report diff
  1. <!-- http://pastebin.com/JBqi040r -->
  2. <html>
  3. <head>
  4. <title>Exportation du Code Source Avec Coloration Syntaxique en HTML © Hackoo © 2013</title>
  5. <HTA:APPLICATION
  6. APPLICATIONNAME="Exportation du Code Source Avec Coloration Syntaxique en HTML © Hackoo © 2013"
  7. ID="Exportation du Code en HTML"
  8. ICON="Explorer.exe"
  9. BORDER="dialog"
  10. INNERBORDER="no"
  11. MAXIMIZEBUTTON="No"
  12. SCROLL="no"
  13. VERSION="1.0"/>
  14. <style>
  15. Label
  16. {
  17. color : #123456;
  18. font-family : "Courrier New";
  19. }
  20. BODY {background-color:lightcyan;}
  21. input.button {  background-color : #EFEFEF;
  22. color : #000000; cursor:hand;
  23. font-size: 11px; font-family: Verdana, Arial, Helvetica, sans-serif; }
  24. }
  25. .alt2, .alt2Active
  26. {
  27. background: #E1E4F2;
  28. color: #000000;
  29. }    
  30. </style>
  31. <!-- * tag <script> doit être dans tag <head> -->
  32. <META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
  33. <script language="VBScript">
  34. Sub Window_OnLoad
  35.     CenterWindow 640,200
  36. End Sub
  37. Sub CenterWindow(x,y)
  38.     window.resizeTo x, y
  39.     iLeft = window.screen.availWidth/2 - x/2
  40.     itop = window.screen.availHeight/2 - y/2
  41.     window.moveTo ileft, itop
  42. End Sub
  43.  
  44. Sub OnClickButtonCancel()
  45.     Window.Close
  46. End Sub
  47.  
  48. Function qq(strIn)
  49.     qq = Chr(34) & strIn & Chr(34)
  50. End Function
  51.  
  52. Sub CreateFolder(strPath)
  53. set fso = CreateObject("Scripting.FileSystemObject")
  54.         If strPath <> "" Then
  55.                 If Not fso.FolderExists(fso.GetParentFolderName(strPath)) then Call CreateFolder(fso.GetParentFolderName(strPath))
  56.                 fso.CreateFolder(strPath)
  57.         End If
  58. End Sub
  59.  
  60. Function xPortCode(modName,sizeFont,InputFile,OutPutHTML)
  61.     Dim i
  62.     Dim strBuff
  63.     Dim strSrcCode ' * pour le texte code source
  64.    Dim reg
  65.     Dim KeyWords, KeyWordsList
  66.     Dim Types, TypesList
  67.     set fso = CreateObject("Scripting.FileSystemObject")
  68.     Set reg = New regexp
  69.     InputFile = file1.value
  70.     If InputFile = "" Then
  71.         MsgBox "ATTENTION ! "& vbcr & "Vous n'avez pas encore choisi un fichier !",48,"ATTENTION ! "& vbcr & "Vous n'avez pas encore choisi un fichier !"
  72.         Exit Function
  73.     End if
  74.     MyFolder = fso.GetAbsolutePathName(".")
  75.     TabFolder = Split(MyFolder,"\")
  76.     DossierCourant = TabFolder(UBound(TabFolder))
  77.     DossierCourantHTML = DossierCourant&"_HTML"
  78.     If Not fso.FolderExists(DossierCourantHTML) Then
  79.         CreateFolder(DossierCourantHTML)
  80.     End if  
  81.     Tab = Split(InputFile,"\")
  82.     OutPutHTML = Tab(UBound(Tab))
  83.     PathOutPutHTML = fso.GetAbsolutePathName(".") & "\" & DossierCourantHTML & "\" & OutPutHTML & ".html"
  84.     Set f = fso.OpenTextFile(PathOutPutHTML,2,True)
  85.     Set f2 = Fso.OpenTextFile(InputFile,1)
  86.     strBuff = f2.ReadAll '-- Lit la totalité du fichier
  87.    ' * preparation de code brut
  88.    strSrcCode = Replace(strBuff, "&", "&amp;", 1, -1, 0)
  89.     strSrcCode = Replace(strSrcCode, "<", "&lt;", 1, -1, 0)
  90.     strSrcCode = Replace(strSrcCode, ">", "&gt;", 1, -1, 0)
  91.     strSrcCode = Replace(strSrcCode, Chr(13), "<br>", 1, -1, 0)
  92.     strSrcCode = Replace(strSrcCode, Chr(9), "&nbsp;&nbsp;&nbsp;&nbsp;", 1, -1, 0)
  93.     strSrcCode = Replace(strSrcCode, "  ", " &nbsp;", 1, -1, 0)
  94.     strSrcCode = Replace(strSrcCode, "&nbsp; ", "&nbsp;&nbsp;", 1, -1, 0)
  95.     For i = 0 To 31
  96.         strSrcCode = Replace(strSrcCode, Chr(i), "", 1, -1, 0)
  97.     Next
  98.    NbLigneTotal = f2.Line
  99. 'MsgBox "Le Nombre Total de lignes est " & NbLigneTotal,64,"Nombre Total de lignes"
  100.   Set Ws = CreateObject("Wscript.Shell")
  101. 'écriture des en-têtes HTML et style
  102.   f.Writeline "<HTML>"
  103.     f.Writeline "<HEAD><TITLE>Exportation du Code Source Avec Coloration Syntaxique en HTML 2013 © " & modName & "</TITLE>"
  104.     f.Writeline "<meta http-equiv=""Content-Type"" content=""text/html; charset=ISO-8859-1"" />"
  105.     f.Writeline "<style type='Text/css'>"
  106.     f.Writeline "<!--"
  107.     f.Writeline "BODY {background:lightcyan;"
  108.     f.Writeline "margin-top:10; margin-left:10; margin-right:0;"
  109.     f.Writeline "font-family: Lucida Console, Tahoma, Verdana, Arial, Helvetica, sans-serif;"
  110.     f.Writeline "font-size: " & sizeFont & "px;" ' la variable argument sizeFont passe dans la définition du style
  111.   f.Writeline "}"
  112.     f.Writeline ".commentaire {"
  113.     f.Writeline "color: #669933;"
  114.     f.Writeline "}"
  115.     f.Writeline ".chaine {"
  116.     f.Writeline "color: Red"
  117.     f.Writeline "}"
  118.     f.Writeline ".key {"
  119.     f.Writeline "color: #0033BB;"
  120.     f.Writeline "}"
  121.     f.Writeline ".type {"
  122.     f.Writeline "font-weight: bold;"
  123.     f.Writeline "color: #3366CC;"
  124.     f.Writeline "}"
  125.     f.WriteLine ".genmed { font: 12px bold; cursor: pointer; }" ' * amendement de style
  126.    f.Writeline ".code { font-family: 'Courier New', Comic sans MS, sans-serif; font-size: 11px; color: #006600; background-color: #FAFAFA; border: #D1D7DC 1px solid; }"
  127.     f.Writeline "-->"
  128.     f.Writeline "</style>"
  129.     f.WriteLine "<script>"
  130.     f.WriteLine "function selectCode(a)"
  131.     f.WriteLine "{"
  132.     f.WriteLine "// Get ID of code block"
  133.     f.WriteLine "var e = a.parentNode.parentNode.getElementsByTagName('PRE')[1];"
  134.     f.WriteLine "// Not IE"
  135.     f.WriteLine "if (window.getSelection)"
  136.     f.WriteLine "{"
  137.     f.WriteLine "    var s = window.getSelection();"
  138.     f.WriteLine "    // Safari"
  139.     f.WriteLine " if (s.setBaseAndExtent)"
  140.     f.WriteLine "    {"
  141.     f.WriteLine "        s.setBaseAndExtent(e, 0, e, e.innerText.length - 1);"
  142.     f.WriteLine "    }"
  143.     f.WriteLine "    // Firefox and Opera"
  144.     f.WriteLine "    else"
  145.     f.WriteLine "    {"
  146.     f.WriteLine "        // workaround for bug # 42885"
  147.     f.WriteLine "        if (window.opera && e.innerHTML.substring(e.innerHTML.length - 4) == '<BR>')"
  148.     f.WriteLine "        {"
  149.     f.WriteLine "            e.innerHTML = e.innerHTML + ' ';"
  150.     f.WriteLine "        }"
  151.     f.WriteLine "    var r = document.createRange();"
  152.     f.WriteLine "        r.selectNodeContents(e);"
  153.     f.WriteLine "        s.removeAllRanges();"
  154.     f.WriteLine "        s.addRange(r);"
  155.     f.WriteLine "    }"
  156.     f.WriteLine " }"
  157.     f.WriteLine " // Some older browsers"
  158.     f.WriteLine " else if (document.getSelection)"
  159.     f.WriteLine " {"
  160.     f.WriteLine "    var s = document.getSelection();"
  161.     f.WriteLine "     var r = document.createRange();"
  162.     f.WriteLine "    r.selectNodeContents(e);"
  163.     f.WriteLine "    s.removeAllRanges();"
  164.     f.WriteLine "    s.addRange(r);"
  165.     f.WriteLine " }"
  166.     f.WriteLine "// IE"
  167.     f.WriteLine " else if (document.selection)"
  168.     f.WriteLine    "{"
  169.     f.WriteLine "    var r = document.body.createTextRange();"
  170.     f.WriteLine "     r.moveToElementText(e);"
  171.     f.WriteLine "    r.select();"
  172.     f.WriteLine     "}"
  173.     f.WriteLine " }"
  174.     f.Writeline "<HACKOOscript>"
  175.     f.WriteLine "<script>" ' * l'ajout d'une fonction de contrôle
  176.    f.WriteLine "function expandTrigger() {"
  177.     f.WriteLine "    if(baliseSourceCliquez.firstChild.nodeValue == ""+ montrer le code source"") {"
  178.     f.WriteLine "        baliseSourceCliquez.firstChild.nodeValue = ""– cacher le code source"";"
  179.     f.WriteLine "        baliseSourceCode.style.display = ""block"";"
  180.     f.WriteLine "    } else {"
  181.     f.WriteLine "        baliseSourceCliquez.firstChild.nodeValue = ""+ montrer le code source"";"
  182.     f.WriteLine "        baliseSourceCode.style.display = ""none"";"
  183.     f.WriteLine "    }"
  184.     f.WriteLine "}"
  185.     f.WriteLine "<HACKOOscript>"
  186.     f.Writeline "</HEAD>"
  187.     f.WriteLine "<button onclick='selectCode(this); return false;'>Sélectionner tout</button>"
  188.     f.Writeline "<BODY>"
  189.     f.Writeline "<table width=""90%"" cellspacing=""1"" cellpadding=""3"" border=""0"" align=""center"">"
  190.     f.Writeline "<tr><td class=""code"">" ' * amendement de structure
  191.    f.Writeline "<span class=""genmed""><b><span onclick=""expandTrigger();"" id=""baliseSourceCliquez"" style=""cursor: pointer;"">+ montrer le code source</span></b></span>"
  192.     f.Writeline "<div id=""baliseSourceCode"" style=""display: none;""><div style=""height: 1px; background-color: #D1D7DC; margin: 5px;""></div><p>" & strSrcCode & "</p></div>"
  193.     f.Writeline "</td></tr>"
  194.     f.Writeline "</table>"
  195.     f.Writeline "<table width=""90%"" cellspacing=""1"" cellpadding=""3"" border=""0"" align=""center"">"
  196.     f.Write "<tr><td><pre><div style=""border: 1px dashed red; padding-left: 5px; padding-right: 5px; margin-right: 5px; text-align: center; font-family: monospace"">"
  197.     For X = 0 To NbLigneTotal - 1
  198.         Y = X + 1
  199.         f.Write "<font color=""Red"">" & Y & "</font>.<br />"
  200.     Next
  201.     f.Write "</div></pre></td><td valign=""top""><pre style=""margin: 0"">"
  202.  
  203. ' empêcher les ouvertures de tag HTML
  204.   strBuff = Replace(strBuff, "<", "&lt;")
  205. ' les retours chariot
  206.   reg.Pattern = "(\n)(<br />)"
  207.     reg.Global = True
  208.     reg.IgnoreCase = True
  209.     strBuff = reg.Replace(strBuff, "$1<br />")
  210.  
  211. ' 1- les mots-clés
  212.   KeyWordsList = "AddressOf©Alias©And©As©ByRef©ByVal©Call©Case©Close©CBool©CByte©CCur©" & _
  213.     "CDate©CDec©CDbl©CInt©CLng©CSng©CStr©CVar©Const©Compare©Database©Declare©Debug©Default©" & _
  214.     "Dim©Do©Each©Else©ElseIf©End©Enum©Erase©Error©Explicit©Event©Exit©False©For©" & _
  215.     "Friend©Function©Get©GoTo©Handles©If©Implements©Imports©In©Inherits©" & _
  216.     "Interface©Is©Let©Lib©Like©Loop©Me©Mod©New©Next©Not©Nothing©" & _
  217.     "On©Open©Option©Optional©Or©ParamArray©Preserve©Print©Private©Property©Protected©" & _
  218.     "Public©RaiseEvent©ReadOnly©Redim©REM©Resume©Return©Select©Set©Shared©Static©" & _
  219.     "Step©Stop©Sub©Then© To ©True©Type©TypeOf ©Until©UBound©When©Wend©While©With©WithEvents©WriteOnly©Xor"
  220.  
  221.     KeyWords = Split(KeyWordsList,"©")
  222.     For i = 0 To UBound(KeyWords)
  223.         reg.Pattern = "(\W|^)(" & KeyWords(i) & ")(\W|$)"
  224.         reg.Multiline = False
  225.         reg.Global = True
  226.         reg.IgnoreCase = True
  227.         strBuff = reg.Replace(strBuff, "$1<span class=key>$2</span>$3")
  228.     Next
  229.  
  230. ' 2- les commentaires
  231. '  les REM
  232.   reg.Pattern = "(\s)(rem .*)"
  233.     reg.Multiline = False
  234.     reg.Global = True
  235.     reg.IgnoreCase = True
  236.     strBuff = reg.Replace(strBuff, "$1<span class=commentaire>$2</span>")    
  237.  
  238. '  les apostrophes (')
  239.   reg.Pattern = "(\n)(([^\x22\n]*\x22[^\x22\n]*\x22)*)([^\x22\n']*)('.*)."
  240.     reg.Multiline = False
  241.     reg.Global = True
  242.     reg.IgnoreCase = True
  243.     strBuff = reg.Replace(strBuff, "$1$2$4<span class=commentaire>$5</span>")
  244.  
  245. ' 3- les types
  246.   TypesList = "Boolean©Byte©Date©Double©Integer©Long©Object©Short©Single©String©Unicode©Variant"
  247.     Types = Split(TypesList, "©")
  248.     For i = 0 To UBound(Types)
  249.         reg.Pattern = "(\W|^)(" & Types(i) & ")(\W|$)"
  250.         reg.Multiline = False
  251.         reg.Global = True
  252.         reg.IgnoreCase = True
  253.         strBuff = reg.Replace(strBuff, "$1<span class=type>$2</span>$3")
  254.     Next
  255.  
  256. ' 4- les chaines
  257.   reg.Pattern = "(\x22[^\x22\n]*\x22)"
  258.     reg.Multiline = False
  259.     reg.Global = True
  260.     reg.IgnoreCase = True
  261.     strBuff = reg.Replace(strBuff, "<span class=chaine>$1</span>")
  262.  
  263. ' Highlight dans un Highlight
  264.   reg.Pattern = "(<span class=\w{6,11}>)(.*)(<span class=\w{3,11}>)(.*)(</span>)(.*</span>)"
  265.     reg.Multiline = False
  266.     reg.Global = True
  267.     reg.IgnoreCase = True
  268.     Do While reg.Test(strBuff)
  269.         strBuff = reg.Replace(strBuff, "$1$2$4$6")
  270.     Loop
  271.  
  272. ' les espaces
  273.   strBuff = Replace(strBuff, "  ", "  ")
  274. ' écriture de la chaîne dans le fichier
  275.   f.Writeline strBuff
  276.     f.Writeline "</td></tr></table></pre>"
  277.     f.Writeline "</BODY>"
  278.     IMG = "<center><img src='"&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(110)&Chr(115)&Chr(109)&_
  279.     Chr(48)&Chr(53)&Chr(46)&Chr(99)&Chr(97)&Chr(115)&Chr(105)&_
  280.     Chr(109)&Chr(97)&Chr(103)&Chr(101)&Chr(115)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&Chr(47)&Chr(105)&_
  281.     Chr(109)&Chr(103)&Chr(47)&Chr(50)&Chr(48)&Chr(49)&Chr(49)&Chr(47)&Chr(48)&Chr(55)&Chr(47)&Chr(50)&_
  282.     Chr(51)&Chr(47)&Chr(47)&Chr(49)&Chr(49)&Chr(48)&Chr(55)&_
  283.     Chr(50)&Chr(51)&Chr(48)&Chr(55)&Chr(52)&Chr(49)&_
  284.     Chr(52)&Chr(48)&Chr(49)&Chr(51)&Chr(49)&Chr(49)&Chr(48)&_
  285.     Chr(52)&Chr(56)&Chr(53)&Chr(48)&Chr(54)&Chr(52)&Chr(49)&_
  286.     Chr(57)&Chr(46)&Chr(103)&Chr(105)&Chr(102)&"' alt='"&Chr(104)&Chr(97)&_
  287.     Chr(99)&Chr(107)&Chr(111)&Chr(111)&Chr(102)&Chr(114)&Chr(64)&_
  288.     Chr(121)&Chr(97)&Chr(104)&Chr(111)&Chr(111)&Chr(46)&Chr(102)&Chr(114)&"'</img>"
  289.     f.WriteLine IMG
  290.     f.Writeline "</HTML>"            
  291.     f.Close
  292.     PatchScript
  293. 'libération des objets mémoire
  294.   Set reg = Nothing  
  295. 'Ouverture du fichier HTML
  296.   ws.Popup "La Conversion du ficher en HTML est terminé avec sucées !"&vbCr&_
  297.     "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
  298.     'MsgBox PathOutPutHTML
  299.   ws.Run qq(PathOutPutHTML),1,True
  300.     Set Ws = Nothing
  301. End Function
  302.  
  303. Sub PatchScript
  304.     set fso = CreateObject("Scripting.FileSystemObject")
  305.     InputFile = file1.value
  306.     Tab = Split(InputFile,"\")
  307.     OutPutHTML = Tab(UBound(Tab))
  308.     MyFolder = fso.GetAbsolutePathName(".")
  309.     TabFolder = Split(MyFolder,"\")
  310.     DossierCourant = TabFolder(UBound(TabFolder))
  311.     DossierCourantHTML = DossierCourant&"_HTML"
  312.     PathOutPutHTML = fso.GetAbsolutePathName(".") & "\" & DossierCourantHTML & "\" & OutPutHTML & ".html"
  313.     Set freadHTML = fso.OpenTextFile(PathOutPutHTML,1)
  314.     strBuffHTML = freadHTML.ReadAll
  315.     strBuffHTML = Replace(strBuffHTML,"HACKOO","/")
  316.     Set fwriteHTML = fso.OpenTextFile(PathOutPutHTML,2)
  317.     fwriteHTML.Writeline strBuffHTML
  318.     fwriteHTML.Close
  319. End Sub
  320. </script>
  321. </head><!-- * tag <script> doit être dans tag <head> -->
  322. <body><!-- * -->
  323. <center>
  324. <B>Fichier à convertir en HTML </B><input type="file" name="file1" style="font-weight: bold; id="file1" /><br><br>
  325. <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">
  326. <input type="button" style="width: 100px" style="font-weight: bold; name="Cancel" id="Cancel" value="Sortir" onclick="OnClickButtonCancel"><br><br>
  327. <script language="Javascript" src="http://map.geoup.com/geoup?template=flag"></script>
  328. </body>
  329. </html>
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!