API tools faq
paste
View difference between Paste ID: ekw47FFZ and JBqi040r
SHOW: | | - or go back to the newest paste.
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-
</head>
30+
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-
End Sub 

41+
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-
50+
51
 

52
Sub CreateFolder(strPath)

53-
	If strPath <> "" Then 

53+
54-
		If Not fso.FolderExists(fso.GetParentFolderName(strPath)) then Call CreateFolder(fso.GetParentFolderName(strPath))

54+
        If strPath <> "" Then

55-
		fso.CreateFolder(strPath)

55+
                If Not fso.FolderExists(fso.GetParentFolderName(strPath)) then Call CreateFolder(fso.GetParentFolderName(strPath))

56-
	End If

56+
                fso.CreateFolder(strPath)

57-
End Sub 

57+
        End If

58
End Sub

59
 

60-
    Dim i 

60+
61
    Dim i

62-
    Dim reg 

62+
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-
	CreateFolder(DossierCourantHTML)

77+
78
    If Not fso.FolderExists(DossierCourantHTML) Then

79
        CreateFolder(DossierCourantHTML)

80
    End if  

81
    Tab = Split(InputFile,"\")

82-
    Set f = fso.OpenTextFile(PathOutPutHTML,2,True) 

82+
83
    PathOutPutHTML = fso.GetAbsolutePathName(".") & "\" & DossierCourantHTML & "\" & OutPutHTML & ".html"

84
    Set f = fso.OpenTextFile(PathOutPutHTML,2,True)

85-
    NbLigneTotal = f2.Line 

85+
86
    strBuff = f2.ReadAll '-- Lit la totalité du fichier

87-
    Set Ws = CreateObject("Wscript.Shell")

87+
    ' * preparation de code brut 

88
    strSrcCode = Replace(strBuff, "&", "&amp;", 1, -1, 0)

89-
    f.Writeline "<HTML>"

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 ".genmed { font-size : 11px; }"

112+
113-
    f.Writeline ".code { font-family: Comic sans MS, 'Courier New', sans-serif; font-size: 11px; color: #006600;"

113+
114-
	f.WriteLine "background-color: #FAFAFA; border: #D1D7DC; border-style: solid;"

114+
115-
	f.WriteLine	"border-left-width: 1px; border-top-width: 1px; border-right-width: 1px; border-bottom-width: 1px }"

115+
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.Write "<table width=""90%"" cellspacing=""1"" cellpadding=""3"" border=""0"" align=""center"">"&_	

167+
168-
    "<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"">"

168+
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-
    strBuff = Replace(strBuff, "<", "&lt;")

176+
    f.WriteLine "function expandTrigger() {"

177
    f.WriteLine "    if(baliseSourceCliquez.firstChild.nodeValue == ""+ montrer le code source"") {"

178-
    reg.Pattern = "(\n)(<br />)"

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-
    KeyWordsList = "AddressOf©Alias©And©As©ByRef©ByVal©Call©Case©Close©CBool©CByte©CCur©" & _

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 

200+
201
    f.Write "</div></pre></td><td valign=""top""><pre style=""margin: 0"">"

202
 

203
' empêcher les ouvertures de tag HTML

204-
    reg.Pattern = "(\s)(rem .*)"

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-
    reg.Pattern = "(\n)(([^\x22\n]*\x22[^\x22\n]*\x22)*)([^\x22\n']*)('.*)."

211+
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-
    TypesList = "Boolean©Byte©Date©Double©Integer©Long©Object©Short©Single©String©Unicode©Variant"

218+
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-
    Next 

226+
227
        strBuff = reg.Replace(strBuff, "$1<span class=key>$2</span>$3")

228
    Next

229-
    reg.Pattern = "(\x22[^\x22\n]*\x22)"

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-
    reg.Pattern = "(<span class=\w{6,11}>)(.*)(<span class=\w{3,11}>)(.*)(</span>)(.*</span>)"

236+
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-
    strBuff = Replace(strBuff, "  ", "  ")

245+
246
   TypesList = "Boolean©Byte©Date©Double©Integer©Long©Object©Short©Single©String©Unicode©Variant"

247-
    f.Writeline strBuff

247+
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-
    f.Writeline "</HTML>"             

262+
263-
    f.Close 

263+
264
   reg.Pattern = "(<span class=\w{6,11}>)(.*)(<span class=\w{3,11}>)(.*)(</span>)(.*</span>)"

265
    reg.Multiline = False

266-
    Set reg = Nothing  

266+
267
    reg.IgnoreCase = True

268-
    ws.Popup "La Conversion du ficher en HTML est terminé avec sucées !"&vbCr&_

268+
269
        strBuff = reg.Replace(strBuff, "$1$2$4$6")

270
    Loop

271-
    ws.Run qq(PathOutPutHTML),1,True

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>
        

    


            


                                


        

            



                
    

        Public Pastes
    

    
            

    

                    

        

    





    


    
    
    
    
    
    
    
    




    


    



                

            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!