;----------------------------------------------------------------------------------
; Auto Login Forum
; PureBasic Version 4.10
; Ce code montre comment procéder pour remplir un formulaire
; de connexion d'accès à un Forum automatiquement
; Ce code n'est pas optimisé pour fonctionner sur des pages contenant des Frames
;----------------------------------------------------------------------------------
; Fonctionnement:
; Si l'URL de navigation correspond à un élément de la liste AutoLogin()
; on compte le nombre de <FORM> dans la page, puis
; pour chaque <FORM>, on comptabilise le nombre d'éléments ci dessous:
; <INPUT> de type text
; <INPUT> de type password
; <INPUT> de type submit
; Une <FORM> est considérée comme apte à recevoir les données si
; elle comptabilise ces 3 types mais une seule fois pour chacun d'entre eux
; et si le submit est placé à la fin de cette séquence
; La première <FORM> qui correspond à ces critères est alors remplie des données
; d'enregistrement et validée.
;----------------------------------------------------------------------------------
Enumeration
#Main
#Web
#Status
#Panel
#Progress
EndEnumeration
Structure VARIANT_SPLIT
StructureUnion
Variant.VARIANT
Split.l[4]
EndStructureUnion
EndStructure
Interface IHTMLElementCollection_FIXED
QueryInterface(a,b)
AddRef()
Release()
GetTypeInfoCount(a)
GetTypeInfo(a,b,c)
GetIDsOfNames(a,b,c,d,e)
Invoke(a,b,c,d,e,f,g,h)
toString(a)
put_length(a)
get_length(a)
get__newEnum(a)
item(a1,a2,a3,a4,b1,b2,b3,b4,c)
tags(a1,a2,a3,a4,b)
EndInterface
Interface IHTMLFormElement_Fixed
QueryInterface(a, b)
AddRef()
Release()
GetTypeInfoCount(a)
GetTypeInfo(a, b, c)
GetIDsOfNames(a, b, c, d, e)
Invoke(a, b, c, d, e, f, g, h)
put_action(a.p-bstr)
get_action(a)
put_dir(a.p-bstr)
get_dir(a)
put_encoding(a.p-bstr)
get_encoding(a)
put_method(a.p-bstr)
get_method(a)
get_elements(a)
put_target(a.p-bstr)
get_target(a)
put_name(a.p-bstr)
get_name(a)
put_onsubmit(a.p-Variant)
get_onsubmit(a)
put_onreset(a.p-Variant)
get_onreset(a)
submit()
reset()
put_length(a)
get_length(a)
get__newEnum(a)
item(a1,a2,a3,a4,b1,b2,b3,b4,c)
tags(a.p-Variant, b)
EndInterface
Structure Login
Url.s
Nom.s
Password.s
EndStructure
Global NewList AutoLogin.Login()
Global UserName.s,Password.s,WebBrowser.IWebBrowser2
AddElement (AutoLogin())
AutoLogin()\Url= "http://www.developpez.net/forums/forumdisplay.php?f=911"
AutoLogin()\Nom= " ;<--- A remplir
AutoLogin()\Password= " ;<--- A remplir
Procedure ProcessInputElement(*pFormElement.IHTMLFormElement_Fixed, Valid.l)
Protected *pElemDisp.IDispatch = #Null
Protected *pInputElement.IHTMLInputElement = #Null
Protected *pElement.IHTMLElement= #Null
Protected a.l,Number.l,varIndex.VARIANT_SPLIT
Protected NbText.l,NbPassword.l,NbSubmit.l
Protected hr.l,Submit.l
varIndex\Variant\vt = #VT_I4
If *pFormElement\get_length(@Number)= #S_OK
For a= 0 To Number-1
varIndex\Variant\lVal= a
hr= *pFormElement\item(varIndex\Split[0], varIndex\Split[1], varIndex\Split[2], varIndex\Split[3], varIndex\Split[0], varIndex\Split[1], varIndex\Split[2], varIndex\Split[3], @*pElemDisp)
If hr=0 And *pElemDisp>0
hr=*pElemDisp\QueryInterface(?IID_IHTMLInputElement, @*pInputElement)
If hr=0 And *pInputElement>0
hr=*pInputElement\get_type(@*bstr)
If hr=0 And *bstr>0
Propriete.s= PeekS (*bstr,-1, #PB_Unicode )
SysFreeString_ (@*bstr)
If Valid=0
If Propriete= "text"
NbText=NbText+1
ElseIf Propriete= "password"
NbPassword=NbPassword+1
ElseIf Propriete= "submit" And NbText=1 And NbPassword=1
NbSubmit=NbSubmit+1
EndIf
Else
If Propriete= "text"
*pInputElement\put_value(AutoLogin()\Nom)
ElseIf Propriete= "password"
*pInputElement\put_value(AutoLogin()\Password)
ElseIf Propriete= "submit"
If *pElemDisp\QueryInterface(?IID_IHTMLElement, @*pElement.IHTMLElement)= #S_OK
*pElement\Click()
*pElement\Release()
Submit= 1
a= Number
EndIf
EndIf
EndIf
EndIf
*pInputElement\Release()
EndIf
*pElemDisp\Release()
EndIf
Next a
EndIf
If NbSubmit=1 And NbText=1 And NbPassword=1
ProcedureReturn ProcessInputElement(*pFormElement,1)
EndIf
If Submit
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure ProcessFormsCollection(*pElemColl.IHTMLElementCollection_FIXED)
Protected *pElemDisp.IDispatch = #Null
Protected *pFormElement.IHTMLFormElement_Fixed = #Null
Protected a.l,Number.l,*bstr,varIndex.VARIANT_SPLIT
Protected hr.l,Ret.l
varIndex\Variant\vt = #VT_I4
If *pElemColl\get_length(@Number)= #S_OK
For a=0 To Number-1
varIndex\Variant\lVal= a
hr= *pElemColl\item(varIndex\Split[0], varIndex\Split[1], varIndex\Split[2], varIndex\Split[3], varIndex\Split[0], varIndex\Split[1], varIndex\Split[2], varIndex\Split[3], @*pElemDisp.IDispatch)
If hr=0 And *pElemDisp>0
hr= *pElemDisp\QueryInterface(?IID_IHTMLFormElement, @*pFormElement)
If hr=0 And *pFormElement>0
If ProcessInputElement(*pFormElement,0)
a=Number
Ret=1
EndIf
*pFormElement\Release()
EndIf
*pElemDisp\Release()
EndIf
Next a
EndIf
If Ret
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure ProcessDocument(*pDoc.IHTMLDocument2)
Protected *pElemColl.IHTMLElementCollection_FIXED = #Null
Protected hr.l,Ret.l
hr= *pDoc\get_forms(@*pElemColl)
If hr=0 And *pElemColl>0
Ret=ProcessFormsCollection(*pElemColl)
*pElemColl\Release()
EndIf
If Ret
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure Auto_Login(Url.s)
Protected *pDispatch.IDispatch,*pDocument2.IHTMLDocument2
Protected hr.l,Ret.l,message.s
ForEach AutoLogin()
If AutoLogin()\Url=Url
Ret=1
Break
EndIf
Next
If Ret
hr= WebBrowser\get_document(@*pDispatch)
If hr=0 And *pDispatch>0
hr=*pDispatch\QueryInterface(?IID_IHTMLDocument2, @*pDocument2)
If hr=0 And *pDocument2>0
If ProcessDocument(*pDocument2)
message= "Le programme à rempli ce formulaire pour vous ; )" + Chr (13)
message+ "Si vos informations de Login sont correctes, vous serez connecté!"
MessageRequester ( "Info" ,message)
EndIf
*pDocument2\Release()
EndIf
*pDispatch\Release()
EndIf
EndIf
EndProcedure
OpenWindow ( #Main ,0,0,800,600, "Auto Login" , #PB_Window_SystemMenu | #PB_Window_ScreenCentered )
If CreateStatusBar ( #Status , WindowID ( #Main ))
AddStatusBarField (600)
AddStatusBarField (200)
EndIf
StatusBarText ( #Status , 0, "" )
StatusBarText ( #Status , 1, "" )
CreateGadgetList ( WindowID ( #Main ))
PanelGadget ( #Panel , 2, 24, 798, 550)
AddGadgetItem ( #Panel , -1, "" )
WebGadget ( #Web ,2,2,788,520, "http://www.developpez.net/forums/forumdisplay.php?f=911" )
CloseGadgetList ()
ProgressBarGadget ( #Progress , 10, 4, 200, 10, 0, 100)
WebBrowser.IWebBrowser2 = GetWindowLong_ ( GadgetID ( #Web ), #GWL_USERDATA )
Repeat
Event= WaitWindowEvent ()
Select Event
Case #PB_Event_Gadget
Select EventGadget ()
Case #Web
Select EventType ()
Case #PB_EventType_TitleChange
Title.s= GetGadgetItemText ( #Web , #PB_Web_PageTitle )
SetGadgetItemText ( #Panel , 0, Title, 0)
Case #PB_EventType_StatusChange
StatusTexte.s= GetGadgetItemText ( #Web , #PB_Web_StatusMessage )
StatusBarText ( #Status , 0, StatusTexte)
Case #PB_EventType_DownloadProgress
Progress= GetGadgetAttribute ( #Web , #PB_Web_Progress )
ProgressMax= GetGadgetAttribute ( #Web , #PB_Web_ProgressMax )
If Progress<>ProgressMax
HideGadget ( #Progress ,0)
SetGadgetState ( #Progress , Progress)
Else
HideGadget ( #Progress ,1)
EndIf
Case #PB_EventType_DownloadEnd
Url.s= GetGadgetText ( #Web )
Auto_Login(Url)
EndSelect
EndSelect
Case #WM_CLOSE
quit.l=1
EndSelect
Until quit=1
End
DataSection
IID_IHTMLElement:
Data.l $3050F1FF
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLInputElement:
Data.l $3050F5D2
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLFormElement:
Data.l $3050F1F7
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLDocument2:
Data.l $332C4425
Data.w $26CB, $11D0
Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
EndDataSection
Tips WebGadget
Deuxième exemple d'Auto Login sur un Forum, ce code est plus complet, tout d'abord avant de faire une recherche sur les champs à remplir, il vérifie que la page présente un formulaire et que celui-ci correspond bien à ce qu'il attend, si c'est le cas alors il remplit les champs et valide.
Dernière modification par nico le dim. 09/mars/2008 14:27, modifié 6 fois.
je vais tester ça tout de suite 
Tu as laissé ton mot de passe dans le code ,c'est volontaire ?
[EDIT]
Je viens de tester, je n'y comprends rien ... mais ça fonctionne bien.
Je vais l'ajouter dans la page sources, merci.
Tu as laissé ton mot de passe dans le code ,c'est volontaire ?
[EDIT]
Je viens de tester, je n'y comprends rien ... mais ça fonctionne bien.
Je vais l'ajouter dans la page sources, merci.
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
; Voici une partie du code source de la page de connexion au Forum Français:
<form action="login.php" method="post" target="_top">
<table width="100%" cellspacing="2" cellpadding="2" border="0" align="center">
<tr>
<td align="left" class="nav"><a href="index.php" class="nav">PureBasic Index du Forum</a></td>
</tr>
</table>
<table width="100%" cellpadding="4" cellspacing="1" border="0" class="forumline" align="center">
<tr>
<th height="25" class="thHead" nowrap="nowrap">Veuillez entrer votre nom d'utilisateur et votre mot de passe pour vous connecter.</th>
</tr>
<tr>
<td class="row1"><table border="0" cellpadding="3" cellspacing="1" width="100%">
<tr>
<td colspan="2" align="center"> </td>
</tr>
<tr>
<td width="45%" align="right"><span class="gen">Nom d'utilisateur:</span></td>
<td>
<input type="text" class="post" name="username" size="25" maxlength="40" value="" />
</td>
</tr>
<tr>
<td align="right"><span class="gen">Mot de passe:</span></td>
<td>
<input type="password" class="post" name="password" size="25" maxlength="32" />
</td>
</tr>
<tr align="center">
<td colspan="2"><span class="gen">Se connecter automatiquement à chaque visite: <input type="checkbox" name="autologin" /></span></td>
</tr>
<tr align="center">
<td colspan="2"><input type="hidden" name="redirect" value="" /><input type="submit" name="login" class="mainoption" value="Connexion" /></td>
</tr>
<tr align="center">
<td colspan="2"><span class="gensmall"><a href="profile.php?mode=sendpassword" class="gensmall">J'ai oublié mon mot de passe</a></span></td>
</tr>
</table></td>
</tr>
</table>
</form>
; Dans la procédure ProcessDocument(*pDoc.IHTMLDocument2)
; *pDoc\get_forms(@*pElemColl.IHTMLElementCollection_FIXED)me permet d'obtenir un pointeur
; sur les parties du code HTML qui constituent un formulaire qui commence par <form et finit par </form>
; Pour connaitre le nombre de formulaire de cette collection, j'appelle cette interface *pElemColl\get_length(@Number)
; ensuite *pElemColl\item(...) permet d'obtenir un pointeur sur l'interface Idispatch pour chaque formulaire,
; grâce à ce pointeur j'appelle une autre interface *pElemDisp\QueryInterface(?IID_IHTMLFormElement, @*pFormElement)
; pour avoir accès aux éléments contenu dans le formulaire
; *pFormElement\get_length(@Number) me donne le nombre d'éléments de ce formulaire
; *pFormElement\item(...) permet d'obtenir un pointeur sur l'interface Idispatch pour chaque élément,
; j'appelle ensuite *pElemDisp\QueryInterface(?IID_IHTMLInputElement, @*pInputElement)
; et j'obtiens un nouveau pointeur sur l'élément en question qui me permet d'entrer des données ou en extraire.
; Cela fonctionne quel que soit le langage de la page.
Merci pour les explications ,c'est déjà moins mystérieux 
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Dans le code précédent, je faisais un Get_all et je listais tous les tags à la recherche des INPUT, c'était plus simple mais moins efficace et moins rapide finalement.
Il y a toute une panoplie d'interface pour traiter une page web (le problème c'est de connaitre la hiérarchie, quelle interface me permet d'en appeller une autre!)
Par exemple avec IHTMLDocument3::getElementsByTagName, on a directement un pointeur sur une collection par Tag, ce qui permettrait de réduire le code, après c'est une question de compatibilité de version d'Internet Explorer.
Il y a toute une panoplie d'interface pour traiter une page web (le problème c'est de connaitre la hiérarchie, quelle interface me permet d'en appeller une autre!)
Par exemple avec IHTMLDocument3::getElementsByTagName, on a directement un pointeur sur une collection par Tag, ce qui permettrait de réduire le code, après c'est une question de compatibilité de version d'Internet Explorer.
J'ai modifié le premier exemple d'Auto Login, il fonctionne aussi bien que le deuxième exemple.
La différence, c'est que si vous mettez en lien la page de votre profil sur le Forum, le premier exemple va remplir les premier champs input text et password et valider, alors que le second identifiera cette page comme étant non valide pour une inscription sur un Forum.
La différence, c'est que si vous mettez en lien la page de votre profil sur le Forum, le premier exemple va remplir les premier champs input text et password et valider, alors que le second identifiera cette page comme étant non valide pour une inscription sur un Forum.
Avec ce troisième exemple, il n'est plus nécessaire de remplir les informations de Login pour se connecter automatiquement. Le programme vérifie à chaque chargement d'une page si un formulaire est disponible et lance un event sur celui-ci. Toutes les données que vous saisissez pour le remplissage de ce formulaire sont alors capturées, à la prochaine connection sur le même forum, le programme vous propose de remplir le formulaire à votre place.
Code : Tout sélectionner
;----------------------------------------------------------------------------------
; Auto Login Forum
; Exemple N°3
; PureBasic Version 4.10
; Ce code montre comment procéder pour remplir un formulaire
; de connexion d'accès à un Forum automatiquement
; Ce code n'est pas optimisé pour fonctionner sur des pages contenant des Frames
; ---------------------------------------------------------------------------------
; Cette version permet de capturer et d'enregistrer vos données de Login que
; vous soumettez dans un formulaire et ainsi vous permettre de vous logger
; automatiquement à la prochaine session
;----------------------------------------------------------------------------------
Enumeration
#Main
#Web
#Status
#Panel
#Progress
#Check
EndEnumeration
Structure DispatchFunctions
QueryInterface.l
AddRef.l
Release.l
GetTypeInfoCount.l
GetTypeInfo.l
GetIDsOfNames.l
Invoke.l
EndStructure
Structure DispatchObject
*IDispatch.IDispatch
ObjectCount.l
EndStructure
Structure VARIANT_SPLIT
StructureUnion
Variant.VARIANT
Split.l[4]
EndStructureUnion
EndStructure
Interface IHTMLElementCollection_FIXED
QueryInterface(a,b)
AddRef()
Release()
GetTypeInfoCount(a)
GetTypeInfo(a,b,c)
GetIDsOfNames(a,b,c,d,e)
Invoke(a,b,c,d,e,f,g,h)
toString(a)
put_length(a)
get_length(a)
get__newEnum(a)
item(a1,a2,a3,a4,b1,b2,b3,b4,c)
tags(a1,a2,a3,a4,b)
EndInterface
Interface IHTMLFormElement_Fixed
QueryInterface(a, b)
AddRef()
Release()
GetTypeInfoCount(a)
GetTypeInfo(a, b, c)
GetIDsOfNames(a, b, c, d, e)
Invoke(a, b, c, d, e, f, g, h)
put_action(a.p-bstr)
get_action(a)
put_dir(a.p-bstr)
get_dir(a)
put_encoding(a.p-bstr)
get_encoding(a)
put_method(a.p-bstr)
get_method(a)
get_elements(a)
put_target(a.p-bstr)
get_target(a)
put_name(a.p-bstr)
get_name(a)
put_onsubmit(a.p-Variant)
get_onsubmit(a)
put_onreset(a.p-Variant)
get_onreset(a)
submit()
reset()
put_length(a)
get_length(a)
get__newEnum(a)
item(a1,a2,a3,a4,b1,b2,b3,b4,c)
tags(a.p-Variant, b)
EndInterface
Structure Login
Url.s
Nom.s
Password.s
EndStructure
Declare.l process(Option.l)
Global NewList AutoLogin.Login()
Global NewList dispatchObject.DispatchObject()
Global WebBrowser.IWebBrowser2
; AddElement (AutoLogin())
; AutoLogin()\Url= "http://www.developpez.net/forums/forumdisplay.php?f=911"
; AutoLogin()\Nom=" ;<--- A remplir
; AutoLogin()\Password=" ;<--- A remplir
Procedure.l AddRef(*THIS.DispatchObject)
*THIS\ObjectCount + 1
ProcedureReturn *THIS\ObjectCount
EndProcedure
Procedure.l QueryInterface(*THIS.DispatchObject, *iid.GUID, *Object.Long)
Protected *THIS_.IDispatch
If CompareMemory(*iid,?DIID_HTMLFormElementEvents2,16)Or CompareMemory(*iid, ?IID_IUnknown, SizeOf(GUID))
*Object\l = *THIS
*THIS_=*THIS.DispatchObject
*THIS_\AddRef()
ProcedureReturn #S_OK
EndIf
If CompareMemory(*iid, ?IID_IDispatch, SizeOf(GUID))
*Object\l = *THIS
*THIS_=*THIS.DispatchObject
*THIS_\AddRef()
ProcedureReturn #S_OK
EndIf
*Object\l = 0
ProcedureReturn #E_NOINTERFACE
EndProcedure
Procedure.l Release(*THIS.DispatchObject)
*THIS\ObjectCount - 1
ProcedureReturn *THIS\ObjectCount
EndProcedure
Procedure GetTypeInfoCount(*THIS.DispatchObject, pctinfo)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure GetTypeInfo(*THIS.DispatchObject, iTInfo, lcid, ppTInfo )
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure GetIDsOfNames(*THIS.DispatchObject, riid, rgszNames, cNames, lcid, rgDispId) : EndProcedure
Procedure Invoke(*THIS.DispatchObject, dispIdMember, riid, lcid, wFlags, *pDispParams.DISPPARAMS, *pVarResult.VARIANT, *pExcepInfo, *puArgErr)
Protected *pEvtObj.IHTMLEventObj=#Null
Protected *pElem.IHTMLElement=#Null
Protected *pDispElem.IDispatch=#Null
Protected *params1.VARIANT=#Null
Protected AttributeValue.VARIANT,Propriete.s,Ret.l,message.s,hr.l,Url.s,Pos.l
Static Nom.s,Password.s
;Debug "dispIdMember= "+Str(dispIdMember)
If dispIdMember= 1049 ;DISPID_ONFOCUSOUT
*params1.VARIANT=*pDispParams\rgvarg
*pDispElem.IDispatch = *params1\pdispVal
If *pDispElem
hr= *pDispElem\QueryInterface(?IID_IHTMLEventObj, @*pEvtObj)
If hr=0 And *pEvtObj>0
hr= *pEvtObj\get_srcElement(@*pElem.IHTMLElement)
If hr=0 And *pElem>0
If *pElem\getAttribute("type",0,@AttributeValue)=#S_OK
If AttributeValue\vt=#VT_BSTR And AttributeValue\bstrVal>0
Propriete=PeekS(AttributeValue\bstrVal,-1,#PB_Unicode)
SysFreeString_(@AttributeValue\bstrVal)
If Propriete="text"
*pElem\GetAttribute("value",0,@AttributeValue)
If AttributeValue\bstrVal
Nom= PeekS(AttributeValue\bstrVal,-1,#PB_Unicode)
Debug "Perte de focus --> Nom= "+Nom
Debug "------------------------------"
SysFreeString_(@AttributeValue\bstrVal)
EndIf
ElseIf Propriete="password"
*pElem\GetAttribute("value",0,@AttributeValue)
If AttributeValue\bstrVal
Password= PeekS(AttributeValue\bstrVal,-1,#PB_Unicode)
Debug "Perte de focus --> Password= "+Password
Debug "------------------------------"
SysFreeString_(@AttributeValue\bstrVal)
EndIf
EndIf
EndIf
EndIf
*pElem\Release()
EndIf
*pEvtObj\Release()
EndIf
EndIf
EndIf
If dispIdMember= 1007 ;DISPID_ONSUBMIT
If Nom<>"" And Password<>""
message.s= "Souhaitez-vous que le programme sauvegarde vos données pour un enregistrement automatique à la prochaine session?"
Ret=MessageRequester("Info" ,message,#PB_MessageRequester_YesNo)
If Ret=6
Pos=FindString(GetGadgetText(#Web),"?",1)
If Pos
Url=Left(GetGadgetText(#Web),Pos-1)
Else
Url=GetGadgetText(#Web)
EndIf
Debug "----Nouvelle données enregistrées----"
Debug "Url= "+Url
Debug "Nom= "+Nom
Debug "Password= "+Password
Debug "-------------------------------------"
AddElement (AutoLogin())
AutoLogin()\Url= Url
AutoLogin()\Nom= Nom
AutoLogin()\Password= PassWord
EndIf
Nom="":Password=""
EndIf
EndIf
EndProcedure
Procedure ConnectEvent(*pElemDisp.IDispatch)
Protected *pElement.IHTMLElement=#Null
Protected *pCPC.IConnectionPointContainer=#Null
Protected *pCP.IConnectionPoint=#Null
Protected hr.l,Ret.l
hr= *pElemDisp\QueryInterface(?IID_IHTMLElement, @*pElement)
If hr=0 And *pElement>0
hr= *pElement\QueryInterface(?IID_IConnectionPointContainer, @*pCPC)
If hr=0 And *pCPC>0
hr= *pCPC\FindConnectionPoint(?DIID_HTMLFormElementEvents2, @*pCP)
If hr=0 And *pCP>0
AddElement(DispatchObject())
DispatchObject()\IDispatch = ?dispatchFunctions
If *pCP\Advise(@DispatchObject(), @dwCookie)=#S_OK
Debug "Prêt à recevoir les évènements liés à ce formulaire!"
Debug "------------------------------"
Ret=1
Else
DeleteElement(DispatchObject())
EndIf
*pCP\Release()
EndIf
EndIf
*pCPC\Release()
EndIf
ProcedureReturn Ret
EndProcedure
Procedure ProcessInputElement(*pFormElement.IHTMLFormElement_Fixed, Option.l)
Protected *pElemDisp.IDispatch = #Null
Protected *pInputElement.IHTMLInputElement = #Null
Protected *pElement.IHTMLElement= #Null
Protected a.l,Number.l,varIndex.VARIANT_SPLIT
Protected NbText.l,NbPassword.l,NbSubmit.l
Protected hr.l,Submit.l,Ret.l,message.s,Propriete.s
varIndex\Variant\vt = #VT_I4
If *pFormElement\get_length(@Number)= #S_OK
For a= 0 To Number-1
varIndex\Variant\lVal= a
hr= *pFormElement\item(varIndex\Split[0], varIndex\Split[1], varIndex\Split[2], varIndex\Split[3], varIndex\Split[0], varIndex\Split[1], varIndex\Split[2], varIndex\Split[3], @*pElemDisp)
If hr=0 And *pElemDisp>0
hr=*pElemDisp\QueryInterface(?IID_IHTMLInputElement, @*pInputElement)
If hr=0 And *pInputElement>0
hr=*pInputElement\get_type(@*bstr)
If hr=0 And *bstr>0
Propriete= PeekS (*bstr,-1, #PB_Unicode )
SysFreeString_ (@*bstr)
If Option=0 Or Option=1
If Propriete= "text"
NbText=NbText+1
ElseIf Propriete= "password"
NbPassword=NbPassword+1
ElseIf Propriete= "submit" And NbText=1 And NbPassword=1
NbSubmit=NbSubmit+1
EndIf
ElseIf Option=2
If Propriete= "text"
*pInputElement\put_value(AutoLogin()\Nom)
ElseIf Propriete= "password"
*pInputElement\put_value(AutoLogin()\Password)
ElseIf Propriete= "submit"
hr= *pElemDisp\QueryInterface(?IID_IHTMLElement, @*pElement.IHTMLElement)
If hr=0 And *pElement>0
*pElement\Click()
*pElement\Release()
Submit= 1
a= Number
EndIf
EndIf
EndIf
EndIf
*pInputElement\Release()
EndIf
*pElemDisp\Release()
EndIf
Next a
EndIf
If NbSubmit=1 And NbText=1 And NbPassword=1
If Option=1
ProcedureReturn 2
Else
message.s= "Souhaitez-vous que le programme remplisse ce formulaire pour vous?"
Ret=MessageRequester ( "Info" ,message ,#PB_MessageRequester_YesNo)
If Ret=6 ;OUI
ProcessInputElement(*pFormElement,2)
Else
message.s= "Souhaitez-vous supprimer les informations d'enregistrement liées à ce formulaire?"
Ret=MessageRequester ( "Info" ,message ,#PB_MessageRequester_YesNo)
If Ret=6 ;OUI
Debug "----Destruction des données enregistrées----"
Debug "Url= "+AutoLogin()\Url
Debug "Nom= "+AutoLogin()\Nom
Debug "Password= "+AutoLogin()\Password
Debug "-------------------------------------"
DeleteElement(AutoLogin())
ProcedureReturn 2
EndIf
EndIf
ProcedureReturn 0
EndIf
EndIf
If Submit
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
Procedure ProcessFormsCollection(*pElemColl.IHTMLElementCollection_FIXED, Option.l)
Protected *pElemDisp.IDispatch = #Null
Protected *pFormElement.IHTMLFormElement_Fixed = #Null
Protected a.l,Number.l,varIndex.VARIANT_SPLIT
Protected hr.l,Ret.l
varIndex\Variant\vt = #VT_I4
If *pElemColl\get_length(@Number)= #S_OK
For a=0 To Number-1
varIndex\Variant\lVal= a
hr= *pElemColl\item(varIndex\Split[0], varIndex\Split[1], varIndex\Split[2], varIndex\Split[3], varIndex\Split[0], varIndex\Split[1], varIndex\Split[2], varIndex\Split[3], @*pElemDisp.IDispatch)
If hr=0 And *pElemDisp>0
hr= *pElemDisp\QueryInterface(?IID_IHTMLFormElement, @*pFormElement)
If hr=0 And *pFormElement>0
Select ProcessInputElement(*pFormElement,Option)
Case 1
a=Number
Ret=1
Case 2
If ConnectEvent(*pElemDisp)
a=Number
Ret=1
EndIf
EndSelect
*pFormElement\Release()
EndIf
*pElemDisp\Release()
EndIf
Next a
EndIf
ProcedureReturn Ret
EndProcedure
Procedure ProcessDocument(*pDoc.IHTMLDocument2, Option.l)
Protected *pElemColl.IHTMLElementCollection_FIXED = #Null
Protected hr.l,Ret.l
hr= *pDoc\get_forms(@*pElemColl)
If hr=0 And *pElemColl>0
Ret=ProcessFormsCollection(*pElemColl, Option.l)
*pElemColl\Release()
EndIf
ProcedureReturn Ret
EndProcedure
Procedure Process(Option.l)
Protected *pDispatch.IDispatch=#Null
Protected *pDocument2.IHTMLDocument2=#Null
Protected hr.l
hr= WebBrowser\get_document(@*pDispatch)
If hr=0 And *pDispatch>0
hr=*pDispatch\QueryInterface(?IID_IHTMLDocument2, @*pDocument2)
If hr=0 And *pDocument2>0
ProcessDocument(*pDocument2, Option)
*pDocument2\Release()
EndIf
*pDispatch\Release()
EndIf
EndProcedure
Procedure Auto_Login(Url.s, Option.l)
Protected Ret.l
ForEach AutoLogin()
If FindString(Url,AutoLogin()\Url,1)
Ret=1
Break
EndIf
Next
If Ret
Debug "----Url enregistrée contenant des données de Login----"
Debug "Url= "+AutoLogin()\Url
Debug "Nom= "+AutoLogin()\Nom
Debug "Password= "+AutoLogin()\Password
Debug "------------------------------------------------------"
Process(0)
ElseIf Option
Process(1)
EndIf
EndProcedure
OpenWindow ( #Main ,0,0,800,600, "Auto Login" , #PB_Window_SystemMenu | #PB_Window_ScreenCentered )
AddKeyboardShortcut(#Main,#PB_Shortcut_Control | #PB_Shortcut_D, 1)
If CreateStatusBar ( #Status , WindowID ( #Main ))
AddStatusBarField (600)
AddStatusBarField (200)
EndIf
StatusBarText ( #Status , 0, "" )
StatusBarText ( #Status , 1, "" )
CreateGadgetList ( WindowID ( #Main ))
PanelGadget ( #Panel , 2, 24, 798, 550)
AddGadgetItem ( #Panel , -1, "" )
WebGadget ( #Web ,2,2,788,520, "http://www.purebasic.fr/french/login.php")
CloseGadgetList ()
ProgressBarGadget ( #Progress , 10, 4, 200, 10, 0, 100)
CheckBoxGadget(#Check, 300, 4, 300, 20, "Autoriser l'enregistrement automatique des saisies de Login")
SetGadgetState(#Check,1)
WebBrowser.IWebBrowser2 = GetWindowLong_ ( GadgetID ( #Web ), #GWL_USERDATA )
Repeat
Event= WaitWindowEvent ()
Select Event
Case #PB_Event_Menu
Select EventMenu()
Case 1
process(3)
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #Check
If GetGadgetState(#Check)
SetGadgetState(#Web,#PB_Web_Refresh)
EndIf
Case #Web
Select EventType()
Case #PB_EventType_DownloadStart
HideGadget (#Progress ,0)
Case #PB_EventType_TitleChange
Title.s=GetGadgetItemText(#Web,#PB_Web_PageTitle)
SetGadgetItemText (#Panel , 0, Title, 0)
Case #PB_EventType_StatusChange
StatusTexte.s=GetGadgetItemText(#Web,#PB_Web_StatusMessage)
StatusBarText (#Status , 0, StatusTexte)
Case #PB_EventType_DownloadProgress
Progress.f=GetGadgetAttribute(#Web,#PB_Web_Progress)
ProgressMax.f=GetGadgetAttribute(#Web,#PB_Web_ProgressMax)
DownloadProgress.l=Int((Progress/ProgressMax)*100)
SetGadgetState (#Progress ,DownloadProgress)
Case #PB_EventType_DownloadEnd
HideGadget (#Progress ,1)
Url.s=GetGadgetText(#Web)
SetWindowTitle(#Main,"Auto Login "+"[ "+url+" ]")
Option.l=GetGadgetState(#Check)
Auto_Login(Url,Option)
EndSelect
EndSelect
Case #WM_CLOSE
quit.l=1
EndSelect
Until quit=1
End
DataSection
dispatchFunctions:
Data.l @QueryInterface(),@AddRef(),@Release(),@GetTypeInfoCount()
Data.l @GetTypeInfo(),@GetIDsOfNames(),@Invoke()
IID_IUnknown:
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IDispatch:
Data.l $00020400
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IHTMLElement:
Data.l $3050F1FF
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLInputElement:
Data.l $3050F5D2
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IConnectionPointContainer:
Data.l $B196B284
Data.w $BAB4, $101A
Data.b $B6, $9C, $00, $AA, $00, $34, $1D, $07
DIID_HTMLFormElementEvents2:
Data.l $3050F614
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLFormElement:
Data.l $3050F1F7
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLDocument2:
Data.l $332C4425
Data.w $26CB, $11D0
Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
IID_IHTMLEventObj:
Data.l $3050F32D
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
EndDataSection
Dernière modification par nico le jeu. 13/mars/2008 12:24, modifié 1 fois.
Une API à connaitre: DeleteUrlCacheEntry
Pour être sûr charger une page Web si l'url est déjà dans le cache d'internet, on serait tenter de faire:
Mais ça ne marche qu'un coup sur deux, la première fois la page actuelle est rechargée et la deuxième fois on a enfin la nouvelle url qui est rechargée ?
En plus, ça fait toujours deux chargement, une par le cache et une actualisée.
Avec cet API, ça fonctionne très bien, un seul chargement:
Pour être sûr charger une page Web si l'url est déjà dans le cache d'internet, on serait tenter de faire:
Code : Tout sélectionner
SetGadgetText(#Web,Url)
SetGadgetState(#Web,#PB_Web_Refresh)En plus, ça fait toujours deux chargement, une par le cache et une actualisée.
Avec cet API, ça fonctionne très bien, un seul chargement:
Code : Tout sélectionner
DeleteUrlCacheEntry_(Url)
SetGadgetText(#Web,Url)Merci pour ce joli code
Ces codes sont excellents nico
Slt Nico, tu fais du trés bon boulot.... Continue comme ca
Merci.
Si vous souhaitez réaliser quelque chose en particulier avec un WebGadget, et que vous avez besoin d'un petit coup de main, n'hésiter pas à m'en faire la demande, j'essayrais de vous aider...
Un truc qui vient du Forum Anglais qui permet d'afficher les contrôles avec les thèmes:
http://www.purebasic.fr/english/viewtop ... 898#242898
Pour tester, il suffit de reprendre le code mettant en place l'interface IDocHostUIHandler au début de ce topic, que j'ai mis à jour dont voici les modifications:
Il y a une autre façon, c'est en utilisant:
SetGadgetAttribute(0, #PB_Web_BlockPopupMenu, 1)
Le fait de bloquer le Popup menu active les thèmes, bizzarre, non?
http://www.purebasic.fr/english/viewtop ... 898#242898
Pour tester, il suffit de reprendre le code mettant en place l'interface IDocHostUIHandler au début de ce topic, que j'ai mis à jour dont voici les modifications:
Code : Tout sélectionner
#DOCHOSTUIFLAG_THEME = $40000
Structure DOCHOSTUIINFO
cbSize.l
dwFlags.l
dwDoubleClick.l
*pchHostCss.l
*pchHostNS.l
EndStructure
Procedure GetHostInfo(*THIS.IDocHost, *pInfo.DOCHOSTUIINFO)
*pInfo\dwFlags = *pInfo\dwFlags | #DOCHOSTUIFLAG_THEME
ProcedureReturn #S_OK
EndProcedureIl y a une autre façon, c'est en utilisant:
SetGadgetAttribute(0, #PB_Web_BlockPopupMenu, 1)
Le fait de bloquer le Popup menu active les thèmes, bizzarre, non?