Extraction des scripts contenus dans une page web

Version imprimable

:salut:
Je suis entrain de faire ce programme pour l'extraction des scripts qui sont contenus dans une page web.
Mon Problème réside dans quelques URL(s) qui me retournent un message d'erreur dont je ne connais pas jusqu'à présent la cause; d’où l'existence de ce post :mouarf:
Exemple l'url : developpez.net ou bien developpez.com ne marche pas et retourne un message d'erreur:

Citation:

Ligne 30
Caract.:6
Erreur : Argument ou appel procédure incorrect

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Call Extraire_Script
 
Sub Extraire_Script
Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches
Titre = "EXTRACTION DES SCRIPTS CONTENUS DANS UNE PAGE WEB © Hackoo © 2012"
URL = InputBox("Saisissez une URL pour extraire ces scripts :",Titre,"http://www.voila.fr")
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
NomFichierLog = temp & "\Script.txt"
NomFichierLogHTML = temp & "\Script.html"
ie.Navigate (URL) 
ie.Visible=false
DO WHILE ie.busy
wscript.sleep 100
LOOP
Data = ie.document.documentElement.innerhtml
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
Set OutPut = objFSO.OpenTextFile(NomFichierLog,2,True)
OutPut.WriteLine "<center><br>Les Scripts qui sont contenus dans cette page : <B><font size=4 color=Yellow>"& URL &"</font></B></center>" 
Set objRegex = new RegExp
objRegex.Pattern = "<script[^>]*>[\w|\t|\r|\W]*</script>"
objRegex.Global = True
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches   
    'MsgBox Match.Value ,64,Titre
     OutPut.WriteLine "<span class=""code""><pre>"&string(123,"*") & vbcr &  Match.Value & vbcr & string(123,"*")&"</pre></span>"
Next
ie.Quit 
Set ie = Nothing
OutPut.close
Convert2HTML "Script.txt","Script.html"
 
If MsgBox ("Vouliez-vous consulter le fichier Résultat : "& Vbcr & qq(NomFichierLog) &" en mode TEXTE ou bien en mode HTML ?" & Vbcr & Vbcr &_
"Pour Afficher en mode HTML Cliquer sur OUI "&Vbcr &_
"Pour Afficher en mode TEXTE Cliquer sur NON ",VbYesNo+VbQuestion ,Titre ) = VbYes Then
Call Explorer(NomFichierLogHTML)
else
Call OpenLog(NomFichierLog)
end if
End Sub
 
Sub OpenLog(File)
Dim ws
Set ws = CreateObject("wscript.shell")
ws.run "Notepad " & File,1,False
Set ws = Nothing
End Sub
 
Function Explorer(File)
set ws = CreateObject("wscript.shell")
ws.Run "iexplore "  & File,1,False
end Function
 
