Peut-on coder à la place du WebBroser ???

Le
LE TROLL
Bonjour,

Peut-on avec le code se dispenser du WebBroser ???

Mon besoin est simple, j'envoie :
http://perso0.free.fr/cgi-bin/meteo.pl?depu
75 = n°départemet (1 à x)
Et en retour j'ai une image par l'ouverture d'une fenêtre de
l'explorateur
--

Alors, je me demande si en code, je peux envoyer la requête Internet au
serveur Free, puis récupérer l'image dans une picturBox sans lancer l'IE ???

Le but est de se passer des objets additifs qui causent des plantages
parfois, à cause de la version de leur dll ou ocx Par exemple, j'ai une
appliation distriibuée qui se plante avec MsCalendar, j'ai donc réécrit en
code le calendrier, et je n'ai plus de problème :o)


--
Merci beaucoup, au revoir et à bientôt :o)

Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
bahn po
Le #16670551
LE TROLL a écrit :
Bonjour,

Peut-on avec le code se dispenser du WebBroser ???

Mon besoin est simple, j'envoie :
http://perso0.free.fr/cgi-bin/meteo.pl?depu
75 = n°départemet (1 à x)
Et en retour j'ai une image par l'ouverture d'une fenêtre de
l'explorateur...
-----------------------

Alors, je me demande si en code, je peux envoyer la requête Internet au
serveur Free, puis récupérer l'image dans une picturBox sans lancer l'IE ???

Le but est de se passer des objets additifs qui causent des plantages
parfois, à cause de la version de leur dll ou ocx... Par exemple, j'ai une
appliation distriibuée qui se plante avec MsCalendar, j'ai donc réécrit en
code le calendrier, et je n'ai plus de problème :o)



Oui, place un contrôle winsock sur une feuille, appel le winsock2 pour
correspondre au code ci-dessous, deux boutons pour tester, un connect
(command2) et l'autre charge (command1) la page ou le fichier. Le
resultat, ici un gif, est ecrit à la racine C:

Testé ok.




Option Explicit
Dim tableau
Dim strwebpage As String
Dim webdata

