[VB] Connection HTTP pour récupérer un fichier binaire

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [VB] Connection HTTP pour récupérer un fichier binaire

Arjuna

Aircraft Ident.: F-MBSD

Bonjour,

Je suis en train de faire un programme VB, qui doit se connecter à un site web, et aspirer une page, ainsi que tous les fichiers qui sont en lien.

J'utilise le composant WinSock afin de me connecter en HTTP au serveur.

Je récupère la page sans problème. Les images GIF et JPG passent aussi sans problème.
Mais les fichiers PDF sont systématiquement corrompus. Ils font pourtant la bonne taille, mais Acrobat Reader ne peux pas les lire.
Si je les télécharge manuellement, ils sont OK.

J'en déduis que ma façon de récupérer les données HTTP n'est pas bonne, et que ça altère les données.

J'utilise actuellement ces fonctions : (wscHttp est le nom de mon contrôle WinSock)

Private Sub wscHttp_Close()
Dim strHttpResponseHeader As String

If Not m_bResponseReceived Then
strHttpResponseHeader = Left$(m_strHttpResponse, _
InStr(1, m_strHttpResponse, _
vbCrLf & vbCrLf) - 1)
m_strHttpResponse = Mid(m_strHttpResponse, _
InStr(1, m_strHttpResponse, _
vbCrLf & vbCrLf) + 4)
m_bResponseReceived = True
End If
End Sub

Private Sub wscHttp_Connect()
Dim strHttpRequest As String

strHttpRequest = "GET " & m_strFilePath & " HTTP/1.1" & vbCrLf
strHttpRequest = strHttpRequest & "Host: " & m_strRemoteHost & vbCrLf
strHttpRequest = strHttpRequest & "Connection: close" & vbCrLf
strHttpRequest = strHttpRequest & "Accept: */*" & vbCrLf
strHttpRequest = strHttpRequest & vbCrLf
wscHttp.SendData strHttpRequest
End Sub

Private Sub wscHttp_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next

Dim strData As String

wscHttp.GetData strData
m_strHttpResponse = m_strHttpResponse & strData
End Sub

Sub downLoadFile(url As String, lfileType As String)
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

url = Replace(url, " ", "%20" )
Set objRegExp = New RegExp
objRegExp.Pattern = "(\w+):\/\/([^/:]+)(:\d*)?([^# ]*)"
objRegExp.IgnoreCase = True
objRegExp.Global = True

If objRegExp.Test(url) Then

m_strProtocol = objRegExp.Replace(url, "$1" )
m_strRemoteHost = objRegExp.Replace(url, "$2" )
m_strRemotePort = objRegExp.Replace(url, "$3" )
m_strFilePath = objRegExp.Replace(url, "$4" )

If Len(m_strRemotePort) = 0 Then
m_strRemotePort = "80"
Else
m_strRemotePort = Right(m_strRemotePort, Len(m_strRemotePort) - 1)
End If

fileType = lfileType

m_strHttpResponse = ""
m_bResponseReceived = False

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." )
End If
End With
Else
' Cas spécial : Lien de type "file" ou "mailto"
[...]
End If

Exit Sub
ERR_HANDLER_DWL:
m_strHttpResponse = ""
End Sub

Sub saveFile(content As String, fileName As String, filePath As String)
If LCase(Left(fileName, 7)) <> "mailto:" Then
If content <> "m_bytes()" Then
intFile = FreeFile
Open filePath & fileName For Binary Access Write As #intFile
Put #intFile, , content
Close #intFile
Else
intFile = FreeFile
Open filePath & fileName For Binary Access Write As #intFile
Put #intFile, , m_bytes
Close #intFile
End If
End If
End Sub

Comment pourrais-je modifier ma sauce pour récupérer correctement des données binaires ? J'ai trouvé un tuto, mais j'avoue n'avoir rien compris
Deplus, pour les fichiers actuels et la page HTML, est-ce que ça va poser problème si je les télécharge en binaire et non en ASCII comme actuellement ? J'aimerais autant se faire se peu ne pas avoir 36 façons d'accéder aux fichiers.

