Code: Select all
;----------------------------------------------------------------------------------
; 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.purebasic.fr/english/ucp.php?mode=login"
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.purebasic.fr/english/ucp.php?mode=login" )
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
