PureBasic Forums - English

Code: Select all

; Code          : Read Browser URL (IE, Firefox) 
; Author(s)     : Sparkie, netmaestro 
; Other credits : PB, rsts 
; Rel Date      : December 21, 2006 7:41 PM 
; Update        : July 26, 2008 10:49 AM
;                 -fix for Firefox 3
; Target OS     : Windows only 
; Target PB     : 4.x 
;...Code converted from VB to PB 
;...Feel free to clean it up and use as you wish. 
; ************************************************ 

;################
; Constants 
;################
#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

;################
; Convert to BSTR
;################
; Thanks to freak for this one
Procedure.l ASCIItoBSTR(asciiString$)
  Protected result = 0
  CompilerIf #PB_Compiler_Unicode
  result = SysAllocString_(@asciiString$)
  CompilerElse
  Protected *buff = AllocateMemory(Len(asciiString$)*2 + 2)
  If *buff
    PokeS(*buff, asciiString$, -1, #PB_Unicode)
    result = SysAllocString_(*buff)
    FreeMemory(*buff)
  EndIf
  CompilerEndIf
  ProcedureReturn result
EndProcedure 

;################
; Set Hook
;################
Procedure WinEventFunc(HookHandle.l, hEvent.l, hwnd.l, idObject.l, idChild.l, idEventThread.l, dwmsEventTime.l) 
  Protected *objectIa.IAccessible 
  Static previousUrl$ 
  Select hEvent 
    Case #EVENT_OBJECT_FOCUS, #EVENT_OBJECT_VALUECHANGE
      className$ = Space(256) 
      GetClassName_(hwnd, @className$, 256) 
      If className$ = "MozillaWindowClass" Or className$ = "Internet Explorer_Server" 
        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 = ASCIItoBSTR(Space(#MAX_PATH))
              If *objectIa\get_accValue(v, @bstr) = #S_OK 
                len = WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, 0, 0, 0, 0) 
                url$ = Space(len) 
                WideCharToMultiByte_(#CP_ACP, 0, bstr, -1, @url$, len, 0, 0)    
                If previousUrl$ <> url$ And url$ <> ""
                  AddGadgetItem(1, -1, url$) 
                  previousUrl$ = url$ 
                EndIf 
              EndIf 
            EndIf 
            *objectIa\Release() 
          EndIf 
        EndIf 
      EndIf 
  EndSelect 
EndProcedure 

;################
; Main Window 
;################
If OpenWindow(0, 0, 0, 500, 400, "Read Browser URL", #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0)) 
  CoInitialize_(0);
  hdll = OpenLibrary(0, "Oleacc.dll") 
  EditorGadget(1, 10, 15, 480, 380) 
  ;...Set event hook 
  eHook = SetWinEventHook_(#EVENT_OBJECT_FOCUS, #EVENT_OBJECT_VALUECHANGE, #Null, @WinEventFunc(), 0, 0, #WINEVENT_OUTOFCONTEXT | #WINEVENT_SKIPOWNPROCESS) 
  Repeat 
    event = WaitWindowEvent() 
  Until event = #PB_Event_CloseWindow 
  ;...Cleanup
  CoUninitialize_()
  If eHook 
    UnhookWinEvent_(eHook) 
  EndIf 
  If hdll 
    CloseLibrary(0) 
  EndIf 
EndIf 
End