Arjuna Aircraft Ident.: F-MBSD | Pendant que je postais mon problème, je pense avoir trouvé la source de l'erreur MAIS ! Je ne sais pas comment le corriger
Un peu de code vaut mieu qu'un long discourt, donc trois fonctions et un type utilisateur :
Code :
- Private Type dwl
- fileType As String
- fileContent As String
- End Type
- Private Function downLoadFile(url As String, lfileType As String) As dwl
- Dim objRegExp As RegExp
- Dim objMatch As Match
- Dim colMatches As MatchCollection
- Dim tmpStr As String
- Dim tmpFile As dwl
- ' [...]
-
- If objRegExp.Test(url) Then
-
- ' Création d'un fichier temporaire qui sert au download
- iTmpFile = FreeFile
- Open App.Path & "\" & Replace(cacheFile, "#", iTmpFile) For Binary Access Write As #iTmpFile
- ' [...]
-
- ' Objet WinSock
- With wscHttp
- .Close
- .LocalPort = 0
- .Connect m_strRemoteHost, m_strRemotePort
- Do While .State < 8
- DoEvents
- Loop
- If .State = 9 Then
- MsgBox ("Error: Disconnected from server." )
- On Error Resume Next
- Close #iTmpFile
- Kill Replace(cacheFile, "#", iTmpFile)
- On Error GoTo 0
- Else
- Close #iTmpFile
- Open App.Path & "\" & Replace(cacheFile, "#", iTmpFile) For Binary Access Read As #iTmpFile
- ' Recherche de deux sauts de ligne dans le fichier, afin de sauter l'en-tête HTTP
- Dim c1 As Byte
- Dim c2 As Byte
- Dim c3 As Byte
- Dim c4 As Byte
- Dim countChar As Integer
-
- Do While Not (c1 = 13 And c2 = 10 And c3 = 13 And c4 = 10)
- c1 = c2
- c2 = c3
- c3 = c4
- Get #iTmpFile, , c4
- countChar = countChar + 1
- Loop
-
- ' Chargement du fichier temporaire dans une chaîne de caractère
- tmpStr = String(FileLen(App.Path & "\" & Replace(cacheFile, "#", iTmpFile)) - (countChar), " " )
- Get #iTmpFile, , tmpStr
- On Error Resume Next
- Close #iTmpFile
- Kill Replace(cacheFile, "#", iTmpFile)
- On Error GoTo 0
- End If
- End With
- Else
- ' [...]
- End If
-
- ' Initialisation de la valeur de retour
- tmpFile.fileType = lfileType
- tmpFile.fileContent = tmpStr
- downLoadFile = tmpFile
-
- Exit Function
- ERR_HANDLER_DWL:
- downLoadFile = tmpFile
- End Function
- Sub saveFile(content As String, fileName As String, filePath As String)
- Dim intFile As Integer
- If LCase(Left(fileName, 7)) <> "mailto:" Then
- intFile = FreeFile
- Open filePath & fileName For Binary Access Write As #intFile
- Put #intFile, , content
- Close #intFile
- End If
- End Sub
- ' Téléchargement d'un fichier situé derrière un lien de type <a href="(url)">...</a>"
- Function getLinks(ByRef document As String)
- Dim objRegExp As RegExp
- Dim objMatch As Match
- Dim colMatches As MatchCollection
- Dim myDoc As String
- Dim myDoc2 As String
- Dim linkFileName As String
- Dim j As Integer
- Dim dwlLnk As dwl
-
- ProgressBar2.Value = 3
- Label6.Caption = "Documents"
-
- myDoc = document
- myDoc2 = document
- Set objRegExp = New RegExp
- objRegExp.Pattern = "(<a[^>]*?href=['|""])([^'|^""]+?)(['|""].*?> )"
- objRegExp.IgnoreCase = True
- objRegExp.Global = True
- If (objRegExp.Test(myDoc2)) Then
- Set colMatches = objRegExp.Execute(myDoc2)
- j = 0
- ProgressBar3.Max = colMatches.Count
- For Each objMatch In colMatches
- linkFileName = Right(objRegExp.Replace(objMatch.Value, "$2" ), Len(objRegExp.Replace(objMatch.Value, "$2" )) - InStrRev(Replace(objRegExp.Replace(objMatch.Value, "$2" ), "\", "/" ), "/" ))
- j = j + 1
- ProgressBar3.Value = j
- Label7.Caption = linkFileName
- frmMain.Refresh
- ' C'est là que ça merde !
- myDoc = Replace(myDoc, objMatch.Value, objRegExp.Replace(objMatch.Value, "$1" & currentDoc & "\" & linkFileName & "$3" ), 1, 1)
- dwlLnk = downLoadFile(objRegExp.Replace(objMatch.Value, "$2" ), "link" )
- saveFile dwlLnk.fileContent, linkFileName, App.Path & docPath & "\" & currentDoc & "\"
- Next
- End If
- getLinks = myDoc
- End Function
|
Ce qu'il se passe, c'est que lors du téléchargement des documents d'une page, les fichiers téléchargés font la taille maximale parmis les derniers fichiers téléchargés au sein du document.
En gros, la valeur de "dwlLnk" dans la boucle de la fonction "getLinks" n'est pas correctement écrasée. Et là, je ne vois pas du tout comment forcer VB à la réinitialiser
Elle est du type utilisateur mis au début du code.
Le problème peut venir aussi de "saveFile" qui enregistre alors la chaîne dans le fichier destination, mais j'en doute.
Le problème, c'est que je ne suis sûr de rien : depuis l'IDE VB, ça marche très bien, je n'ai aucun problème ! Par contre, ça se met à déconner dès que je compile (même sur la même machine)
A vrai dire, je pense même que c'est plutôt la fonction "downloadFile" qui déconne, car j'ai le problème aussi à un autre endroit, du programme (par contre, ce second endroit ne pète pas sur tous les PC, sur le mien ça marche, et sur le PC d'un collègue ça déconne ) |