Télécharger images

**gegedu45** · 21/07/2017, 09h41

Bonjour

Comme je suis un vieux papy (+70) j'occupe mes jours a faire du développement en VBSCRIPT a usage personnel .mais la cela fait 2 mois que je bute sur un problème (pas vital ) mais qui m'agace j'ai beau parcourir les forums anglais francais rien
Dans un programme je télécharge une page internet en forme HTML tout se passe bien excepté que dans le résultat les petites images ne sont pas présentes dans le fichier

Page internet
Nom : gege1.png
Affichages : 649
Taille : 76,9 Ko

Nom : gege1.png
Affichages : 649
Taille : 76,9 Ko

Resultat

Nom : gege2.PNG
Affichages : 668
Taille : 59,0 Ko

Et le code source qui est un sous programme appelle par le programme principal avec 2 fonctions telechargement en HTML et en PDF
tout fonctionne correctement sauf ces sacrées images.

Si quelqu'un connait la solution (je pense a une option mais !!!)

Merci d'avance

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
''------------------------------------------------------------------------------------------------------------------
'   TELECHARGEMENT des AIRES de CCI en format HTML  ou PDF
'------------------------------------------------------------------------------------------------------------------
Option Explicit
Const ForReading = 1, ForWriting = 2 , ForAppending = 8
Dim SA			'Shell application
Dim WSH			'WScript.Shell
Dim FSO			'File system object
 
Dim FSO_DEBUG,FILE_DEBUG 
 
Const maxTime = 30    ' in seconds
Const sleepTime = 250 ' in milliseconds
Dim  PDFCreator, DefaultPrinter, ReadyState,  c,  Scriptname
Dim objArgs
	Set SA 		= CreateObject("Shell.Application")
	Set FSO 	= CreateObject("Scripting.FileSystemObject")
	Set WSH 	= WScript.CreateObject("WScript.Shell")
	'***********************************************************************************************
	' -------->  lecture des parametres
	'  Verification des données tout doit etre correct nom fichier repertoire source repertoire cible
	'***********************************************************************************************
	Scriptname = fso.GetbaseName(Wscript.ScriptFullname)	'nom du programme
	Set objArgs = Wscript.Arguments
	if not WScript.Arguments.Count = 3 then
			Msgbox "Aucun parametre il manque un ou des parametres : adresse URL et/ou path fichier en sortie ",vbCritical,(Scriptname & " 025")
			Wscript.quit 999
	End if
	FILE_DEBUG	=	objArgs(2)
	Set FSO_DEBUG = FSO.OpenTextFile(FILE_DEBUG,ForAppending,true)
	'***********************************************************************************************
	'Controle si repertoire existe si non creation du repertoire
	'***********************************************************************************************
	If	not FSO.FolderExists(FSO.getparentfoldername(objArgs(1) ) ) 		then
			Call	Create_folder ( FSO.getparentfoldername(objArgs(1) ) )
	End If
	'***********************************************************************************************
	' Suppression du fichier cible si existe
	'***********************************************************************************************
	If FSO.Fileexists(objArgs(1)) Then
			FSO.DeleteFile (objArgs(1))
	End If
	Select  case   Ucase( FSO.GetExtensionname(objArgs(1))  )
			case 		"HTML" 	 
					Call	Traitement_HTML
					'msgbox "FIN de TRAITEMENT HTML" 
					FSO_DEBUG.close
					wscript.quit 0
			Case	 	"PDF" 	 
					Call	Traitement_PDF
					'msgbox "FIN de TRAITEMENT PDF"
					FSO_DEBUG.close
					wscript.quit 0
			Case	Else
					FSO_DEBUG.writeline		Scriptname &  " 55  -> Erreur type de fichier a telecharger  = " & objargs(1)
					FSO_DEBUG.close
					wscript.quit 9
	End  Select
'------------------------------------------------------------------------------------
'	traitement fichier HTML
'--------------------------------------------------------------------------------------
Sub	Traitement_HTML	
	On Error Resume Next
	'***********************************************************************************************
	' Recuperation fichier format HTML
	'***********************************************************************************************
	dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
	dim bStrm: Set bStrm = createobject("Adodb.Stream")
	xHttp.Open "GET", objargs(0), False
	'msgbox 70 & Err.number
	xHttp.Send		
	'msgbox 72 & Err.number
	If Err.Number <> 0 then 
				'--> pb connection internet on delete le fichier
				FSO_DEBUG.writeline		Scriptname &  " 68  -> Erreur = " & Err.Number & "download fichier HTML = " & objargs(0)
				'WScript.Echo  "59 Unexpected Error #: " & Err.Number 
				FSO_DEBUG.close
				FSO.Deletefile	objargs(0) , true
				wscript.quit 9	
	End if
	with bStrm
		.type = 1 '//binary
		.open
		'msgbox 82 & Err.number
		.write xHttp.responseBody
		.savetofile (objArgs(1)), 2 '//overwrite
		'.savetofile "D:\PROGRAMMES_BATCH_VBS\PROGRAMMES\Aires_gege\Resultat\Aires_00.html", 2 '//overwrite
	end with
	On Error GoTo 0
