Re: Get browser URL
Posted: Mon Dec 28, 2020 8:06 pm
Not sure if this is will help, but I used it in another project, and it works quite well: https://github.com/balta2ar/brotab
http://www.purebasic.com
https://www.purebasic.fr/english/
Code: Select all
the *objectIa\get_accRole(v, @v) = #S_OK
Code: Select all
Hey dudes And RASHAD.
I'm opening that topic again to know if you have understand how to correct the "invalid access memory" for [code]the *objectIa\get_accRole(v, @v) = #S_OK
Code: Select all
#CHILDID_SELF = 0
#WINEVENT_OUTOFCONTEXT = 0
#WINEVENT_SKIPOWNPROCESS = $2
#EVENT_OBJECT_FOCUS = $8005
#EVENT_OBJECT_VALUECHANGE = $800E
#ROLE_SYSTEM_DOCUMENT = $F
#ROLE_SYSTEM_PANE = $10
#ROLE_SYSTEM_TEXT = $2A
Enumeration
#Wnd
#POPM
#SystrayI
;font
#F9
#F12
#F14
#LISTV
#TextFooter
;Timer
#T
EndEnumeration
Declare OpenWnd()
Declare TextColorGadget(GadgetID,x,y,l,h,message.s, FrontColor, BackColor, The_font, alignement = #SS_CENTER)
Declare.s CatchDate()
Declare GetProcessPidByName(sfilename.s)
Global v$ = " v7.1", Fichier$
Global Lwin, Hwin, Lbt, Hbt, BT_BackCol, BT_TextCol, BT_HoverCol, BT_OutlineCol, MenuFont
Global.b marge = 5
; *** MODIFIER LA TAILLE DE LA FENETRE ICI
Lwin = 650
Hwin = 620
; *****************************************
LoadFont(#F14, "Segoe UI", 14, #PB_Font_HighQuality)
LoadFont(#F12, "Segoe UI", 12, #PB_Font_HighQuality)
LoadFont(#F9, "Segoe UI", 9, #PB_Font_HighQuality)
; WEB URI HOOK
Procedure WinEventFunc(HookHandle.l, hEvent.l, hwnd.l, idObject.l, idChild.l, idEventThread.l, dwmsEventTime.l)
;RASHAD
Protected *objectIa.IAccessible, a.i=0, b.i=0, c.i=0, d.i=0, e.i=0, f.i=0, g.i=0, h.i=0, i.i=0, j.i=0
Static previousUrl$
Select hEvent
Case #EVENT_OBJECT_FOCUS, #EVENT_OBJECT_VALUECHANGE
className$ = Space(#MAX_PATH)
GetClassName_(hwnd, @className$, #MAX_PATH)
If className$ = "MozillaWindowClass" Or className$ = "Internet Explorer_Server" Or className$ = "IEFrame" Or className$ = "OperaWindowClass" Or className$ = "Chrome_WidgetWin_1" ; Ajout Opera et Chrome
If CallFunction(0, "AccessibleObjectFromEvent", hwnd, idObject, idChild, @*objectIa, @v.VARIANT) = #S_OK
v.VARIANT\vt = #VT_I4
v\lVal = #CHILDID_SELF
If *objectIa\get_accRole(v, @v) = #S_OK
If v\lVal = #ROLE_SYSTEM_PANE Or v\lVal = #ROLE_SYSTEM_DOCUMENT Or v\lVal = #ROLE_SYSTEM_TEXT
v\vt = #VT_I4
v\lVal = #CHILDID_SELF
url$ = Space(#MAX_PATH)
bstr = @url$
If *objectIa\get_accValue(v, @bstr) = #S_OK
url$ = PeekS(bstr, -1, #PB_Unicode)
If previousUrl$ <> url$ And url$ <> "" ; And Left(url$,4) = "http"
AddGadgetItem(#LISTV, -1, CatchDate() + " " + url$)
SetClipboardText(url$)
previousUrl$ = url$
EndIf
EndIf
EndIf
*objectIa\Release()
EndIf
EndIf
EndIf
Default
EndSelect
EndProcedure
; =======================================================================
;-PROCES DE BASE
Procedure.s CatchDate()
Date$ = FormatDate("%yyyy/%mm/%dd", Date())
Time$ = FormatDate("%hh:%ii:%ss", Date())
ProcedureReturn Date$ + " : "+Time$
EndProcedure
Procedure TextColorGadget(GadgetID,x,y,l,h,message.s, FrontColor, BackColor, The_font, alignement = #SS_CENTER)
If The_font = 0 : The_font = #F9 : EndIf
TextGadget(GadgetID, x, y, l, h, message.s, #SS_CENTERIMAGE|alignement)
SetGadgetColor(GadgetID, #PB_Gadget_FrontColor,FrontColor)
SetGadgetColor(GadgetID, #PB_Gadget_BackColor, BackColor)
SetGadgetFont(GadgetID, FontID(The_font))
EndProcedure
Procedure OpenWnd()
SetGadgetFont(#PB_Default, Font2)
If OpenWindow(#Wnd, Lwin, 311, LWIN, HWIN, " ", #PB_Window_BorderLess|#PB_Window_ScreenCentered)
SetWindowColor(#Wnd,$E78847)
StickyWindow(#Wnd,1)
;FENETRE SANS BORD AVEC OMBRE PORTEE
SetClassLongPtr_(WindowID(#Wnd), #GCL_STYLE, #CS_DROPSHADOW)
;-LIST VIEW
ListViewGadget(#LISTV, marge, 52, LWIN-(Marge*2), Hwin-84)
;TEXT FOOTER
TextColorGadget(#TextFooter,0,Hwin-30,Lwin,30,"Pressez CTRL + ECHAP pour quitter",RGB(255, 255, 255), $E78847, #F12)
; Init du hook
CoInitialize_(0)
hdll = OpenLibrary(0, "Oleacc.dll")
eHook = SetWinEventHook_(#EVENT_OBJECT_FOCUS, #EVENT_OBJECT_VALUECHANGE, #Null, @WinEventFunc(), 0, 0, #WINEVENT_OUTOFCONTEXT|#WINEVENT_SKIPOWNPROCESS)
;Timer PID
AddWindowTimer(#Wnd, #t, 1000)
EndIf
EndProcedure
; ---- GESTION PID ----
Procedure.i GetProcessPidByName(sfilename.s)
Protected.s name
Protected.i ishot, ipid, itool, first, inext, ifound
Protected entry.PROCESSENTRY32\dwSize = entry
sfilename = UCase(sfilename)
If OpenLibrary(0, "Kernel32.dll")
itool = GetFunction(0, "CreateToolhelp32Snapshot")
first = GetFunction(0, "Process32First")
inext = GetFunction(0, "Process32Next")
If itool And first And inext
ishot = CallFunctionFast(itool, #TH32CS_SNAPPROCESS, 0)
If ishot
ifound = CallFunctionFast(first, ishot, entry)
While ifound
name = GetFilePart(UCase(PeekS(@entry\szExeFile, -1, #PB_Ascii)))
If name = sfilename
ipid = entry\th32ProcessID
EndIf
ifound = CallFunctionFast(inext, ishot, entry)
Wend
EndIf
CloseHandle_(ishot)
EndIf
CloseLibrary(0)
EndIf
If ipid <> 0
ProcedureReturn ipid
EndIf
EndProcedure
OpenWnd()
;- // BOUCLE //
Repeat
Select WaitWindowEvent(10)
Case #PB_Event_Timer
TaskPID = GetProcessPidByName("Taskmgr.exe")
If TaskPID > 0
Debug "PID TASK MANGER : " + TaskPID ; Detection du taskmanager
EndIf
Case #WM_LBUTTONDOWN
If WindowMouseX(#Wnd) >= 0 And WindowMouseX(#Wnd) <= Lwin And WindowMouseY(#Wnd) >= 0 And WindowMouseY(#Wnd) <= Hwin
SendMessage_(WindowID(#Wnd), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
EndIf
Case #PB_Event_Gadget
;(.......)
Case #PB_Event_CloseWindow
Quit = 1
EndSelect
Until quit = 1 Or (GetAsyncKeyState_(#VK_CONTROL) & 32768) And (GetAsyncKeyState_(#VK_ESCAPE) & 32768)
CoUninitialize_()
UnhookWinEvent_(eHook)
CloseLibrary(0)