Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Utility to capture statusbar messages from IE

  • Filter
  • Time
  • Show
Clear All
new posts

  • Utility to capture statusbar messages from IE

    Having received much help from various people, and having stitched together the code from many posters, I offer this humble (read: "sparse") utility.

    First the .RC

    //To compile the PBR, remove the comment slashes from the following line
    #include "resource.h"
    FILEVERSION       0,0,0,1
    PRODUCTVERSION    1,0,0,0
    FILEFLAGS          0x0
    FILEOS            VOS__WINDOWS32
    //FILETYPE           VFT_DLL
    FILETYPE          VFT_APP
        BLOCK "StringFileInfo"
            BLOCK "040904E4"    //US English, Multilingual
    //        BLOCK "040904B0"      //US English, Unicode
                VALUE "CompanyName",      "PB Support Forum Community\0"
                VALUE "FileDescription",  "IEStatusbar Reader\0"
                VALUE "FileVersion",      "\0"
                VALUE "InternalName",     "IEStatusbarReader\0"
                VALUE "LegalCopyright",   "\0"
    //            VALUE "LegalTrademarks1", " "
    //            VALUE "LegalTrademarks2", " "
                VALUE "OriginalFilename", "IEStatusbar Reader.exe\0"
                VALUE "ProductName",      "IEStatusbar Reader\0"
                VALUE "ProductVersion",   "1.0\0"
                VALUE "Comment",          "a group effort\0"
        BLOCK "VarFileInfo"
            VALUE "Translation", 0x409, 0x4E4   //US English, Multilingual
    ICON1 ICON sbar.ICO
    You can create your own icon, or use the one attached to this message.

    Since I'm going to be attaching the .ICO, I'll also attach the .PBR and the .BAS... (the .RC won't attach, says it's an invalid file...)

    But for the record, here's the code of the app, sprinkled with many text sections where I documented the development of one or another aspect of a can clean it up as you see fit.

    It isn't perfect, but it's OK for what I needed. Have fun!!!

    Many thanks to all who provided all kinds of input and support!


    'IEStatusbar Reader.bas
    'Using as the base code: Jose Roca's EnumIEChildren.bas from:
    'I'm trying to add Pierre Bellisle's listbox code from:
    'I'm adding a few small features to make it more useable. (eg, write to file, copy to clipboard, etc.)
    '- Process commandline params for: "confirm prompts", alternate filename, other???
    '- Provide visual confirmation that button actions have completed...(flash the button??)
    '- Maybe someday, provide options to sort the save file, and maybe eliminate duplicate lines...???
    '1. By default, "Confirm prompts" is OFF
    '2. A SB message that is longer than the first part of the SB might not fully display the rightmost chars;
    '     BUT as long as the text is not "physically" truncated by the webpage, we will get the whole text.
    '3. If the SB message text has been truncated by the webpage, we cannot obtain the truncated portion.
    '     Well, maybe we could search the HTML, but that's beyond the scope at this time...
    '1. Start IE
    '2. Start this program (IEStatusbar Reader)
    '3. Bring IE to the forefront
    '   (IEStatusbar Reader will operate even if it isn't visible. Or you could leave it open over IE and watch it work...)
    '4. Move mouse pointer over hyperlinks. If the hyperlink causes a message to be displayed in the Statusbar, it will be captured.
    '     (See Notes 2 and 3 above.)
    '5. Click on buttons to either Write all captured messages to a file, or to copy the current text line to the clipboard.
    '   Alternatively, copy a text line to the clipboard by double-clicking it.
    '   Single-click on a text line and the Copy to Clipboard button becomes the default, ready for keypress of Enter.
    '   The filename is automatically generated: the ISO date (YYYYMMDD), the time (digits only), and the app name, .LOG
    '       It is stored in the same directory in which the .EXE resides.
    '6. IEStatusbar Reader will remain open even if IE is closed, so that captured texts can be saved.
    '      If another IE is opened, you may need to re-establish a connection. A button will show up for this purpose.
    '7. If you switch to another Tab or browser, IEStatusbar Reader will also switch to that active frame.
    ' ########################################################################################
    ' This example finds the handle of a running instance of Internet Explorer, enumerates
    ' its child windows to find the handle of the status bar and retrieves the text - Jose Roca
    ' ########################################################################################
    ' This works even when the status bar is turned off in the View menu.
    #Compile Exe  "c:\tools\IEStatusbarReader.exe"
    #Dim All
    #Include ""
    #Include ""
    #Resource "StatusbarReader.pbr"
    %LISTBOX                = 101
    %CMD_CopyToClipboard    = 102
    %CMD_WriteToFile        = 103
    %CMD_Quit               = 104
    %CMD_ReconnectToIE      = 105
    Global hDlg       As Dword '
    Global ThreadKill As Long
    Global hList      As Dword
    Global gConfirm   As Long  'to enable confirmation prompting, we need to set this somewhere...
    ' ===============================================
    Function PBDateToISO (ByVal PBDate As String) As String
       'PB dates are always in this order: mm dd yy(yy)
       'We want yyyy-mm-dd
       Local PBDelims, tmpDate, SavedDelim, YYYY, MM, DD As String
       PBDelims = "-/"
    '   SavedDelim = "-"  'default to hyphen
       tmpDate = PBDate
       If tmpDate = "" Then tmpDate = Date$
       SavedDelim = Mid$(tmpDate, InStr(tmpDate, Any PBDelims), 1)
       MM = Extract$(tmpDate, Any PBDelims)
       If Len(MM) = 1 Then MM = "0" & MM
       tmpDate = Remain$(Trim$(tmpDate, Any PBDelims), Any PBDelims)
       DD = Extract$(tmpDate, Any PBDelims)
       If Len (DD) = 1 Then DD = "0" & DD
       YYYY = Remain$(Trim$(tmpDate, Any PBDelims), Any PBDelims)
       If Len(YYYY) < 4 Then YYYY = String$(4-Len(YYYY), "0") & YYYY
       Function = YYYY & SavedDelim & MM & SavedDelim & DD
    End Function
    ' ===============================================
    Function OpenFil (ByVal Fil As String, ByVal FileMode As String, ByVal ErrCode As Long) As Long
       'Valid mode strings can be one of: U O A B R
       'Returns the buffer Number, so the caller can close the file when done.
       'If error, returns 0, with ErrorCode going back in param3
       Dim Buf As Local Long
       Buf = FreeFile
       On Error Resume Next
       Select Case UCase$(Left$(FileMode, 1))
       Case "U" 'Seq Input
          Open Fil$ For Input As Buf
       Case "O" 'Seq Output
          Open Fil$ For Output As Buf
       Case "A" 'Seq Append
          Open Fil$ For Append As Buf
       Case "B" 'Binary
          Open Fil$ For Binary As Buf
       Case "R" 'Random
          Open Fil$ For Random As Buf
       End Select
       'Run-time errors to check for:
       ' 53 = "File not found"; 70 = "Permission denied"; 75 = "Path/file access error"
       ErrCode = Err
       If ErrCode = 53 Or ErrCode = 70 Or ErrCode = 75 Then 'check for others?
          Function = 0
          Exit Function
       End If
       On Error GoTo 0  'reset runtime error checking
       Function = Buf
    End Function
    ' ========================================================================================
    Sub Clipboard_SetText(ByVal Txt As String)
    'swiped from POFFS postings under Windows Compiler (Scott Turchin Mar16, 99) also Mike Trader Apr 5, 06
       Local lpMem As Asciiz Ptr
       Local hMem  As Dword
       ' Allocate global memory block
       hMem  = GlobalAlloc(%GHND, Len(Txt) + 1)
       lpMem = GlobalLock(hMem)
       ' copy text into memory object
       @lpMem = Txt
       ' unlock the memory object
       GlobalUnlock hMem
       'Open and Empty clipboard:
       OpenClipboard 0
       ' add text to the clipboard
       SetClipboardData %cf_text, hMem
    End Sub
    ' ========================================================================================
    ' EnumChildWindows - from Jose Roca
    ' ========================================================================================
    Function EnumChildProc(ByVal hwnd As Dword, ByVal lParam As Dword Ptr) As Long
       Local szClassName As Asciiz * %MAX_PATH
       GetClassName (hwnd, szClassName, %MAX_PATH)
       If szClassName = "msctls_statusbar32" Then
          If lParam <> %NULL Then @lParam = hWnd
          Function = %FALSE
          Function = %TRUE
       End If
    End Function
    ' ========================================================================================
    Function FindIEStatusBarText(ByVal hDlg As Dword) As Dword  ' mostly from Jose, some from Pierre, some my own
       'for Jose's code:
       Local hWndExplorer As Dword                   ' // Internet Explorer handle
       Local hStatusbar As Dword                     ' // Status bar handle
       Local hProc As Dword                          ' // Process handle
       Local dwProcID As Dword                       ' // Process identifier
       Local pMem As Dword                           ' // Virtual memory address
       Local nLen As Long                            ' // Text length
       Local buffer As String                        ' // General purpose string buffer
       Local dwResult As Dword                       ' // Result code
       Local cbRead As Dword                         ' // Bytes read
       'for my code:
       Local AppTitle As String
       AppTitle = "Statusbar Reader"
       Local msg As String, retval As Long
       'for Pierre's Listbox:
       Local ListboxCount  As Long
       Local sBuffer       As String
       Local sOldBuffer    As String
    'In case IE gets closed while we're running, this loop detects whether IE is or isn't running, and
    '  either reconnects or enables the Reconnect button if necessary...
    'This also permits switching to whichever is the active of multiple Tabs or browsers,
    '  while preserving any text lines previously collected.
       ' Find the window handle of a running instance of Internet Explorer
       hWndExplorer = FindWindow("IEFrame", ByVal %NULL)
       If IsFalse hWndExplorer Then
          ? "Internet Explorer isn't running",, "StatusBar Reader"
          Control Enable hDlg, %CMD_ReconnectToIE      'enable the Reconnect button and make it visible...
          Control Send hDlg, %CMD_ReconnectToIE, %WM_UPDATEUISTATE, MakLng(%UIS_CLEAR, %UISF_HIDEFOCUS Or %UISF_HIDEACCEL), 0
          Control Send hDlg, %CMD_CopyToClipboard, %WM_UPDATEUISTATE, MakLng(%UIS_CLEAR, %UISF_HIDEFOCUS Or %UISF_HIDEACCEL), 0
          Control Send hDlg, %CMD_WriteToFile, %WM_UPDATEUISTATE, MakLng(%UIS_CLEAR, %UISF_HIDEFOCUS Or %UISF_HIDEACCEL), 0
          Exit Function
       End If
       Control Disable hDlg, %CMD_ReconnectToIE
       ' Enumerate its child windows
       EnumChildWindows hWndExplorer, CodePtr(EnumChildProc), VarPtr(hStatusbar)
       If hStatusbar Then
          ' Retrieve text length of the first SB part (0 based)   ("first part" refers to leftmost SB section, if divided)
          dwResult = SendMessage (hStatusBar, %SB_GETTEXTLENGTH, 0, 0) 'any way to get the whole thing? retrieve all parts
          nLen = Lo(Word, dwResult)
          ' Allocate a string buffer
          buffer = Space$((nLen + 1))
          ' Retrieve the process identifier
          GetWindowThreadProcessID(hStatusBar, dwProcID)
          ' Retrieve the process handle
          ' Note For Windows Vista it should be:
          ' hProc = OpenProcess(%STANDARD_RIGHTS_REQUIRED OR %SYNCHRONIZE OR &HFFFF, 0, dwProcID)
          hProc = OpenProcess(%STANDARD_RIGHTS_REQUIRED Or %SYNCHRONIZE Or &H0FFF, 0, dwProcID)
          ' Allocate memory
          pMem = VirtualAllocEx(hProc, ByVal %NULL, Len(buffer), %MEM_COMMIT, %PAGE_READWRITE)
          ' Retrieve the text
          dwResult = SendMessage(hStatusBar, %SB_GETTEXT, 0, pMem)
          ' Read process memory
          ReadProcessMemory(hProc, pMem, ByVal StrPtr(buffer), Len(buffer), cbRead)
          ' Remove the ending null character
          If cbRead Then buffer = Left$(buffer, cbRead - 1)
          ' Release memory
          dwResult = VirtualFreeEx(hProc, ByVal pMem, 0, %MEM_RELEASE)
          ' Close process handle
          If hProc Then CloseHandle hProc
          ' Display the string
          If Len(Trim$(buffer, Any $Spc & Chr$(0))) > 0 Then  'how is it that we are still getting some blank lines????
             sBuffer = buffer  'to make the transition from Jose's code to Pierre's
                               ' (not sure if Jose was using buffer for multiple purposes...)
             'If this message is NOT the same as the last message, then insert the content of buffer into the listbox
             If sBuffer <> sOldBuffer Then               'Is it different from previous message
                ListboxCount = SendMessage(hList, %LB_GETCOUNT,  0, 0) 'Ask listbox for items count
                SendMessage(hList, %LB_ADDSTRING, ListboxCount, StrPtr(sBuffer)) 'Add message to listbox
                SendMessage hList, %LB_SETCURSEL, ListboxCount, 0 'Go to last listbox position
             End If
             sOldBuffer = sBuffer                        'Backup sBuffer to avoid sending same message
          End If
          Sleep 25  'needed??   Yes, indeed!! else LOTS of messages are missed!
          MsgBox "No statusbar found.",,AppTitle
          Exit Function
       End If
    End Function
    ' ========================================================================================
    ' Callback functions
    ' ========================================================================================
    CallBack Function DlgProc() As Long
     Static hThread  As Dword
     Local  sBuffer  As String
     Local  Retval   As Long
     If ThreadKill = 1 Then Thread Close hThread To Retval
     Select Case CbMsg
       Case %wm_initdialog
         hList = GetDlgItem(CbHndl, %LISTBOX)                   'Get listbox handle
         sBuffer = "Waiting for ie statusbar message"           'Prepare message
         SendMessage(hList, %LB_ADDSTRING, 0, StrPtr(sBuffer))  'Send message to listbox
         Thread Create FindIEStatusBarText(CbHndl) To hThread   'Create a thread that will loop
         Thread Close hThread To Retval                         'Release the thread handle
        Case %wm_command
          'improvements, from Dave Biggs:
          If Cb.Ctl = %LISTBOX Then ' Check which control. Maybe you'll add a second listbox one day ;)
            If Cb.CtlMsg = %lbn_selchange Then
              Control Set Focus hDlg, %CMD_CopyToClipboard    'Put focus onto button, ready for Space bar or Enter activation
            End If
            If Cb.CtlMsg = %lbn_dblclk Then  'but if double clicked, do it immediately!
              Control Send Cb.Hndl, %CMD_CopyToClipboard, %BM_CLICK, 0, 0
            End If
          End If
          ' Take advantage of a default dialog behaviour - %IDOK, %Bn_Clicked is sent to a dialog when Enter is pressed
          If Cb.Ctl = %idok And Cb.CtlMsg = %bn_clicked Then  'Enter Key has been pressed. Where is the focus?
            If GetFocus = GetDlgItem(Cb.Hndl, %LISTBOX) Or GetFocus = GetDlgItem(Cb.Hndl, %CMD_CopyToClipboard) Then
              ' focus is on the listbox or the clipboard button so simulate a click
              Control  Send Cb.Hndl, %CMD_CopyToClipboard, %BM_CLICK, 0, 0
              ' doesn't actually 'move' the button but the notification msg is sent as if it had been
            End If
          End If
          If Cb.Ctl = %CMD_ReconnectToIE And Cb.CtlMsg = %bn_clicked Then
             'start thread
             Thread Create FindIEStatusBarText(CbHndl) To hThread   'Create a thread that will loop
             Thread Close hThread To Retval                         'Release the thread handle
          End If
       Case %wm_destroy
        ThreadKill = 1      'Tell the thread to end
        'I think this only had meaning in Pierre's original code... does nothing here? (test by commenting out)
     End Select
    End Function
    ' ========================================================================================
    CallBack Function CB_WriteToFile() As Long
       Local lResult, OutBuf, ListboxCount, i, ItemLength, ErrorCode As Long
       Local LogFile, sBuf As String
       Local msg As String, retval As Long
       If Cb.Msg = %wm_command And Cb.CtlMsg = %bn_clicked Then
          ListboxCount = SendMessage(hList, %LB_GETCOUNT,  0, 0) 'Get listbox item count
          If gConfirm Then
             lResult = MsgBox ("Dump " & Trim$(Str$(ListboxCount)) & " lines of text from the listbox to a file?",%mb_yesno,"Confirm File Write")
             If lResult <> %idyes Then Exit Function
          End If
          'create a target filename and open it
          LogFile = Remove$(PBDateToISO (Date$), Any "-/") & " " & Remove$(Time$, Any ".:")& " IEStatusbar Reader" & ".log"
          OutBuf = OpenFil(LogFile, "OUTPUT", ErrorCode) 'Opens file for Sequential Output
          If OutBuf = 0 Then
             MsgBox "Could not open logfile.",,"Logfile error:" & Str$(ErrorCode)
             Function = 1
             Exit Function
          End If
          For i = 0 To ListboxCount -1 'adjust for 0-based index
             ItemLength = SendMessage(hList, %LB_GETTEXTLEN, i, 0) 'get the length of the current item
             sBuf = Space$((ItemLength + 1))
             SendMessage(hList, %LB_GETTEXT, i, StrPtr(sBuf)) 'retrieve item's text
             Print #OutBuf, Trim$(sBuf, Any $Spc & Chr$(0))   'output a clean string; no we're not truncating it
          Next i
          Close #OutBuf
          'notify user that the write is done:
          Sleep 600  'perceptible pause for the user to grasp that the write to disk has occurred...
          '- change the text on the write button to flash "Done!" (would need to reset it later) (Or, in our own statusbar!)
          MessageBeep (%mb_iconasterisk)    'make a noise to indicate "OK, Done."
          Function = 1 'tells parent dialog that the event message needs no further processing...
       End If
    End Function
    CallBack Function CB_CopyToClipboard() As Long
       'we only copy the current line (want more? WriteToFile, then do your own cut&paste)
       Local CurrentItem, ItemLength As Long
       Local sBuf As String
       If Cb.Msg = %wm_command And Cb.CtlMsg = %bn_clicked Then
          CurrentItem = SendMessage(hList, %LB_GETCURSEL,  0, 0) 'Get 0-based index of current listbox item
          ItemLength = SendMessage(hList, %LB_GETTEXTLEN, CurrentItem, 0) 'get the length of the current item
          sBuf = Space$((ItemLength + 1)) 'create a buffer
          SendMessage(hList, %LB_GETTEXT, CurrentItem, StrPtr(sBuf)) 'retrieve item's text
          sBuf = Trim$(sBuf, Any $Spc & Chr$(0)) 'clean up the text
          Clipboard_SetText(sBuf & $CrLf)        'copy sBuf to the clipboard
          MessageBeep (%mb_iconexclamation)      'make a (similar but different) noise to indicate "OK, Done."
          Function = 1 'needs no further processing
       End If
    End Function
    CallBack Function CB_Quit() As Long
       Local lResult As Long
       If Cb.Msg = %wm_command And CbCtlMsg = %bn_clicked Then
          If gConfirm Then
             lResult = MsgBox ("Are you sure?",%mb_yesno,"Quit?")
             If lResult = %idno Then Exit Function
          End If
          Dialog End Cb.Hndl, 0 ' Return 0
          Function = 1
       End If
    End Function
    ' ========================================================================================
    ' Main
    ' ========================================================================================
    Function PBMain () As Long
       Local Result As Long
       Local Cmd As String
       'check commandline; parse for alternative filespec, and for Confirm switch
       'Cmd$ = parse$(command$)
       'IF ... THEN
       '   gConfirm = %TRUE
       Dialog New %HWND_DESKTOP, "Read IE StatusBar", , , 500, 275, _
          %ws_caption Or %ws_minimizebox Or %ws_sysmenu, 0 To hDlg
       'create buttons in the desired z-order:
       Control Add ListBox, hDlg, %LISTBOX, , 5, 5, 490, 240, _
          %ws_child Or %ws_visible Or %ws_tabstop Or %ws_vscroll, %ws_ex_clientedge
       Control Add Button, hDlg, %CMD_ReconnectToIE, "&Reconnect to IE", 173, 248, 64, 18, %ws_tabstop ''Call CB_ReconnectToIE
       Control Disable hDlg, %CMD_ReconnectToIE  'disable it in order to make it not visible...
       Control Add Button, hDlg, %CMD_CopyToClipboard, "&Copy current line to Clipboard", 249, 248, 105, 18, %ws_tabstop Call CB_CopyToClipboard
       Control Send hDlg, %CMD_CopyToClipboard, %WM_UPDATEUISTATE, MakLng(%UIS_CLEAR, %UISF_HIDEFOCUS Or %UISF_HIDEACCEL), 0 'per Dave Biggs
       Control Add Button, hDlg, %CMD_WriteToFile, "&Write all lines to File", 366, 248, 75, 18, %ws_tabstop Call CB_WriteToFile
       Control Send hDlg, %CMD_WriteToFile, %WM_UPDATEUISTATE, MakLng(%UIS_CLEAR, %UISF_HIDEFOCUS Or %UISF_HIDEACCEL), 0 'per Dave Biggs
       Control Add Button, hDlg, %CMD_Quit, "&Quit", 453, 248, 35, 18, %ws_tabstop Call CB_Quit
       Control Send hDlg, %CMD_Quit, %WM_UPDATEUISTATE, MakLng(%UIS_CLEAR, %UISF_HIDEFOCUS Or %UISF_HIDEACCEL), 0 'per Dave Biggs
       Dialog Set Icon hDlg, "ICON1"
       Dialog Show Modal hDlg, Call DlgProc To Result
    End Function
    Attached Files