Soyez le premier à donner votre avis sur cette source.
Vue 4 407 fois - Téléchargée 416 fois
<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>
23 nov. 2013 à 07:30
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
27 févr. 2013 à 12:50
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.
27 févr. 2013 à 02:02
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
25 févr. 2013 à 15:22
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. ?
25 févr. 2013 à 13:04
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.