Hello:
is it possible to open a webpage and filling some fields (like username and password etc.....) automatically using PB?
also is it possible to emulate cliking on buttons to go to another page?
Thanks
opening a webpage and filling fields, possible?
Re: opening a webpage and filling fields, possible?
This is a crude example based on IHTMLWindow2 (see http://msdn.microsoft.com/en-us/library ... 85%29.aspx) and suitable for an embedded window inside your application.
It would require a lot of work to make it robust, but it can get you started.
Basically you use javascript exactly as you would do in a normal html page.
To click a button, just move around using #VK_DOWN etc and then press #VK_RETURN.
BTW I selected the objects by name, but you can do by ID also, if they are specified in the source ...
It would require a lot of work to make it robust, but it can get you started.
Basically you use javascript exactly as you would do in a normal html page.
To click a button, just move around using #VK_DOWN etc and then press #VK_RETURN.
Code: Select all
Enumeration ; windows
#WIN_MAIN
EndEnumeration
Enumeration ; gadgets
#WEB_MAIN
EndEnumeration
#PUSH_CTRL = 0
#PUSH_ALT = 1
#PUSH_SHIFT = 2
#URL_BASE$ = "http://www.purebasic.com"
#URL_START$ = #URL_BASE$ + "/securedownload/Login.php?language="
DataSection
IID_IHTMLDocument: ; {626FC520-A41E-11CF-A731-00A0C9082637}
Data.l $626FC520
Data.w $A41E, $11CF
Data.b $A7, $31, $00, $A0, $C9, $08, $26, $37
IID_IHTMLDocument2: ; {332C4425-26CB-11D0-B483-00C04FD90119}
Data.l $332C4425
Data.w $26CB, $11D0
Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
IID_IHTMLDocument3: ; {3050F485-98B5-11CF-BB82-00AA00BDCE0B}
Data.l $3050F485
Data.w $98B5,$11CF
Data.b $BB,$82,$00,$AA,$00,$BD,$CE,$0B
IID_IHTMLDocument4: ; {3050F69A-98B5-11CF-BB82-00AA00BDCE0B}
Data.l $3050F69A
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLDocument5: ; {3050F80C-98B5-11CF-BB82-00AA00BDCE0B}
Data.l $3050F80C
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
IID_IHTMLElement: ; {3050F1FF-98B5-11CF-BB82-00AA00BDCE0B}
Data.l $3050F1FF
Data.w $98B5, $11CF
Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
EndDataSection
Macro KEY_DOWN (iKey)
keybd_event_ (iKey, 0, 0, 0)
EndMacro
Macro KEY_UP (iKey)
keybd_event_(iKey, 0, #KEYEVENTF_KEYUP, 0)
EndMacro
Procedure.i WebGadget_GetHTMLDocument2 (nGadget)
Protected oBrowser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(nGadget), #GWL_USERDATA)
Protected oDocumentDispatch.IDispatch
Protected oHTMLDocument.IHTMLDocument2
Protected iBusy
Repeat
While WindowEvent(): Delay(0): Wend
oBrowser\get_Busy(@iBusy): Delay(10)
Until iBusy = #VARIANT_FALSE
If oBrowser
If oBrowser\get_document(@oDocumentDispatch) = #S_OK
If oDocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @oHTMLDocument) = #S_OK
oDocumentDispatch\Release()
EndIf
EndIf
EndIf
ProcedureReturn oHTMLDocument
EndProcedure
Procedure.i WebGadget_GetHTMLDocumentParent (nGadget)
Protected oHTMLDocument.IHTMLDocument2 = WebGadget_GetHTMLDocument2 (nGadget)
Protected oWindow.IHTMLWindow2
If oHTMLDocument
oHTMLDocument\get_parentWindow(@oWindow)
EndIf
oHTMLDocument\Release()
ProcedureReturn oWindow
EndProcedure
Procedure WebGadget_SetFocus (nGadget)
Protected oWindow.IHTMLWindow2 = WebGadget_GetHTMLDocumentParent (nGadget)
If oWindow
oWindow\focus()
oWindow\Release()
EndIf
EndProcedure
Procedure WebGadget_ExecScript (nGadget, sScriptCode.s, sScriptLanguage.s = "JavaScript")
Protected oWindow.IHTMLWindow2 = WebGadget_GetHTMLDocumentParent (nGadget)
Protected tVariant.VARIANT
If oWindow
oWindow\execScript (sScriptCode, sScriptLanguage, @tVariant)
oWindow\Release()
EndIf
EndProcedure
Procedure WebGadget_SetFocusByName (nGadget, sFieldName.s)
Protected sScript.s
sScript = "var elements = document.getElementsByName('"+ sFieldName + "');"
sScript + "for (var i = 0; i < elements.length; ++i)"
sScript + "{"
sScript + "if (elements[i].tagName.toLowerCase() == 'input')"
sScript + "{"
sScript + "elements[i].focus();"
sScript + "break;"
sScript + "}"
sScript + "}"
WebGadget_ExecScript (nGadget, sScript)
EndProcedure
Procedure PushKey (iKey, iMod = 0)
If iMod & #PUSH_CTRL
KEY_DOWN (#VK_CONTROL)
EndIf
If iMod & #PUSH_SHIFT
KEY_DOWN (#VK_SHIFT)
EndIf
If iMod & #PUSH_ALT
KEY_DOWN (#VK_MENU)
EndIf
If iKey
KEY_DOWN (iKey)
KEY_UP (iKey)
EndIf
If iMod & #PUSH_ALT
KEY_UP (#VK_MENU)
EndIf
If iMod & #PUSH_SHIFT
KEY_UP (#VK_SHIFT)
EndIf
If iMod & #PUSH_CTRL
KEY_UP (#VK_CONTROL)
EndIf
EndProcedure
Procedure Main()
Protected iRetVal, iEvent, iStepCount
Protected sUrl.s
iRetVal = OpenWindow(#WIN_MAIN, 10, 10, 800, 600, "WebRobot")
iRetVal = WebGadget(#WEB_MAIN, 5, 5, 790, 550, #URL_START$)
Repeat
iEvent = WaitWindowEvent()
Select iEvent
Case #PB_Event_Gadget
Select EventGadget()
Case #WEB_MAIN
Select EventType()
Case #PB_EventType_DownloadEnd
iStepCount + 1
Select iStepCount
Case 1:
WebGadget_SetFocus(#WEB_MAIN)
WebGadget_SetFocusByName(#WEB_MAIN, "Login")
PushKey(#VK_U)
PushKey(#VK_S)
PushKey(#VK_E)
PushKey(#VK_R)
WebGadget_SetFocusByName(#WEB_MAIN, "Password")
PushKey(#VK_P)
PushKey(#VK_A)
PushKey(#VK_S)
PushKey(#VK_S)
PushKey(#VK_RETURN)
Case 2:
Debug "Ended."
EndSelect
EndSelect
EndSelect
EndSelect
Until iEvent = #PB_Event_CloseWindow
EndProcedure
Main()
"Have you tried turning it off and on again ?"
A little PureBasic review
A little PureBasic review
-
Kwai chang caine
- Always Here
- Posts: 5494
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: opening a webpage and filling fields, possible?
Very interesting code LUIS
Thanks a lot to sharing
Thanks a lot to sharing
The happiness is a road...Not a destination
Re: opening a webpage and filling fields, possible?
Thank you very much LUIS 
Grazie
Grazie
Re: opening a webpage and filling fields, possible?
Yeah, great example! Thank you Luis!
-
MachineCode
- Addict
- Posts: 1482
- Joined: Tue Feb 22, 2011 1:16 pm
Re: opening a webpage and filling fields, possible?
Nice example, but how do we make it work with any web site? I'd like to send an update to my Facebook status, for instance.
Microsoft Visual Basic only lasted 7 short years: 1991 to 1998.
PureBasic: Born in 1998 and still going strong to this very day!
PureBasic: Born in 1998 and still going strong to this very day!
Re: opening a webpage and filling fields, possible?
here is one of my codes March 7, 2008
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