End sub
'------------------------------------------------------------------------------------
'	traitement fichier PDF
'--------------------------------------------------------------------------------------
Sub	Traitement_PDF
	On Error Resume Next
	'msgbox "jepasse 01"  & objargs(0) & vbcrlf & objargs(1)
	If CDbl(Replace(WScript.Version,".",",")) < 5.1 then
		msgbox "You need the ""Windows Scripting Host version 5.1"" or greater!", vbCritical + vbSystemModal, AppTitle
		Wscript.Quit 9
	End if
	'***********************************************************************************************
	' Controle si fichier Internet disponible
	'***********************************************************************************************
	dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
	xHttp.Open "GET", objargs(0), False
	If Err.Number <> 0 then 
				'--> pb connection internet on delete le fichier
				FSO_DEBUG.writeline		Scriptname &  " 108  -> Erreur = " & Err.Number & "download fichier PDF = " & objargs(0)
				'WScript.Echo  "59 Unexpected Error #: " & Err.Number 
				FSO_DEBUG.close
				FSO.Deletefile	objargs(1) , true
				wscript.quit 9	
	End if
	xHttp.Send		
	'msgbox 72 & Err.number
	If Err.Number <> 0 then 
				'--> pb connection internet on delete le fichier
				FSO_DEBUG.writeline		Scriptname &  " 117  -> Erreur = " & Err.Number & "download fichier PDF = " & objargs(0)
				'WScript.Echo  "59 Unexpected Error #: " & Err.Number 
				FSO_DEBUG.close
				FSO.Deletefile	objargs(1) , true
				wscript.quit 9	
	End if
	'msgbox "jepasse 02"
	Set PDFCreator = Wscript.CreateObject("PDFCreator.clsPDFCreator", "PDFCreator_")
	PDFCreator.cStart "/NoProcessingAtStartup"
	With PDFCreator
		.cOption("UseAutosave") = 1
		.cOption("UseAutosaveDirectory") = 1
		.cOption("AutosaveFormat") = 0                              ' 0 = PDF
		DefaultPrinter = .cDefaultprinter
		.cDefaultprinter = "PDFCreator"
		.cClearcache
	End With
	'msgbox "jepasse 03"
	On Error Resume Next
	With PDFCreator
		'msgbox "jepasse 04"
		On Error Resume Next
		ReadyState = 0
		'.cOption("AutosaveDirectory") = fso.GetParentFolderName(Wscript.ScriptFullname)
		.cOption("AutosaveDirectory")	=  FSO.getparentfoldername(objArgs(1))
		'msgbox "coptiondirectory" &  Err.Number
		.cOption("AutosaveFilename") 	=  FSO.getfilename(objArgs(1))
		'msgbox "coptionsave" &  Err.Number
		'.cPrintURL "http://www.campingcar-infos.com/Francais/listingairea.php?AS=on&ASN=on&AA=on&AC=on&ACF=on&ACS=on&APCC=on&AP=on&APN=on&pays=FRANCE&dept=48&textdept=48" 
		.cprintURL objArgs(0)
		'msgbox "URL" &   Err.Number
		If Err.Number <> 0 then 				'--> pb connection internet on delete le fichier
				FSO_DEBUG.writeline		Scriptname &  " 124  -> Erreur = " & Err.Number & "Probleme download fichier PDF = " & objargs(0)
				'WScript.Echo  "59 Unexpected Error #: " & Err.Number 
				FSO_DEBUG.close
				FSO.Deletefile	objargs(1) , true
				wscript.quit 9	
		End if
		WScript.Sleep 5000
		.cCombineAll
		.cPrinterStop = false
		c = 0
		Do While (ReadyState = 0) and (c < (maxTime * 1000 / sleepTime))
			c = c + 1
			Wscript.Sleep sleepTime
		Loop
		'msgbox "jepasse 05" & Zfile
		If ReadyState = 0 then
			MsgBox "Converting: " & objArgs(1) & vbcrlf & vbcrlf & _
			"An error is occured: Time is up!", vbExclamation + vbSystemModal, scriptname
			wscript.quit 999
		End If
	End With
	'msgbox "jepasse 06"
	With PDFCreator
		'msgbox "jepasse 07" & DefaultPrinter
		.cDefaultprinter = DefaultPrinter
		.cClearcache
		WScript.Sleep 200
		.cClose
	End With	
	'msgbox 153 &  Err.Number
	If Err.Number <> 0 then 
				'--> pb connection internet on delete le fichier
				FSO_DEBUG.writeline		Scriptname &  " 157  -> Erreur = " & Err.Number & "Probleme download fichier PDF = " & objargs(0)
				'WScript.Echo  "59 Unexpected Error #: " & Err.Number 
				FSO_DEBUG.close
				FSO.Deletefile	objargs(1) , true
				wscript.quit 9	
	End if
 
	'msgbox "jepasse 08"
	On Error GoTo 0
