http://www.powerbasic.com/support/pb...ad.php?t=38758
First the .RC
Code:
//'StatusbarReader.rc
//To compile the PBR, remove the comment slashes from the following line
#include "resource.h"
VS_VERSION_INFO VERSIONINFO
FILEVERSION 0,0,0,1
PRODUCTVERSION 1,0,0,0
FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
//FILEFLAGS (VER_PRIVATEBUILD|VER_PRERELEASE|VER_DEBUG)
FILEFLAGS 0x0
FILEOS VOS__WINDOWS32
//FILETYPE VFT_DLL
FILETYPE VFT_APP
FILESUBTYPE VFT2_UNKNOWN
BEGIN
BLOCK "StringFileInfo"
BEGIN
BLOCK "040904E4" //US English, Multilingual
// BLOCK "040904B0" //US English, Unicode
BEGIN
VALUE "CompanyName", "PB Support Forum Community\0"
VALUE "FileDescription", "IEStatusbar Reader\0"
VALUE "FileVersion", "0.0.0.1\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"
END
END
BLOCK "VarFileInfo"
BEGIN
VALUE "Translation", 0x409, 0x4E4 //US English, Multilingual
END
END
ICON1 ICON sbar.ICO
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 problem...you 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!
-John
Code:
'IEStatusbar Reader.bas
'
'Using as the base code: Jose Roca's EnumIEChildren.bas from:
'http://www.powerbasic.com/support/pbforums/showpost.php?p=298086&postcount=6
'
'I'm trying to add Pierre Bellisle's listbox code from:
'http://www.powerbasic.com/support/pbforums/showpost.php?p=280811&postcount=12
'
'I'm adding a few small features to make it more useable. (eg, write to file, copy to clipboard, etc.)
'===========================================================================
'ToDo:
'- 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...???
'NOTES:
'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...
'USE:
'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 "win32api.inc"
#Include "commctrl.inc"
#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)
'THIS CAUSES A GPF IN 32 BIT!
' copy text into memory object
@lpMem = Txt
' unlock the memory object
GlobalUnlock hMem
'Open and Empty clipboard:
OpenClipboard 0
EmptyClipboard
' add text to the clipboard
SetClipboardData %cf_text, hMem
CloseClipboard
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
Else
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.
Do
' 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
Control Send hDlg, %CMD_Quit, %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!
Else
MsgBox "No statusbar found.",,AppTitle
Exit Function
End If
Loop
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
'ZCZC
'----------
'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