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

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