Private Sub Command1_Click()
strwebpage = "GET http://perso0.free.fr/cgi-bin/meteo.pl?depu" &
vbCrLf
Winsock2.SendData strwebpage
'Winsock2.SendData "GET http://" & " HTTP/1.0" & vbCrLf
Winsock2.SendData "Accept: */*" & vbCrLf
Winsock2.SendData "Accept: Accept: image/gif, image/x-xbitmap,
image/jpeg, image/pjpeg, */*" & vbCrLf
Winsock2.SendData "Accept-Language: en-us" & vbCrLf
Winsock2.SendData "User-Agent: Mozilla/4.0 (compatible; MSIE 5.5;
Windows 95)" & vbCrLf
Winsock2.SendData vbCrLf

End Sub

Private Sub Command2_Click()
Winsock2.RemoteHost = "perso0.free.fr"
Winsock2.RemotePort = 80
Winsock2.Connect
End Sub

Private Sub winsock2_DataArrival(ByVal bytesTotal As Long)
Winsock2.GetData webdata, vbString
tableau = tableau & webdata
Me.Caption = Len(tableau)
End Sub
Private Sub winsock2_close()

Open "c:test.gif" For Output As #1
Print #1, tableau
Close

End Sub
Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
If Winsock2.State <> sckClosed Then
WinsockX.Close
End If
Winsock2.Accept requestID
End Sub



A+
LE TROLL
Le #16671331
Bonjour,

Merci, mais... Winsock c'est aussi un composant additionnel.

J'ai demandé : sans composant, avec le code ou les objets de base !!!

Car mettre Winsock à la place de WebBroser, ben... heu...

Cordialement.

--
Merci beaucoup, au revoir et à bientôt :o)
------
Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"bahn po"
| LE TROLL a écrit :
| > Bonjour,
| >
| > Peut-on avec le code se dispenser du WebBroser ???
| >
| > Mon besoin est simple, j'envoie :
| > http://perso0.free.fr/cgi-bin/meteo.pl?depu
| > 75 = n°départemet (1 à x)
| > Et en retour j'ai une image par l'ouverture d'une fenêtre de
| > l'explorateur...
| > -----------------------
| >
| > Alors, je me demande si en code, je peux envoyer la requête Internet
au
| > serveur Free, puis récupérer l'image dans une picturBox sans lancer l'IE
???
| >
| > Le but est de se passer des objets additifs qui causent des
plantages
| > parfois, à cause de la version de leur dll ou ocx... Par exemple, j'ai
une
| > appliation distriibuée qui se plante avec MsCalendar, j'ai donc réécrit
en
| > code le calendrier, et je n'ai plus de problème :o)
|
| Oui, place un contrôle winsock sur une feuille, appel le winsock2 pour
| correspondre au code ci-dessous, deux boutons pour tester, un connect
| (command2) et l'autre charge (command1) la page ou le fichier. Le
| resultat, ici un gif, est ecrit à la racine C:
|
| Testé ok.
|
|
|
|
| Option Explicit
| Dim tableau
| Dim strwebpage As String
| Dim webdata
|
| Private Sub Command1_Click()
| strwebpage = "GET http://perso0.free.fr/cgi-bin/meteo.pl?depu" &
| vbCrLf
| Winsock2.SendData strwebpage
| 'Winsock2.SendData "GET http://" & " HTTP/1.0" & vbCrLf
| Winsock2.SendData "Accept: */*" & vbCrLf
| Winsock2.SendData "Accept: Accept: image/gif, image/x-xbitmap,
| image/jpeg, image/pjpeg, */*" & vbCrLf
| Winsock2.SendData "Accept-Language: en-us" & vbCrLf
| Winsock2.SendData "User-Agent: Mozilla/4.0 (compatible; MSIE 5.5;
| Windows 95)" & vbCrLf
| Winsock2.SendData vbCrLf
|
| End Sub
|
| Private Sub Command2_Click()
| Winsock2.RemoteHost = "perso0.free.fr"
| Winsock2.RemotePort = 80
| Winsock2.Connect
| End Sub
|
| Private Sub winsock2_DataArrival(ByVal bytesTotal As Long)
| Winsock2.GetData webdata, vbString
| tableau = tableau & webdata
| Me.Caption = Len(tableau)
| End Sub
| Private Sub winsock2_close()
|
| Open "c:test.gif" For Output As #1
| Print #1, tableau
| Close
|
| End Sub
| Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
| If Winsock2.State <> sckClosed Then
| WinsockX.Close
| End If
| Winsock2.Accept requestID
| End Sub
|
|
|
| A+
|
|
bahn po
Le #16671401
LE TROLL a émis l'idée suivante :
Bonjour,

Merci, mais... Winsock c'est aussi un composant additionnel.

J'ai demandé : sans composant, avec le code ou les objets de base !!!

Car mettre Winsock à la place de WebBroser, ben... heu...



Demande à gogole l'api winsock
Jean-marc
Le #16672351
LE TROLL wrote:
Bonjour,

Merci, mais... Winsock c'est aussi un composant additionnel.




Le plus simple : utiliser l'API URLDownloadToFile

voici par exemple :

Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" Alias
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szUrl As String, ByVal
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As
Long
Private Const SW_SHOWNORMAL = 1
Private Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal
lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String,
ByVal nShowCmd As Long) As Long

Function downloadFile(ByVal szUrl As String, ByVal szFile As String) As
Boolean
Dim ret As Long

ret = URLDownloadToFile(0, szUrl, szFile, 0, 0)

If ret = 0 Then
downloadFile = True
Else
downloadFile = False
End If
End Function

Private Sub Form_Load()
Dim ret As Boolean

ret = downloadFile("http://perso0.free.fr/cgi-bin/meteo.pl?depu",
"meteo.gif")

If ret Then
' dans une picturebox
Picture1.Picture = LoadPicture("meteo.gif")
' dans une image
Image1.Picture = LoadPicture("meteo.gif")
' ou ouvrir avec l'appli associée au .gif
ShellExecute Me.hwnd, "open", "meteo.gif", vbNullString, "",
SW_SHOWNORMAL
' ou tout autre traitement.
End If
End Sub

L'image retournée est un .gif. Tu peux mettre le nom
de fichier de ton choix, mais l'extension doit etre .gif.

--
Jean-marc Noury (jean_marc_n2)
Microsoft MVP - Visual Basic
FAQ VB: http://faq.vb.free.fr/
mailto: remove '_no_spam_' ;
LE TROLL
Le #16672581
Ahhhhhhhhh.... merci Jean-Marc, ça c'est du renseignement comme je les aime,
c'est du renseignement clef-en-main, on fait un copier coller et ça marche
!!!

Remarques : heureusement que tu me l'as fait car j'aurais eu bien du mal :o)

Je présume que ça marche, t'as dû essayer... je te dirai...

Merci beaucoup, au revoir et à bientôt :o)
------

Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"Jean-marc" 48b94bd2$0$2849$
| LE TROLL wrote:
| > Bonjour,
| >
| > Merci, mais... Winsock c'est aussi un composant additionnel.
|
|
| Le plus simple : utiliser l'API URLDownloadToFile
|
| voici par exemple :
|
| Option Explicit
|
| Private Declare Function URLDownloadToFile Lib "urlmon" Alias
| "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szUrl As String, ByVal
| szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As
| Long
| Private Const SW_SHOWNORMAL = 1
| Private Declare Function ShellExecute Lib "shell32.dll" Alias
| "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal
| lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As
String,
| ByVal nShowCmd As Long) As Long
|
| Function downloadFile(ByVal szUrl As String, ByVal szFile As String) As
| Boolean
| Dim ret As Long
|
| ret = URLDownloadToFile(0, szUrl, szFile, 0, 0)
|
| If ret = 0 Then
| downloadFile = True
| Else
| downloadFile = False
| End If
| End Function
|
| Private Sub Form_Load()
| Dim ret As Boolean
|
| ret = downloadFile("http://perso0.free.fr/cgi-bin/meteo.pl?depu",
| "meteo.gif")
|
| If ret Then
| ' dans une picturebox
| Picture1.Picture = LoadPicture("meteo.gif")
| ' dans une image
| Image1.Picture = LoadPicture("meteo.gif")
| ' ou ouvrir avec l'appli associée au .gif
| ShellExecute Me.hwnd, "open", "meteo.gif", vbNullString, "",
| SW_SHOWNORMAL
| ' ou tout autre traitement.
| End If
| End Sub
|
| L'image retournée est un .gif. Tu peux mettre le nom
| de fichier de ton choix, mais l'extension doit etre .gif.
|
| --
| Jean-marc Noury (jean_marc_n2)
| Microsoft MVP - Visual Basic
| FAQ VB: http://faq.vb.free.fr/
| mailto: remove '_no_spam_' ;
|
|
|
|
Jean-marc
Le #16672711
LE TROLL wrote:
Ahhhhhhhhh.... merci Jean-Marc, ça c'est du renseignement comme je
les aime, c'est du renseignement clef-en-main, on fait un copier
coller et ça marche !!!



C'était bien l'idée en effet :-)

Remarques : heureusement que tu me l'as fait car j'aurais eu bien du
mal :o)

Je présume que ça marche, t'as dû essayer...



Bien entendu :-)

Merci beaucoup, au revoir et à bientôt :o)



Merci du retour !

--
Jean-marc Noury (jean_marc_n2)
Microsoft MVP - Visual Basic
FAQ VB: http://faq.vb.free.fr/
mailto: remove '_no_spam_' ;
LE TROLL
Le #16672831
Parfait, merci :o)))

Voici le programme final :

----------------------------
'
' charge image météo free : form 1
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szUrl As String, _
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As
Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal
_
lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As
String, _
ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1
Dim ligne As String
Dim ret As Long
'

Sub Form_Load()
Dim i As Long
ligne = "L'accès à la météo est impossible ! " & vbLf & vbLf
ligne = ligne & "Recommencer un peu plus tard... " & vbLf & vbLf
ligne = ligne & "Causes possibles : " & vbLf
ligne = ligne & "Serveur et, ou, connexion internet hors service ? " &
vbLf
For i = 1 To 95 ' stop à métropole
Combo1.AddItem Format(i, "00")
Next i
Combo1.ListIndex = 74 ' paris 75
ret = downloadFile("http://perso0.free.fr/cgi-bin/meteo.pl?depu",
"meteo.gif")
If ret = True Then Picture1.Picture = LoadPicture("meteo.gif")
If ret = False Then MsgBox ligne, vbInformation
End Sub

Function downloadFile(ByVal szUrl As String, ByVal szFile As String) As
Boolean
ret = URLDownloadToFile(0, szUrl, szFile, 0, 0)
downloadFile = False
If ret = 0 Then downloadFile = True
End Function

Sub Combo1_Click()
Dim mes As String
mes = "http://perso0.free.fr/cgi-bin/meteo.pl?dep=" & Combo1.ListIndex + 1
ret = downloadFile(mes, "meteo.gif")
If ret = True Then
Picture1.Picture = LoadPicture()
Sleep 300
Picture1.Picture = LoadPicture("meteo.gif")
End If
If ret = False Then MsgBox ligne, vbInformation
End Sub
-------------------------


Merci beaucoup, au revoir et à bientôt :o)
------
Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"Jean-marc" 48b94bd2$0$2849$
| LE TROLL wrote:
| > Bonjour,
| >
| > Merci, mais... Winsock c'est aussi un composant additionnel.
|
|
| Le plus simple : utiliser l'API URLDownloadToFile
|
| voici par exemple :
|
| Option Explicit
|
| Private Declare Function URLDownloadToFile Lib "urlmon" Alias
| "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szUrl As String, ByVal
| szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As
| Long
| Private Const SW_SHOWNORMAL = 1
| Private Declare Function ShellExecute Lib "shell32.dll" Alias
| "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal
| lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As
String,
| ByVal nShowCmd As Long) As Long
|
| Function downloadFile(ByVal szUrl As String, ByVal szFile As String) As
| Boolean
| Dim ret As Long
|
| ret = URLDownloadToFile(0, szUrl, szFile, 0, 0)
|
| If ret = 0 Then
| downloadFile = True
| Else
| downloadFile = False
| End If
| End Function
|
| Private Sub Form_Load()
| Dim ret As Boolean
|
| ret = downloadFile("http://perso0.free.fr/cgi-bin/meteo.pl?depu",
| "meteo.gif")
|
| If ret Then
| ' dans une picturebox
| Picture1.Picture = LoadPicture("meteo.gif")
| ' dans une image
| Image1.Picture = LoadPicture("meteo.gif")
| ' ou ouvrir avec l'appli associée au .gif
| ShellExecute Me.hwnd, "open", "meteo.gif", vbNullString, "",
| SW_SHOWNORMAL
| ' ou tout autre traitement.
| End If
| End Sub
|
| L'image retournée est un .gif. Tu peux mettre le nom
| de fichier de ton choix, mais l'extension doit etre .gif.
|
| --
| Jean-marc Noury (jean_marc_n2)
| Microsoft MVP - Visual Basic
| FAQ VB: http://faq.vb.free.fr/
| mailto: remove '_no_spam_' ;
|
|
|
|
Jean-marc
Le #16673241
LE TROLL wrote:
Parfait, merci :o)))

Voici le programme final :



Presque parfait :-)

Voici la version 'académique' :

Tu noteras que :

- les variables globales ont été supprimées, il ne reste que
la chaine d'affichage de l'erreur (qui est une constante en fait).
- La variable "ligne" a été renommée en "MsgErreur", puisque c'est
sa signification. Pourquoi cacher ça au lecteur ?
- Le code a été réindenté en utilisant les tabulations réglementaires
- Tout ce qui pouvait etre exprimée comme une constante l'a été. Avantage;
il suffit de modifier les constantes à une seule place pour mettre à jour
tout le programme. Il n'y a plus de redondance inutiles du code
- Tout ce qui était hard-codé est devenu constant
- J'ai supprimé les "if ret = true then " au profit de "if ret then".
Préciser "= True" est un pléonasme ici.
- Il faut utiliser les ELSE dans les if exclusifs, c'est plus clair et
plus propre.

Et voila le code, j'espère que tu conviendras que c'est quand même plus
plaisant à lire que la version initiale, en plus d'être 1000 fois plus
simple à maintenir et/ou à faire évoluer ...

'
' Charge image météo free : form 1
'
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szUrl As String, _
ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Const SW_SHOWNORMAL As Long = 1

Private Const MAX_DEPT As Long = 95 ' 95 departements
Private Const DEF_DEPT As Long = 75 ' 75 par défaut
Private Const SLEEP_TIME As Long = 300

Private Const BASE_URL As String =
"http://perso0.free.fr/cgi-bin/meteo.pl?dep="
Private Const TEMP_IMG As String = "meteo.gif"


Dim MsgErreur As String

Function DownloadFile(ByVal szUrl As String, _
ByVal szFile As String) As Boolean
Dim ret As Long

ret = URLDownloadToFile(0, szUrl, szFile, 0, 0)
If ret = 0 Then
DownloadFile = True
End If
End Function

Function DownloadMeteo(ByVal dept As String) As Boolean

DownloadMeteo = DownloadFile(BASE_URL & Trim$(dept), TEMP_IMG)
End Function

' Initialise ComboBox des Départements
Sub InitialiseDept()
Dim i As Long

For i = 1 To MAX_DEPT
Combo1.AddItem Format(i, "00")
Next i

Combo1.ListIndex = DEF_DEPT - 1
End Sub

Sub AfficheMeteo(ByVal img As String, _
ByVal sleepTime As Long)
Picture1.Picture = LoadPicture()
Sleep sleepTime
Picture1.Picture = LoadPicture(img)
End Sub

Sub Form_Load()

Dim ret As Boolean

' Initialisation de la chaine à afficher en cas d'erreur
MsgErreur = "L'accès à la météo est impossible ! " & vbCrLf & vbCrLf
MsgErreur = MsgErreur & "Recommencer un peu plus tard... " & vbCrLf &
vbCrLf
MsgErreur = MsgErreur & "Causes possibles : " & vbCrLf
MsgErreur = MsgErreur & "Serveur et, ou, connexion internet hors service
? " & vbCrLf

' Remplissage de la combo des départements
Call InitialiseDept

ret = DownloadMeteo(DEF_DEPT)

If ret Then
Call AfficheMeteo(TEMP_IMG, 0)
Else
MsgBox MsgErreur, vbInformation
End If
End Sub

Sub Combo1_Click()

Dim ret As Boolean

ret = DownloadMeteo(Combo1.Text)

If ret Then
Call AfficheMeteo(TEMP_IMG, SLEEP_TIME)
Else
MsgBox MsgErreur, vbInformation
End If
End Sub

Bonne continuation !

--
Jean-marc Noury (jean_marc_n2)
Microsoft MVP - Visual Basic
FAQ VB: http://faq.vb.free.fr/
mailto: remove '_no_spam_' ;
Driss HANIB
Le #16685441
et c'est mieux qu'un "cabane au fond du jardin"...;o)

Driss

"LE TROLL"
Ahhhhhhhhh.... merci Jean-Marc, ça c'est du renseignement comme je les
aime,
c'est du renseignement clef-en-main, on fait un copier coller et ça marche
!!!

Remarques : heureusement que tu me l'as fait car j'aurais eu bien du mal
:o)

Je présume que ça marche, t'as dû essayer... je te dirai...

Merci beaucoup, au revoir et à bientôt :o)
------

Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"Jean-marc" 48b94bd2$0$2849$
| LE TROLL wrote:
| > Bonjour,
| >
| > Merci, mais... Winsock c'est aussi un composant additionnel.
|
|
| Le plus simple : utiliser l'API URLDownloadToFile
|
| voici par exemple :
|
| Option Explicit
|
| Private Declare Function URLDownloadToFile Lib "urlmon" Alias
| "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szUrl As String,
ByVal
| szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As
| Long
| Private Const SW_SHOWNORMAL = 1
| Private Declare Function ShellExecute Lib "shell32.dll" Alias
| "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal
| lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As
String,
| ByVal nShowCmd As Long) As Long
|
| Function downloadFile(ByVal szUrl As String, ByVal szFile As String) As
| Boolean
| Dim ret As Long
|
| ret = URLDownloadToFile(0, szUrl, szFile, 0, 0)
|
| If ret = 0 Then
| downloadFile = True
| Else
| downloadFile = False
| End If
| End Function
|
| Private Sub Form_Load()
| Dim ret As Boolean
|
| ret = downloadFile("http://perso0.free.fr/cgi-bin/meteo.pl?depu",
| "meteo.gif")
|
| If ret Then
| ' dans une picturebox
| Picture1.Picture = LoadPicture("meteo.gif")
| ' dans une image
| Image1.Picture = LoadPicture("meteo.gif")
| ' ou ouvrir avec l'appli associée au .gif
| ShellExecute Me.hwnd, "open", "meteo.gif", vbNullString, "",
| SW_SHOWNORMAL
| ' ou tout autre traitement.
| End If
| End Sub
|
| L'image retournée est un .gif. Tu peux mettre le nom
| de fichier de ton choix, mais l'extension doit etre .gif.
|
| --
| Jean-marc Noury (jean_marc_n2)
| Microsoft MVP - Visual Basic
| FAQ VB: http://faq.vb.free.fr/
| mailto: remove '_no_spam_' ;
|
|
|
|




Publicité
Poster une réponse
Anonyme