Publicité

checkitout

excuse mais chuis intéressé par ton code qui récupère le page web, ya moyen que tu le mettes ici ?

Arjuna

Aircraft Ident.: F-MBSD

Si tu veux. Le voilà :

Code :

Private m_strRemoteHost As String 'the web server to connect to
Private m_strFilePath As String 'relative path to the file to retrieve
Private m_strHttpResponse As String 'the server response
Private m_bResponseReceived As Boolean
Private m_strRemotePort As String
Private fileType As String
Private currentDoc As String
Private m_bytes() As Byte
Private dom As DOMDocument
Private canRefresh As Boolean
Private language As String * 3
Const siteRoot = "http://gemseas-devl.euro.med.ge.com:8081/egx/"
Private Type t_lp
login As String * 30
pass As String * 30
language As String * 3
End Type
Private Sub Command1_Click()
Dim tabpro() As String
Dim i As Integer
Dim strURL As String
Dim errMsg As String
Dim errNb As Integer
Dim nbDocs As Integer
If codpro.Text = "" Then
fillCodpro
End If
errNb = 0
nbDocs = 0
If Len(Trim(codpro.Text)) = 0 Then
MsgBox ("Please type at least a product code." )
codpro.Text = ""
Exit Sub
End If
tabpro = Split(UCase(codpro.Text), "," )
ProgressBar1.Max = UBound(tabpro) + 1
ProgressBar2.Max = 3
On Error GoTo ERROR_HANDLER
If Not auth(errMsg) Then
errNb = errNb + 1
MsgBox errMsg
codpro.Text = ""
Exit Sub
End If
For i = LBound(tabpro) To UBound(tabpro)
currentDoc = Trim(tabpro(i))
ProgressBar1.Value = i
Label5.Caption = currentDoc
If Trim(currentDoc) <> "" Then
nbDocs = nbDocs + 1
downLoadFile siteRoot & "W_PRO_SPR_D_print.asp?CHP:CODPRO=" & currentDoc & "&LOG=" & Text1.Text & "&PASS=" & Text2.Text & "&CODLAN=" & language, "root"
If fileType = "root" Then
If m_strHttpResponse = "404" Then
MsgBox "Product " & currentDoc & " doesn't exist."
errNb = errNb + 1
Else
If Not FileExists(App.Path & "\documents\" & currentDoc) Then
MkDir App.Path & "\documents\" & currentDoc
End If
saveFile getLinks(getImages(getCSS(m_strHttpResponse))), currentDoc & ".doc", App.Path & "\documents\"
End If
End If
End If
Next
EXIT_LABEL:
If errNb = 0 Then
MsgBox "Documents downloaded successfully"
Else
MsgBox nbDocs - errNb & " documents downloaded and " & errNb & " aborted on error."
End If
codpro.Text = ""
Exit Sub
ERROR_HANDLER:
If Err.Number = 5 Then
strURL = strURL & "/"
Resume 0
Else
MsgBox "Error was occurred." & vbCrLf & _
"Error #: " & Err.Number & vbCrLf & _
"Description: " & Err.Description, vbExclamation
GoTo EXIT_LABEL
End If
End Sub
Sub downLoadFile(url As String, lfileType As String)
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
url = Replace(url, " ", "%20" )
Set objRegExp = New RegExp
objRegExp.Pattern = "(\w+):\/\/([^/:]+)(:\d*)?([^# ]*)"
objRegExp.IgnoreCase = True
objRegExp.Global = True
If objRegExp.Test(url) Then
m_strProtocol = objRegExp.Replace(url, "$1" )
m_strRemoteHost = objRegExp.Replace(url, "$2" )
m_strRemotePort = objRegExp.Replace(url, "$3" )
m_strFilePath = objRegExp.Replace(url, "$4" )
If Len(m_strRemotePort) = 0 Then
m_strRemotePort = "80"
Else
m_strRemotePort = Right(m_strRemotePort, Len(m_strRemotePort) - 1)
End If
fileType = lfileType
m_strHttpResponse = ""
m_bResponseReceived = False
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." )
End If
End With
Else
If LCase(Left(url, 7)) <> "mailto:" Then
On Error GoTo ERR_HANDLER_DWL
ReDim m_bytes(FileLen(url))
intFile = FreeFile
Open url For Binary Access Read As #intFile
Get #intFile, , m_bytes
Close #intFile
m_strHttpResponse = "m_bytes()"
Else
m_strHttpResponse = ""
End If
End If
Exit Sub
ERR_HANDLER_DWL:
m_strHttpResponse = ""
End Sub
Private Sub Form_Load()
Dim intFile As Integer
Dim lp As t_lp
canRefresh = True
Load frmSplash
frmSplash.Show
frmSplash.Refresh
On Error GoTo noFile
intFile = FreeFile
Open App.Path & "\documents\_" For Random As #intFile
Get #intFile, , lp
Close #intFile
Text1.Text = Trim(lp.login)
Text2.Text = Trim(lp.pass)
language = Trim(lp.language)
If language = "" Then
language = "ENG"
End If
On Error GoTo 0
Set dom = New DOMDocument
dom.async = False
If Not dom.Load(siteRoot & "bin/menus.xml.asp?CODLAN=" & language) Then
MsgBox "Can't contact server, or data error. Can't initialize filters."
End
End If
refreshFilters
Unload frmSplash
Exit Sub
noFile:
Close #intFile
Text1.Text = ""
Text2.Text = ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim intFile As Integer
Dim lp As t_lp
lp.login = Text1.Text
lp.pass = Text2.Text
lp.language = language
On Error GoTo noFile
intFile = FreeFile
Open App.Path & "\documents\_" For Random As #intFile
Put #intFile, , lp
Close #intFile
End
Exit Sub
noFile:
Close #intFile
MsgBox "Can't save your settings !"
End
End Sub
Private Sub ImageCombo1_Click()
refreshFilters
End Sub
Private Sub ImageCombo2_Click()
refreshFilters
End Sub
Private Sub ImageCombo3_Click()
refreshFilters
End Sub
Private Sub ImageCombo4_Click()
If ImageCombo4.SelectedItem.Key <> "" Then
canRefresh = True
Load frmSplash
frmSplash.Show
frmSplash.Refresh
Set dom = New DOMDocument
dom.async = False
If Not dom.Load(siteRoot & "bin/menus.xml.asp?CODLAN=" & ImageCombo4.SelectedItem.Key) Then
MsgBox "Can't contact server, or data error. Can't initialize filters."
End
End If
Unload frmSplash
End If
refreshFilters
End Sub
Private Sub ImageCombo5_Click()
refreshFilters
End Sub
Private Sub wscHttp_Close()
Dim strHttpResponseHeader As String
If Not m_bResponseReceived Then
strHttpResponseHeader = Left$(m_strHttpResponse, _
InStr(1, m_strHttpResponse, _
vbCrLf & vbCrLf) - 1)
m_strHttpResponse = Mid(m_strHttpResponse, _
InStr(1, m_strHttpResponse, _
vbCrLf & vbCrLf) + 4)
m_bResponseReceived = True
End If
End Sub
Private Sub wscHttp_Connect()
Dim strHttpRequest As String
strHttpRequest = "GET " & m_strFilePath & " HTTP/1.1" & vbCrLf
strHttpRequest = strHttpRequest & "Host: " & m_strRemoteHost & vbCrLf
strHttpRequest = strHttpRequest & "Connection: close" & vbCrLf
strHttpRequest = strHttpRequest & "Accept: */*" & vbCrLf
strHttpRequest = strHttpRequest & vbCrLf
wscHttp.SendData strHttpRequest
End Sub
Private Sub wscHttp_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim strData As String
wscHttp.GetData strData
m_strHttpResponse = m_strHttpResponse & strData
End Sub
Sub saveFile(content As String, fileName As String, filePath As String)
If LCase(Left(fileName, 7)) <> "mailto:" Then
If content <> "m_bytes()" Then
intFile = FreeFile
Open filePath & fileName For Binary Access Write As #intFile
Put #intFile, , content
Close #intFile
Else
intFile = FreeFile
Open filePath & fileName For Binary Access Write As #intFile
Put #intFile, , m_bytes
Close #intFile
End If
End If
End Sub
Function getImages(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 imgFileName As String
Dim j As Integer
ProgressBar2.Value = 2
Label6.Caption = "Pictures"
myDoc = document
myDoc2 = document
Set objRegExp = New RegExp
objRegExp.Pattern = "(<img[^>]*?src=['|""])([^'|^""]+?)(['|""].*?> )"
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
imgFileName = 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 = imgFileName
frmMain.Refresh
myDoc = Replace(myDoc, objMatch.Value, objRegExp.Replace(objMatch.Value, "$1" & currentDoc & "\" & imgFileName & "$3" ), 1, 1)
downLoadFile objRegExp.Replace(objMatch.Value, "$2" ), "img"
saveFile m_strHttpResponse, imgFileName, App.Path & "\documents\" & currentDoc & "\"
Next
End If
getImages = myDoc
End Function
Function getCSS(ByVal document As String) As String
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim myDoc As String
Dim myDoc2 As String
Dim cssFileName As String
Dim j As Integer
ProgressBar2.Value = 1
Label6.Caption = "Layout"
myDoc = document
myDoc2 = document
Set objRegExp = New RegExp
objRegExp.Pattern = "(<link[^>]*?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
cssFileName = 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 = cssFileName
frmMain.Refresh
myDoc = Replace(myDoc, objMatch.Value, objRegExp.Replace(objMatch.Value, "$1" & currentDoc & "\" & cssFileName & "$3" ), 1, 1)
downLoadFile objRegExp.Replace(objMatch.Value, "$2" ), "css"
saveFile m_strHttpResponse, cssFileName, App.Path & "\documents\" & currentDoc & "\"
Next
End If
getCSS = myDoc
End Function
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
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
myDoc = Replace(myDoc, objMatch.Value, objRegExp.Replace(objMatch.Value, "$1" & currentDoc & "\" & linkFileName & "$3" ), 1, 1)
downLoadFile objRegExp.Replace(objMatch.Value, "$2" ), "link"
saveFile m_strHttpResponse, linkFileName, App.Path & "\documents\" & currentDoc & "\"
Next
End If
getLinks = myDoc
End Function
Function auth(ByRef errMsg As String) As Boolean
downLoadFile siteRoot & "verifLogin.asp?log=" & Text1.Text & "&pass=" & Text2.Text, ""
errMsg = m_strHttpResponse
If errMsg = "OK" Then
auth = True
Else
auth = False
End If
End Function
Public Function FileExists(ByVal strFileName As String) As Boolean
Dim dtm As Date
On Error GoTo ErrHandler
dtm = FileSystem.FileDateTime(strFileName)
FileExists = True
Exit Function
ErrHandler:
FileExists = False
End Function
Sub refreshFilters()
Dim fam As String
Dim sfa As String
Dim ssf As String
Dim bt As String
If canRefresh Then
canRefresh = False
If ImageCombo1.SelLength <> 0 Then
fam = ImageCombo1.SelectedItem.Key
End If
If ImageCombo2.SelLength <> 0 Then
sfa = ImageCombo2.SelectedItem.Key
End If
If ImageCombo3.SelLength <> 0 Then
ssf = ImageCombo3.SelectedItem.Key
End If
If ImageCombo4.SelLength <> 0 Then
language = ImageCombo4.SelectedItem.Key
End If
If ImageCombo5.SelLength <> 0 Then
bt = ImageCombo5.SelectedItem.Key
End If
ImageCombo1.ComboItems.Clear
ImageCombo2.ComboItems.Clear
ImageCombo3.ComboItems.Clear
ImageCombo4.ComboItems.Clear
ImageCombo5.ComboItems.Clear
' Families
fillFamily fam, sfa, ssf
fillBT bt
fillLanguage language
ImageCombo1.Refresh
ImageCombo2.Refresh
ImageCombo3.Refresh
ImageCombo4.Refresh
ImageCombo5.Refresh
canRefresh = True
End If
End Sub
Sub fillFamily(fam As String, sfa As String, ssf As String)
Dim myItem As ComboItem
Dim el
Dim curItem As Integer
curItem = 1
Set myItem = ImageCombo1.ComboItems.Add(, "", "All" )
myItem.Selected = True
For Each el In dom.selectSingleNode("interface/families" ).childNodes
curItem = curItem + 1
If el.tagName = "fam" Then
Set myItem = ImageCombo1.ComboItems.Add(, el.Attributes(0).Value, el.Attributes(1).Value)
If myItem.Key = fam Then
myItem.Selected = True
End If
End If
Next
fillSubFamily fam, sfa, ssf
End Sub
Sub fillSubFamily(fam As String, sfa As String, ssf As String)
Dim myItem As ComboItem
Dim el
Dim el2
Dim curItem As Integer
curItem = 1
Set myItem = ImageCombo2.ComboItems.Add(, "", "All" )
myItem.Selected = True
If fam <> "" Then
For Each el In dom.selectSingleNode("interface/families" ).childNodes
If el.tagName = "fam" Then
If el.Attributes(0).Value = fam Then
For Each el2 In el.childNodes
curItem = curItem + 1
If el2.tagName = "sfa" Then
Set myItem = ImageCombo2.ComboItems.Add(, el2.Attributes(0).Value, el2.Attributes(1).Value)
If myItem.Key = sfa Then
myItem.Selected = True
End If
End If
Next
End If
End If
Next
End If
fillSubSubFamily fam, sfa, ssf
End Sub
Sub fillSubSubFamily(fam As String, sfa As String, ssf As String)
Dim myItem As ComboItem
Dim el
Dim el2
Dim el3
Dim curItem As Integer
curItem = 1
Set myItem = ImageCombo3.ComboItems.Add(, "", "All" )
myItem.Selected = True
If fam <> "" And sfa <> "" Then
For Each el In dom.selectSingleNode("interface/families" ).childNodes
If el.tagName = "fam" Then
If el.Attributes(0).Value = fam Then
For Each el2 In el.childNodes
If el2.tagName = "sfa" Then
If el2.Attributes(0).Value = sfa Then
For Each el3 In el2.childNodes
curItem = curItem + 1
If el3.tagName = "ssf" Then
Set myItem = ImageCombo3.ComboItems.Add(, el3.Attributes(0).Value, el3.Attributes(1).Value)
If myItem.Key = ssf Then
myItem.Selected = True
End If
End If
Next
End If
End If
Next
End If
End If
Next
End If
End Sub
Sub fillLanguage(language As String)
Dim myItem As ComboItem
Dim el
Dim curItem As Integer
curItem = 1
For Each el In dom.selectSingleNode("interface/languages" ).childNodes
curItem = curItem + 1
If el.tagName = "lan" Then
Set myItem = ImageCombo4.ComboItems.Add(, el.Attributes(0).Value, el.Attributes(1).Value)
If myItem.Key = language Then
myItem.Selected = True
End If
End If
Next
End Sub
Sub fillBT(bt As String)
Dim myItem As ComboItem
Dim el
Dim curItem As Integer
curItem = 1
Set myItem = ImageCombo5.ComboItems.Add(, "", "All" )
myItem.Selected = True
For Each el In dom.selectSingleNode("interface/bts" ).childNodes
curItem = curItem + 1
If el.tagName = "bt" Then
Set myItem = ImageCombo5.ComboItems.Add(, el.Attributes(0).Value, el.Attributes(1).Value)
If myItem.Key = bt Then
myItem.Selected = True
End If
End If
Next
End Sub
Sub fillCodpro()
Dim inet As InternetExplorer
Set inet = New InternetExplorer
inet.Visible = False
inet.Navigate siteRoot & "bin/codpros.asp?FAM=" & ImageCombo1.SelectedItem.Key & "&SFA=" & ImageCombo2.SelectedItem.Key & "&SSF=" & ImageCombo3.SelectedItem.Key & "&BT=" & ImageCombo5.SelectedItem.Key
Do While Not inet.readyState = READYSTATE_COMPLETE
DoEvents
Loop
codpro.Text = inet.document.body.innerHTML
End Sub

PS: j'ai laissé les url et tout, m'en fout c'est des adresses internes

PS²: Par contre, c'est loin de faire ce que tu veux à mon avis, ce programme sert à télécharger des documents à partir d'une appli intranet, donc c'est pas du tout gééraliste, à mon avis tu ne pourras pas en faire grand chose

Message édité par Arjuna le 15-04-2004 à 11:03:56

checkitout

je verrais bien merci quand même

Arjuna

Aircraft Ident.: F-MBSD

Pour ceux que ça intéresse, c'est ce tuto que j'avais suivie.
http://www.vbip.com/winsock/index.asp

Seul problème, c'est que l'accès à des fichiers binaires vient après un tas de trucs dont je n'ai pas besoin, et le code est du coup trop complexe pour que j'y comprenne quoi que ce soit :sweat:

Par contre, ce tuto est vraiment très bien et couvre un peu tout les domaines (www, ftp, smtp, application distribuée, chat, etc.)

Arjuna

Aircraft Ident.: F-MBSD

Du nouveau.

J'ai comparé les deux fichiers (le bon et le mauvais)

C'est encore plus bizarre que ça...
=> Ils sont rigoureusement identiques SAUF que celui qui est foireux s'arrête d'un coup, à 301 886 octets.
La taille ne semble pas "ronde", donc j'en déduit que c'est pas un problème au niveau de la taille de la chaîne de caractère.

En regardant en Hexa, je pensais tomber sur un caractère à la con, style EOF, qui aurait pu foutre en l'air la représentation des données dans une chaîne de caractères, mais même pas !

En effet, j'ai à la fin du fichier foireux la suite :

2a 45 __ (ça s'arrête là)

Alors que dans le fichier original, j'ai :

2a 45 4a 3b 27

=> Ce ne sont même pas des caractères spéciaux, ça correspond à la chaîne " *EJ:' "

:sweat:

Là je sèche vraiment, je ne comprends pas ce qui fait que ça ne fonctionne pas :cry:

Message édité par Arjuna le 15-04-2004 à 14:11:39

Arjuna

Aircraft Ident.: F-MBSD

Merci pour votre aide :sweat:

Bon, j'ai résolu mon problème (mais alors là il va falloir m'expliquer comment ! :lol: )

En fait, j'ai juste rajouté : "vbString" en paramètre de getData :

wscHttp.GetData strData, vbString

Et maintenant le fichier se charge correctement :heink:

Arjuna

Aircraft Ident.: F-MBSD

Bon, maintenant j'ai un autre problème :heink:

Private dom As DOMDocument

Function machin()
Set dom = New DOMDocument
dom.async = False
If Not dom.Load(siteRoot & "bin/menus.xml.asp?CODLAN=" & language) Then
MsgBox "Can't contact server, or data error. Can't initialize filters."
End
End If
End Function

Premier passage dans la fonction, ça passe.
Second passage, systématiquement j'ai une erreur comme quoi la source est indisponible. L'erreur est instantanée.

J'ai essayé de trouver un .Close ou autre pour forcer le dom à bien se vider avant d'en charger une nouvelle couche, mais j'ai pas trouvé. J'ai donc tenté de faire un set dom = Nothing avant l'affectation du constructeur, mais toujours la même donne, même erreur.

De quoi ça peut venir :??:

J'utilise MSXML 3.0

Arjuna

Aircraft Ident.: F-MBSD

Vous êtes tous morts ou quoi ? :cry:

bouchrabouchra

j'ai à peu prés le même problème que le tien, je voudrai me connecter à un site et ensuite y envoyer une requête qui va me retourner les données dont j'ai besoin. Mais je n'ai pas accés à la base de données du site et le site est fait en ASP tandis que mon application est faite en VBA. je ne sais pas si tu as une idée de comment je pourrai le faire. merci

Publicité

Arjuna

Aircraft Ident.: F-MBSD

Alors, tout bête :

Ta page ASP doit retourner un flux HTML de ce type : (ou un XML à la limite)

Code :

<html>
<head>NE PAS VENIR ICI !</head>
<body>
<p>Si vous voyez ce texte, c'est que vous n'avez rien à faire sur cette page. Ouste ! On dégage ! <a href="/default.asp">Foutez-moi le camp de là avant que je m'énerve !</a></p>
<div style="display: none" id="data1">val1;val2;val3<br/>val4;val5;val6<br/></div>
<div style="display: none" id="data2">val1;val2;val3<br/>val4;val5;val6<br/></div>
</body>
</html>

(des DIV nommées avec ID, contenant un flux CSV, avec retour à la ligne sous forme de <br/> )

Ensuite, dans ta macro, tu lies "Internet Controls"

Puis ta macro :

Code :

Sub getData()
Dim ie As New InternetExplorer
Dim data1 As String
Dim data2 As String
Dim arrData() As String
Dim arrLineData() As String
Dim val1 As String
Dim val2 As String
Dim val3 As String
Dim i As Integer
ie.Visible = False
ie.Navigate "http://server/getdata.asp?param1=" & param1
Do While Not ie.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
data1 = ie.Document.getElementById("data1" ).innerHTML
data2 = ie.Document.getElementById("data1" ).innerHTML
ie.Quit
Set ie = Nothing
arrData = Split(data1, "<br/>" )
For i = LBound(arrData) To UBound(arrData)
arrLineData = Split(arrData(i), ";" )
val1 = arrLineData(0)
val2 = arrLineData(1)
val3 = arrLineData(2)
'Do something with va1, val2 and val3
Next
arrData = Split(data2, "<br/>" )
For i = LBound(arrData) To UBound(arrData)
arrLineData = Split(arrData(i), ";" )
val1 = arrLineData(0)
val2 = arrLineData(1)
val3 = arrLineData(2)
'Do something with va1, val2 and val3
Next
End Sub

A quelques bugs prêt (pas testé ) ça doit marcher

bouchrabouchra

peux-tu m'expliquer ce qui fait ce code stp!!!

---------------
bou

Arjuna

Aircraft Ident.: F-MBSD

Il ouvre IE dans une fenêtre invisible.
Il va ensuite sur la page ASP dont tu as besoin (n'oublie pas de passer les éventuels paramètres en QueryString).
Ensuite, il attend que la page aie fini de charger.

Et quand c'est fini, il recherche les deux blocs de données (dans mon exemple) puis les parcours ligne pas ligne (le premier split) puis valeur par valeur (le second split imbriqué dans la boucle). Une fois que tu as tes valeurs, tu en fait ce que tu veux

bouchrabouchra

je pense que tu vas mieux comprendre si tu jetes un coup d'oeil sur le site à l'adresse suivante:
http://69.159.241.96/alliancewebse [...] ysFilter=0

---------------
bou

Arjuna

Aircraft Ident.: F-MBSD

Nope, je comprends pas mieu

Mais bon, ça doit toujours fonctionner avec mon système, sauf que là, c'est pas du VBA, mais plutôt du VB.NET, ce qui est littéralement différent.

C'est un aspect que je n'ai pas regardé, mais dans le namespace System.Web, il y a tout ce qu'il faut pour communiquer en HTTP avec d'autres sites. Creuse de ce côté là.

Ensuite, t'auras plus qu'à parser le HTML reçu afin de retrouver les infos dont tu as besoin.

bouchrabouchra

merci quand même

---------------
bou

bouchrabouchra

si tu as un exemple déjà fait, ça pourrait m'aider beaucoup

---------------
bou

Arjuna

Aircraft Ident.: F-MBSD

avec .NET nope.

Arjuna

Aircraft Ident.: F-MBSD

Mais crée un autre topic dans la cat "C#/Managed", il y sera plus à sa place.

bouchrabouchra

je ne comprend pas qu'est ce que tu veux dire?

---------------
bou

Arjuna

Aircraft Ident.: F-MBSD

Ben parceque vu que tes pages sont en ASPX, j'en déduit que ça n'a rien à voir avec du VBA, ni même du VB, mais du VB.NET

Hors, le VB.NET, c'est ni plus ni moins que du C# avec une syntaxe différente. Le fonctionnement est le même, et les librairies sont aussi les mêmes.

Pour cette raison, si tu veux des réponses à ton problème, il faut poster ton problème dans C#/Managed (en précisant qu'il s'agit de VB.NET) et non ici, où tu as moins de chances de trouver une personne qui saura répondre à ton problème.

bouchrabouchra

non, mais mon application est en VBA et non en VB.NET

---------------
bou

Arjuna

Aircraft Ident.: F-MBSD

Comprends rien.

Le site que tu m'as montré, c'est celui sur lequel tu dois retrouver les infos ?

Ben le code que je t'ai pondu marche, suffit de l'adapter :
-> Tu peux récupérer les éléments du SELECT afin de simuler le choix d'un site, puis après, en parcourant le tableau retourné, tu trouveras sans problème les données.

ie.Body.Document, c'est l'objet "document" que tu as en JavaScript à l'intérieur d'une page sous Internet Explorer. Tu peux donc utiliser toutes les fonctions JS que tu veux (style "getElementById()", et accéder à tous les éléments HTML depuis ton script VBA).

bouchrabouchra

ben c'est la requête que je ne sais pas comment faire.
désolée je ne connais pas VBA beaucoup...

---------------
bou

Arjuna

Aircraft Ident.: F-MBSD

y'a pas de requête

bouchrabouchra

alors peux-tu me dire comment le faire stp. j'en ai aucune idée

---------------
bou

Arjuna

Aircraft Ident.: F-MBSD

ben je peux pas tout t'expliquer. pour voir le fonctionnement avec un formulaire, tu peux regarder ça :

http://forum.hardware.fr/hardwaref [...] 7024-1.htm

bouchrabouchra

non, je ça ne marche pas, mais si tu peux me faire un petit code qui pourrait m'aider ça sera vraiment gentil.
merciiiii

---------------
bou

Publicité

FORUM HardWare.fr

Programmation

VB/VBA/VBS

[VB] Connection HTTP pour récupérer un fichier binaire

Sujets relatifs
Recuperer le texte d'une page web dans un fichier texte	[php ]ecrire dans un fichier
appli Java pour Palm peut-elle lire un fichier XML ?	appli Java pour Palm peut-elle lire un fichier XML ?
Un programme pour transferer auto un fichier sur mon serveur	changement de propriétaire de fichier uploadé
renommage fichier	Ouverture d'un fichier dans son application
Chnager le nom court d'un fichier
Plus de sujets relatifs à : [VB] Connection HTTP pour récupérer un fichier binaire

Page générée en 0.209 secondes