PureBasic

Code : Tout sélectionner

; ************************************************
; 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
          *value = AllocateMemory(#MAX_PATH *2 + 2)
          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) 
  StickyWindow(0,1)
  CoInitialize_(0);
  hdll = OpenLibrary(0, "Oleacc.dll")
  EditorGadget(1, 1, 30, 480, 80)
  ButtonGadget(2,1,1,100,25,"Sniff !")
  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