End sub
'--- PDFCreator events ---
Public Sub PDFCreator_eReady()
	ReadyState = 1
End Sub
Public Sub PDFCreator_eError()
		 MsgBox "An error is occured!" & vbcrlf & vbcrlf & _
		  "Error [" & PDFCreator.cErrorDetail("Number") & "]: " & PDFcreator.cErrorDetail("Description"), vbCritical + vbSystemModal, Scriptname
		Wscript.Quit 999
End Sub
'-----------------------------------------------------------------------------------------------
'------> 		'creation nouveau repertoire 
'-----------------------------------------------------------------------------------------------
Sub Create_folder(Chemin )
	If Not fso.FolderExists(chemin) Then
		call	Create_folder(fso.GetParentFolderName(chemin))
		fso.CreateFolder(chemin)
	End If
End Sub

**ericlm128** · 22/07/2017, 12h44

Le code source de la page est bien copier via votre code, il n'y a donc pas de problème.
Les image sont des ressources externes, que les navigateurs télécharge en plus pendant la lecture de la page html.

Soit l’emplacement des images est définit en chemin complet :
Exemple : <img src="https://www.gravatar.com/avatar/de6b68b6b8114e0a1367841dea0781f7.jpg">

Soit l’emplacement des images est définit en chemin relatif :
Exemple : <img src="../avatar/de6b68b6b8114e0a1367841dea0781f7.jpg">

A l'ouverture de votre page html sauvegarder en local :
En tant que chemin complet, votre navigateur ira la télécharger sur internet (https://www.gravatar.com/avatar/de6b...1dea0781f7.jpg).
En tant que chemin relatif, votre navigateur ne la trouvera pas. L'image ici est relatif à l'emplacement de la page html, qui est maintenant sur votre pc.

Voici ce que fait IE (c'est schématique) lorsqu'on fait un sauvegarder-sous à partir d'une page web :
- télécharge la page Web (code source)
- vérifie les ressources externes et les télécharges en local dans un sous-dossier
- modifier les chemins, dans le fichier html sauvegardé, pour qu'il pointe vers les fichier en local

Certains outils semble capable de réaliser ces opérations comme Wget : https://eternallybored.org/misc/wget/

Pour information voici comment sauvegarder une page html en PowerShell (correspond à votre procédure Traitement_HTML)

Code powershell :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
$client = New-Object System.Net.WebClient
$client.DownloadFile("http://www.campingcar-infos.com/Francais/listingairea.php?AS=on&ASN=on&AA=on&AC=on&ACF=on&ACS=on&APCC=on&AP=on&APN=on&pays=FRANCE&dept=48&textdept=48", "C:\Users\Moi\Desktop\page.html")

Juste ceci pour dire que PowerShell est très puissant et intéressant.

**cerede2000** · 23/08/2017, 23h29

Comme indiqué par @ericlm128 il faut téléchargé les images en plus de la page elle même.

L'idée est donc de parser la page récupérée afin d'identifier les images à télécharger.
Idem d'ailleurs pour les feuilles de style externes par exemple.

Peut être regarder du côté pilotage Internet Explorer pour enregistrer la page en MHT directement...

Sinon en effet en Powershell c'est nettement plus simple

**patricktoulon** · 18/11/2017, 09h08

Bonjour

Soit l’emplacement des images est définit en chemin relatif :
Exemple : <img src="../avatar/de6b68b6b8114e0a1367841dea0781f7.jpg">

quand le src est relatif tel que présenté en général tu trouve le host dans le header de la page web

quand le chemin commence par "//xxxx/xxxx/xxxx/yyyy.JPG" il suffit d'ajouter "https:" devant

puisque que tu télécharge ton image avec une requete et adob.Stream

tu en fait une premiere (requete)sur la page web pour récupérer le host dans le (head) comme ca pas besoins de IE

Télécharger images

VBScript

Discussions similaires

Partager

Partager