Function Convert2HTML(FileTxt,FileHTML)
Dim oFSO,ws,temp,OutPutHTML,StrHTML
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
Set ReadTxt = oFSO.OpenTextFile(temp & "\" & FileTxt,1)
Set OutPutHTML = oFSO.OpenTextFile(temp & "\" & FileHTML,2,True)
 strHTML="<html><body text=white bgcolor=#1234568><style type='text/css'>.code {font-family:courier;font-size:10pt;color:orange}"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"
StrHTML = StrHTML & "<center><B><font size=4 color=Yellow>EXTRACTION DES SCRIPTS CONTENUS DANS UNE PAGE WEB © Hackoo © 2012 </font></B><hr>"&_
"<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><hr></center>"
StrHTML = StrHTML & ReadTxt.ReadALL
StrHTML = Replace(StrHTML,VbCrlf,"<br>")
StrHTML = Replace(StrHTML,"<","&lt;")
StrHTML = Replace(StrHTML,"&lt;html>","<html>")
StrHTML = Replace(StrHTML,"&lt;/html>","</html>")
StrHTML = Replace(StrHTML,"&lt;body","<body")
StrHTML = Replace(StrHTML,"&lt;/body>","</body>")
StrHTML = Replace(StrHTML,"&lt;span","<span")
StrHTML = Replace(StrHTML,"&lt;/span>","</span>")
StrHTML = Replace(StrHTML,"&lt;/html>","</html>")
StrHTML = Replace(StrHTML,"&lt;pre>","<pre>")
StrHTML = Replace(StrHTML,"&lt;/pre>","</pre>")
StrHTML = Replace(StrHTML,"&lt;style","<style")
StrHTML = Replace(StrHTML,"&lt;/style>","</style>")
StrHTML = Replace(StrHTML,"&lt;font","<font")
StrHTML = Replace(StrHTML,"&lt;/font>","</font>")
StrHTML = Replace(StrHTML,"&lt;B>","<B>")
StrHTML = Replace(StrHTML,"&lt;/B>","</B>")
StrHTML = Replace(StrHTML,"&lt;hr>","<hr>")
StrHTML = Replace(StrHTML,"&lt;br>","<br>")
StrHTML = Replace(StrHTML,"&lt;center>","<center>")
StrHTML = Replace(StrHTML,"&lt;/center>","</center>")
StrHTML = Replace(StrHTML,"&lt;img","<img")
StrHTML = Replace(StrHTML,"&lt;/img>","</img>")
OutPutHTML.writeLine StrHTML
End Function
 
Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function

:merci: de votre aide :ccool:

02/07/2012, 07h11
ProgElecT

Salut
Pour ma part ton code ne provoque pas d'erreur pour les adresses URL indiquées.
02/07/2012, 12h46
hackoofr

Citation:

Envoyé par ProgElecT

Salut
Pour ma part ton code ne provoque pas d'erreur pour les adresses URL indiquées.

:salut: ProgElecT et :merci: pour le test :ccool:
Bon , pour ma part ça reste toujours inexplicable cette erreur avec ces deux URL indiquées ci-dessus, car toujours je reçois la même erreur (sous windows xp SP2) :calim2:
Est-ce-qu'il n'y a pas une méthode pour faire une gestion d’erreurs dans mon cas :koi:
:merci:

Bonjour,

Peut-être que cela ferait l'affaire pour la gestion d'erreur ?

Code:

1
2
3
4
5
6
7
8
9
10
For Each Match in Matches   
	On Error Resume Next
	strMatchValue = Match.Value
	If Err.Number <> 0 Then 
		strMatchValue = "Erreur (N° " & Err.Number & "; Description : " & Err.Description & ")"
		Err.Clear
	End If
	On Error GoTo 0
	OutPut.WriteLine "<span class=""code""><pre>"&string(123,"*") & vbcr &  strMatchValue & vbcr & string(123,"*")&"</pre></span>"
Next

Bonne continuation

:merci: pitchalov pour votre intervention :ccool:
mais j'ai toujours le même message d'erreur :koi: , pourtant il y a d'autres URL qui fonctionnent à merveille :mouarf: et voila le code modifié :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Call Extraire_Script
 
Sub Extraire_Script
Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches
Titre = "EXTRACTION DES SCRIPTS CONTENUS DANS UNE PAGE WEB © Hackoo © 2012"
URL = InputBox("Saisissez une URL pour extraire ces scripts :",Titre,"http://www.voila.fr")
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
NomFichierLog = temp & "\Script.txt"
NomFichierLogHTML = temp & "\Script.html"
ie.Navigate (URL) 
ie.Visible=false
DO WHILE ie.busy
wscript.sleep 1000
LOOP
Data = ie.document.documentElement.innerhtml
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
Set OutPut = objFSO.OpenTextFile(NomFichierLog,2,True)
OutPut.WriteLine "<center><br>Les Scripts qui sont contenus dans cette page : <B><font size=4 color=Yellow>"& URL &"</font></B></center>" 
Set objRegex = new RegExp
objRegex.Pattern = "<script[^>]*>[\w|\t|\r|\W]*</script>"
objRegex.Global = True
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches   
	On Error Resume Next
	strMatchValue = Match.Value
	If Err.Number <> 0 Then 
		strMatchValue = "Erreur (N° " & Err.Number & "; Description : " & Err.Description & ")"
		Err.Clear
	End If
	On Error GoTo 0
	OutPut.WriteLine "<span class=""code""><pre>"&string(123,"*") & vbcr &  strMatchValue & vbcr & string(123,"*")&"</pre></span>"
Next
ie.Quit 
Set ie = Nothing
OutPut.close
Convert2HTML "Script.txt","Script.html"
 
If MsgBox ("Vouliez-vous consulter le fichier Résultat : "& Vbcr & qq(NomFichierLog) &" en mode TEXTE ou bien en mode HTML ?" & Vbcr & Vbcr &_
"Pour Afficher en mode HTML Cliquer sur OUI "&Vbcr &_
"Pour Afficher en mode TEXTE Cliquer sur NON ",VbYesNo+VbQuestion ,Titre ) = VbYes Then
Call Explorer(NomFichierLogHTML)
else
Call OpenLog(NomFichierLog)
end if
End Sub
 
Sub OpenLog(File)
Dim ws
Set ws = CreateObject("wscript.shell")
ws.run "Notepad " & File,1,False
Set ws = Nothing
End Sub
 
Function Explorer(File)
set ws = CreateObject("wscript.shell")
ws.Run "iexplore "  & File,1,False
end Function
 
Function Convert2HTML(FileTxt,FileHTML)
Dim oFSO,ws,temp,OutPutHTML,StrHTML
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
Set ReadTxt = oFSO.OpenTextFile(temp & "\" & FileTxt,1)
Set OutPutHTML = oFSO.OpenTextFile(temp & "\" & FileHTML,2,True)
 strHTML="<html><body text=white bgcolor=#1234568><style type='text/css'>.code {font-family:courier;font-size:10pt;color:orange}"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"
StrHTML = StrHTML & "<center><B><font size=4 color=Yellow>EXTRACTION DES SCRIPTS CONTENUS DANS UNE PAGE WEB © Hackoo © 2012 </font></B><hr>"&_
"<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><hr></center>"
StrHTML = StrHTML & ReadTxt.ReadALL
StrHTML = Replace(StrHTML,VbCrlf,"<br>")
StrHTML = Replace(StrHTML,"<","&lt;")
StrHTML = Replace(StrHTML,"&lt;html>","<html>")
StrHTML = Replace(StrHTML,"&lt;/html>","</html>")
StrHTML = Replace(StrHTML,"&lt;body","<body")
StrHTML = Replace(StrHTML,"&lt;/body>","</body>")
StrHTML = Replace(StrHTML,"&lt;span","<span")
StrHTML = Replace(StrHTML,"&lt;/span>","</span>")
StrHTML = Replace(StrHTML,"&lt;/html>","</html>")
StrHTML = Replace(StrHTML,"&lt;pre>","<pre>")
StrHTML = Replace(StrHTML,"&lt;/pre>","</pre>")
StrHTML = Replace(StrHTML,"&lt;style","<style")
StrHTML = Replace(StrHTML,"&lt;/style>","</style>")
StrHTML = Replace(StrHTML,"&lt;font","<font")
StrHTML = Replace(StrHTML,"&lt;/font>","</font>")
StrHTML = Replace(StrHTML,"&lt;B>","<B>")
StrHTML = Replace(StrHTML,"&lt;/B>","</B>")
StrHTML = Replace(StrHTML,"&lt;hr>","<hr>")
StrHTML = Replace(StrHTML,"&lt;br>","<br>")
StrHTML = Replace(StrHTML,"&lt;center>","<center>")
StrHTML = Replace(StrHTML,"&lt;/center>","</center>")
StrHTML = Replace(StrHTML,"&lt;img","<img")
StrHTML = Replace(StrHTML,"&lt;/img>","</img>")
OutPutHTML.writeLine StrHTML
End Function
 
Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function

03/07/2012, 14h40
pitchalov

Bonjour,

Peux-tu nous indiquer ton message d'erreur?
Il se produit toujours sur la ligne 30?
03/07/2012, 14h54
hackoofr

Citation:

Envoyé par pitchalov

Bonjour,
Peux-tu nous indiquer ton message d'erreur?
Il se produit toujours sur la ligne 30?

Non,Maintenant avec le nouveau code sur la ligne N°36 :mouarf:

OutPut.WriteLine "<span class=""code""><pre>"&string(123,"*") & vbcr & strMatchValue & vbcr & string(123,"*")&"</pre></span>"

Citation:

Ligne 36
Caract.:2
Erreur : Argument ou appel procédure incorrect

Bonjour,

Une piste à laquelle je pense, mais sans être sûr :
Peut-être que le WriteLine n'accepte pas de trop longues chaines de caractère.
dans ce cas, en fonction de la taille de strMatchValue cela ne fonctionnerait pas.

Le test peut être fait en séparant les différentes parties de ton String, pour voir si c'est ici que ça bloque.
Code:

1 2 3 4 5 Msgbox Len("<span class=""code""><pre>"& string(123,"*") & vbcr & strMatchValue & vbcr & string(123,"*")&"</pre></span>") 'taille de la chaine complète OutPut.WriteLine "<span class=""code""><pre>"&string(123,"*") OutPut.WriteLine strMatchValue OutPut.WriteLine string(123,"*")&"</pre></span>" 'Ecriture de la chaine en plusieurs fois dans le fichier Output
Ou, autre possibilité, toujours si le problème vient de là, réduire la taille de tes "****" :
Code:

1 2 Msgbox Len("<span class=""code""><pre>"& string(12,"*") & vbcr & strMatchValue & vbcr & string(12,"*")&"</pre></span>") 'taille de la chaine complète OutPut.WriteLine "<span class=""code""><pre>"& string(12,"*") & vbcr & strMatchValue & vbcr & string(12,"*")&"</pre></span>"
Du coup, vu que l'erreur ne se faisait pas sur le "Match.value", la gestion d'erreur mise en place hier ne sert à rien.
Elle peut à la limite être décalée sur la ligne WriteLine, si tu ne t'en sors pas :aie:...

Bonne continuation

04/07/2012, 20h23
hackoofr

:salut: pitchalov
Oui je crois que vous avez raison a propos de la taille de strMatchValue
même quand j'ai essayé vos propositions, j'ai toujours le même message d'erreur :cry:
mais pour le moment j'ai pas encore trouvé une astuce pour contourner cette limitation :roll: :calim2:

Bonjour hackoofr,

Pour réduire la taille des chaines insérées dans ton fichier par le "WriteLine", voici une solution :
Code:

1 2 3 4 5 6 7 8 For Each Match in Matches strMatchValue = Match.Value OutPut.WriteLine "<span class=""code""><pre>"&string(123,"*") For Each strTmp In Split(strMatchValue, vbCrLF) OutPut.WriteLine strTmp Next OutPut.WriteLine string(123,"*")&"</pre></span>" Next
Est-ce que ça fonctionne mieux, ou as-tu toujours ces messages d'erreur?

Bonne continuation

05/07/2012, 10h40
hackoofr

Citation:

Envoyé par pitchalov

Est-ce que ça fonctionne mieux, ou as-tu toujours ces messages d'erreur?

:salut:
Oui, j'ai pensé moi aussi a "splitter" strMatchValue mais sans succès même avec votre propostion j'ai toujours ce message d'erreur :cry:

Bonjour,

J'ai peur de ne plus avoir d'idées pour ne plus avoir l'erreur.
Pour info, elle ne se produit pas sur mon XP SP3.

Reste la gestion d'erreur, mais le fichier ne contiendra pas toutes les informations :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 For Each Match in Matches strMatchValue = Match.Value OutPut.WriteLine "<span class=""code""><pre>"&string(123,"*") For Each strTmp In Split(strMatchValue, vbCrLF) On Error Resume Next OutPut.WriteLine strTmp If Err.Number <> 0 Then MsgBox "Impossible d'écrire la ligne <" & strTmp & ">" & vbCrLf & _ "Erreur (N° " & Err.Number & "; Description : " & Err.Description & ")" Err.Clear End If On Error Goto 0 Next OutPut.WriteLine string(123,"*")&"</pre></span>" Next
Informe nous si tu trouves un vrai contournement à ton problème.

Bonne continuation.

:salut: pitchalov et :merci: pour la gestion d'erreur elle est vraiment super :ccool: . Donc Problème :resolu: :lahola:
Voici donc le code final que je vais le poster dans la section Téléchargement ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
Call Extraire_Script
 
Sub Extraire_Script
Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches
Titre = "EXTRACTION DES SCRIPTS CONTENUS DANS UNE PAGE WEB © Hackoo © 2012"
URL = InputBox("Saisissez une URL pour extraire ces scripts :",Titre,"http://www.developpez.net")
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
NomFichierLog = temp & "\Script.txt"
NomFichierLogHTML = temp & "\Script.html"
ie.Navigate (URL) 
ie.Visible=false
DO WHILE ie.busy
wscript.sleep 1000
LOOP
Data = ie.document.documentElement.innerhtml
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
Set OutPut = objFSO.OpenTextFile(NomFichierLog,2,True)
OutPut.WriteLine "<center><br>Les Scripts qui sont contenus dans cette page : <B><font size=4 color=Yellow>"& URL &"</font></B></center>" 
Set objRegex = new RegExp
objRegex.Pattern = "<script[^>]*>[\w|\t|\r|\W]*</script>"
objRegex.Global = True
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches   
    strMatchValue = Match.Value
	OutPut.WriteLine "<span class=""code""><pre>"&string(123,"*")
	For Each strTmp In Split(strMatchValue, vbCrLF)
		On Error Resume Next
		OutPut.WriteLine strTmp
		If Err.Number <> 0 Then 
			MsgBox "Impossible d'écrire la ligne <" & strTmp & ">" & vbCrLf & _
				"Erreur (N° " & Err.Number & "; Description : " & Err.Description & ")",64,Titre
			Err.Clear
		End If
		On Error Goto 0
	Next
	OutPut.WriteLine string(123,"*")&"</pre></span>"
Next
ie.Quit 
Set ie = Nothing
OutPut.close
Convert2HTML "Script.txt","Script.html"
 
If MsgBox ("Vouliez-vous consulter le fichier Résultat : "& Vbcr & qq(NomFichierLog) &" en mode TEXTE ou bien en mode HTML ?" & Vbcr & Vbcr &_
"Pour Afficher en mode HTML Cliquer sur OUI "&Vbcr &_
"Pour Afficher en mode TEXTE Cliquer sur NON ",VbYesNo+VbQuestion ,Titre ) = VbYes Then
Call Explorer(NomFichierLogHTML)
else
Call OpenLog(NomFichierLog)
end if
End Sub
 
Sub OpenLog(File)
Dim ws
Set ws = CreateObject("wscript.shell")
ws.run "Notepad " & File,1,False
Set ws = Nothing
End Sub
 
Function Explorer(File)
set ws = CreateObject("wscript.shell")
ws.Run "iexplore "  & File,1,False
end Function
 
Function Convert2HTML(FileTxt,FileHTML)
Dim oFSO,ws,temp,OutPutHTML,StrHTML
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
Set ReadTxt = oFSO.OpenTextFile(temp & "\" & FileTxt,1)
Set OutPutHTML = oFSO.OpenTextFile(temp & "\" & FileHTML,2,True)
 strHTML="<html><body text=white bgcolor=#1234568><style type='text/css'>.code {font-family:courier;font-size:10pt;color:orange}"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"
StrHTML = StrHTML & "<center><B><font size=4 color=Yellow>EXTRACTION DES SCRIPTS CONTENUS DANS UNE PAGE WEB © Hackoo © 2012 </font></B><hr>"&_
"<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><hr></center>"
StrHTML = StrHTML & ReadTxt.ReadALL
StrHTML = Replace(StrHTML,VbCrlf,"<br>")
StrHTML = Replace(StrHTML,"<","&lt;")
StrHTML = Replace(StrHTML,"&lt;html>","<html>")
StrHTML = Replace(StrHTML,"&lt;/html>","</html>")
StrHTML = Replace(StrHTML,"&lt;body","<body")
StrHTML = Replace(StrHTML,"&lt;/body>","</body>")
StrHTML = Replace(StrHTML,"&lt;span","<span")
StrHTML = Replace(StrHTML,"&lt;/span>","</span>")
StrHTML = Replace(StrHTML,"&lt;/html>","</html>")
StrHTML = Replace(StrHTML,"&lt;pre>","<pre>")
StrHTML = Replace(StrHTML,"&lt;/pre>","</pre>")
StrHTML = Replace(StrHTML,"&lt;style","<style")
StrHTML = Replace(StrHTML,"&lt;/style>","</style>")
StrHTML = Replace(StrHTML,"&lt;font","<font")
StrHTML = Replace(StrHTML,"&lt;/font>","</font>")
StrHTML = Replace(StrHTML,"&lt;B>","<B>")
StrHTML = Replace(StrHTML,"&lt;/B>","</B>")
StrHTML = Replace(StrHTML,"&lt;hr>","<hr>")
StrHTML = Replace(StrHTML,"&lt;br>","<br>")
StrHTML = Replace(StrHTML,"&lt;center>","<center>")
StrHTML = Replace(StrHTML,"&lt;/center>","</center>")
StrHTML = Replace(StrHTML,"&lt;img","<img")
StrHTML = Replace(StrHTML,"&lt;/img>","</img>")
OutPutHTML.writeLine StrHTML
End Function
 
Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function

:salut: pitchalov
Grâce à votre gestion d'erreur, j'ai trouvé ou se pose le problème exactement, car il me sort un MsgBox m'indiquant que cette fonction ne peut pas être sauvegardé dans mon fichier Ouput et la raison ce qu'il y a comme vous le voyer des caractères spéciaux (Unicode) non enregistrable dans mon Notepad, alors j'ai utilisé votre astuce qui se trouve ici dans cette Discussion : Comment transformer les caractères en Unicode et vice versa ?
:merci: encore une autre fois pour vos astuces. ;) :mouarf:
Donc le Code fonctionne parfaitement sans erreur et le script est enregistrable maintenant :mouarf: :ccool: :zoubi:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 <SCRIPT type=text/javascript>  </SCRIPT> <A href="mailto:xxxx@xxxx-xxxxxx.com">Contacter par email</A> </P></DIV><SCRIPT type=text/javascript>  </SCRIPT>