Re: IE sequencing and cookie notification popups

hi Csaba,

The answer, as you may have suspected, is to launch
_another_ script, to detect and dismiss the popups.

There is a sample script attached, which does just
that (and more). Unfortunately, it is not "pure"
script, in that it uses a number of those untrustworthy
and unreliable third-party controls (ugh!).

But, judging from your past postings, you are a clever
guy, and can convert the logic into something more
"pure". Or, since most of the api calls are relatively
straight-forward, you could use dynawrap instead of the
api toolbox.

cheers from the remote back-woods, jw

Csaba Gabor wrote:

So, how can I get rid of these pesky popups?

Thanks,
Csaba Gabor from Vienna

'<script language='VBScript'>
' wsh Intercepting (and dismissing) Cookies, jw 06Aug01
'
' --- description block --------------------------
'
' Title: wsh Intercept (and kill) Cookies...
'
' Description: sit here (all day if necessary) looking for
' "Security Alert" dialogs to pop up, and if they do
' then send a mouse click to the NO (or Yes) button...
'
' Author: jwarrington*NoSteekinSpam*@worldnet.att.net
' Website: http://home.att.net/~wshvbs/index.htm
'
' Usage: Use at you own risk, tested on win98se...
'
' --- revision history ---------------------------
' 06Aug01: original attempt...
' 08Aug01: added "Yes" and stand-by options...
' 10Aug01: added "timing constants"...
' 17Aug01: added "bring to foreground" the cookie alert window...
' 25July02: check for html-error warnings also, and dismiss...
' 24Oct02: revised to reflect IE6 cookie dialog...
' 10Apr04: accept cookies from hotmail. Er Wait. Decided not to handle this
' here. Rather, make "hotmail" a trusted site in IE.
' (otherwise, look for: "The Web site "hotmail.com" has requested to save
' a file on your computer", and accept that)...
' 14June04: revised to use genII-type api calls...
' 11July04: revised to use option buttons (looking like cmdBtns).
' As there are no option-button-click events reported, we added
' subclassing to detect (optbtn) click events...
' 10Nov04: added zone alarm alerts to the basket...
' 22Nov04: write the zone alarm alerts to win/temp file...
' --- end of description block -------------------
'
Option Explicit
'
' instantiate ActX components here...
Dim oATO : Call Instantiate(oATO, "wshAPIToolkit.ucATO", "") ' (no events)
Dim oSCO : Call Instantiate(oSCO, "wshAPIToolkit.ucSubclass", "") ' (no events)
Dim oTD : Call Instantiate (oTD, "wshAPIToolkit.ucTypedef", "") ' (no events)
Dim oNMD : Call Instantiate(oNMD, "wshLtWtNonModalDialog.ucNMD", "oNMD_")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2
'
' ------------------------------------------------
' --- API DECLARATIONS ---------------------------
' ------------------------------------------------
Dim PostMessage : Set PostMessage = oATO.DeclareAPI("USER32.DLL", "PostMessageA", "ByVal hWnd As Long", "ByVal wMsg As Long", "ByVal wParam As Long", "lParam As Any")
Dim SendMessage : Set SendMessage = oATO.DeclareAPI("USER32.DLL", "SendMessageA", "ByVal hWnd As Long", "ByVal wMsg As Long", "ByVal wParam As Long", "lParam As Any")

Dim SetWindowLong ' as object
Set SetWindowLong = oATO.DeclareAPI("USER32.DLL", "SetWindowLongA", _
"ByVal hWnd As Long", "ByVal nIndex As Long", "ByVal dwNewLong As Long")
Dim GetWindowLong ' as object
Set GetWindowLong = oATO.DeclareAPI("USER32.DLL", "GetWindowLongA", _
"ByVal hWnd As Long", "ByVal nIndex As Long")
'
Dim SetFocusAPI ' as object
Set SetFocusAPI = oATO.DeclareAPI("USER32.DLL", "SetFocus", "ByVal hWnd As Long")
Dim SetWindowPos ' as object
Set SetWindowPos = oATO.DeclareAPI("USER32.DLL", "SetWindowPos", "ByVal hWnd As Long", _
"ByVal hWndInsertAfter As Long", "ByVal x As Long", "ByVal y As Long", _
"ByVal cx As Long", "ByVal cy As Long", "ByVal wFlags As Long")
Dim IsWindow ' as object
Set IsWindow = oATO.DeclareAPI("USER32.DLL", "IsWindow", "ByVal hWnd As Long")
Dim IsWindowVisible ' as object
Set IsWindowVisible = oATO.DeclareAPI("USER32.DLL", "IsWindowVisible", "ByVal hWnd As Long")
Dim mouse_event ' as object
Set mouse_event = oATO.DeclareAPI("USER32.DLL", "mouse_event", "ByVal dwFlags As Long", _
"ByVal dx As Long", "ByVal dy As Long", "ByVal cButtons As Long", "ByVal dwExtraInfo As Long")
Dim GetSystemMetrics ' as object
Set GetSystemMetrics = oATO.DeclareAPI("USER32.DLL", "GetSystemMetrics", "ByVal nIndex As Long")
Dim GetDlgItem ' as object
Set GetDlgItem = oATO.DeclareAPI("USER32.DLL", "GetDlgItem", "ByVal hDlg As Long", _
"ByVal nIDDlgItem As Long")
Dim GetWindowTextLength ' as object
Set GetWindowTextLength = oATO.DeclareAPI("USER32.DLL", "GetWindowTextLengthA", _
"ByVal hWnd As Long")
Dim GetWindowText ' as object
Set GetWindowText = oATO.DeclareAPI("USER32.DLL", "GetWindowTextA", _
"ByVal hWnd As Long", "ByVal lpString As String", "ByVal cch As Long")
Dim GetActiveWindow ' as object
Set GetActiveWindow = oATO.DeclareAPI("USER32.DLL", "GetActiveWindow")
Dim GetWindowRect ' as object
Set GetWindowRect = oATO.DeclareAPI("USER32.DLL", "GetWindowRect", _
"ByVal hWnd As Long", "lpRect As TypeDef")
Dim CloseWindow ' as object
Set CloseWindow = oATO.DeclareAPI("USER32.DLL", "CloseWindow", "ByVal hWnd As Long")
Dim MoveWindow ' as object
Set MoveWindow = oATO.DeclareAPI("USER32.DLL", "MoveWindow", "ByVal hWnd As Long", _
"ByVal x As Long", "ByVal y As Long", "ByVal nWidth As Long", "ByVal nHeight As Long", _
"ByVal bRepaint As Long")
Dim FindWindow ' as object
Set FindWindow = oATO.DeclareAPI("USER32.DLL", "FindWindowA", "ByVal lpClassName As String", "ByVal lpWindowName As String")
' ------------------------------------------------
' --- end of api declarations --------------------
' ------------------------------------------------

'
' --- progress dialog declarations ---------------
Dim m_btnExitID ' as integer
'
Dim bCloseFlag ' t/f if user closed the form...
Dim bExitClick ' as boolean
'
Const sDlgCaption = " Kookie Kruncher, "
Const sRejectOption = "currently REJECTING cookies... "
Const sAcceptOption = "currently ACCEPTING cookies... "
Const sIgnoreOption = "currently in STAND-BY mode... "
' --- end of progdlg stuff -----------------------
'
' --- mouse related ------------------------------
Dim m_pxWdScreen ' as long (screen wd/ht in pixels)
Dim m_pxHtScreen
'
Dim m_msePtsPPX ' as long ("mouse points" per pixel ratio)
Dim m_msePtsPPY
'
Dim mseMoveFlags ' mouse_event flags...
Dim mseLBtnDnFlags ' btn_down
Dim mseLBtnUpFlags ' btn_up
' --- end of mouse related stuff -----------------
'
Const bTesting = True ' False ' True ' flag to define/re-define window params...
'
' Const sCookieAlertCaption = "Security Alert" ' (works for both)
Const sCookieAlertCaption = "Privacy Alert" ' (works for both)
Dim sCookieAlertClass ' as string
Dim ID_BTNYES, ID_BTNNO ' as long
'
Const sErrorAlertCaption = "Error"
Const sErrorAlertClass = "#32770"
'
Const sZoneAlarmAlertCaption = "ZoneAlarm"
Const sZoneAlarmAlertClass = "#32770"
'
if bTesting then ' select parameters, based on testing/"production" use...
' er, um, well at least the parameters for the ORIGINAL dummy dialog
' were different. The NEW dummy dialog uses a msgbox, and (surprise!)
' the msgbox parameters (class and btn_IDs) are the same as the Sec Alert dlg...
' note: this window class and button id for the dummy security alert test case...
sCookieAlertClass = "#32770" ' (was "ThunderRT5Form" w/oNMD)
ID_BTNYES = 6 ' button id for the "&Yes" button (was 7 w/oNMD)...
ID_BTNNO = 7 ' button id for the "&No" button (was 8 w/oNMD)...
Else
' note: THIS window class and button id for the REAL THING (from IE)...
sCookieAlertClass = "#32770"
' ID_BTNYES = 6 ' button id for the "&Yes" button...
' ID_BTNNO = 7 ' button id for the "&No" button...
ID_BTNYES = 6 ' button id for the "&Allow Cookie" (IE6) button...
ID_BTNNO = 7 ' button id for the "&Block Cookie" (IE6) button...
End If
'
Dim m_btnRejectID, m_btnAcceptID, m_btnIgnoreID
' Dim bRejectClick, bAcceptClick, bIgnoreClick
Dim bIgnoreIEDialogs
'
Dim nRtn ' as long (api return value)
Const S_ERR = 0 ' (api) success codes
Dim iBtn ' as integer (mb button clicked)
'
Dim ID_BTNTARGET ' as long (child window ID of target button)
Dim sBtnText ' as string (button text/caption, used for confirmation)...
'
Const SWP_NOSIZE = &H1 ' SetWindowPos Flags
Const SWP_NOMOVE = &H2
Const SWP_NOREDRAW = &H8
Const SWP_SHOWWINDOW = &H40
Dim swpFlags : swpFlags = SWP_SHOWWINDOW Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOREDRAW
Const HWND_TOPMOST = -1
'
Dim oForm ' as form object
'
Const MAX_STRING = 260 ' maximum size, [out] param string buffer...
' --- Timing Constants ---------------------------
Const tWaitLoop = 200 ' this constant determines the overall
' responsiveness of the script. A smaller number will cause the script to detect
' "Security Alert" dialogs quicker, but also will cause the script
' to hog more resources...
Const tDoEvents = 20 ' in places, the sleep method is used
' where a vb programmer would use "DoEvents",
' i.e., in places where one would give up the cpu so that
' the system could process events...
Const tShowDlg = 100 ' a delay intentionally inserted between
' finding the alert dlg and clicking the button. Without some
' delay here, the appearance of the alert dlg is almost
' "subliminal", that is, you can barely notice it. Since the
' main purpose of this script is to notice attempts to plant
' cookies on your pc, then you want the alert dlg to stay on
' the screen long enough to (at least) be BARELY noticable...
Const tWaitABit = 300 ' a delay to show the zone alarm alert a bit longer...
'
' --- Writing Zone Alarm Warning Messages --------
Const sMsgFileName = "zoneAlarmMessages.txt" ' (output - class code) win/temp/ & filename
Dim sMsgFileSpec ' as string
Dim oMsgFile ' as object
' --- end of declarations and constants ----------


' ================================================
' === MAIN LINE SCRIPT LOGIC =====================
' ================================================
Const sMe = "[main], "

' Create the Form (with default caption), and add the controls...
Call Create_Dialog(sDlgCaption & sRejectOption)
dbPrint sMe & "dialog created... "

' construct output filespec (for zone alarm messages)...
Dim oSH : Set oSH = WScript.CreateObject("WScript.Shell")
Dim oEnv : Set oEnv = oSH.Environment("PROCESS")
sMsgFileSpec = oEnv("TEMP") & "\" & sMsgFileName
dbPrint sMe & " ..note: zoneAlarm message file is: " & sMsgFileSpec
Set oEnv = nothing
Set oSH = nothing

' open output file...
Set oMsgFile = fso.CreateTextFile(sMsgFileSpec, True) ' allow overwrite...
oMsgFile.WriteLine("zoneAlarm Message file of: " & FormatDateTime(Date, vbGeneralDate) )

' ----------------------------------------------
' setup the callback address in place (to my wndproc)...
Set oSCO.SetCallBack = GetRef("myOptBtnWndProc")
oSCO.SubClassWindow oForm.OptBtn(1).hWnd ' subclass control (not form)
oSCO.SubClassWindow oForm.OptBtn(2).hWnd
oSCO.SubClassWindow oForm.OptBtn(3).hWnd
' ----------------------------------------------



Call Initialize() ' get screen dimensions (for later)...

Dim sBuffer : sBuffer = String(MAX_STRING, Chr(0)) ' allocate string buffer
' Dim lpSBuf : lpSBuf = oATO.StringPtr(sBuffer) ' get pointer for api call


' wait around for user cancel/close...
bCloseFlag = FALSE ' set close flag as undetected.
bExitClick = False

' bRejectClick = True ' to trigger (default) setup for reject...
Call OptionButton_Click(1) ' to trigger (default) setup for reject...
bIgnoreIEDialogs = False

Do ' main wait loop...

WScript.Sleep tWaitLoop ' wait-a-bit...
WScript.Sleep tDoEvents ' allow vb to process events...

if (NOT bIgnoreIEDialogs) then

' normal activity, look for window and click button if found...
Call CheckCookieAlert(sCookieAlertCaption, sCookieAlertClass, _
ID_BTNTARGET, sBtnText)

' check also for those html-error notices (answer NO, to "want debug?")...
Call CheckCookieAlert(sErrorAlertCaption, sErrorAlertClass, _
ID_BTNNO, "&No")



' finally, check for zone alarm alerts (and dismiss)...
Call CheckZoneAlarmAlert(sZoneAlarmAlertCaption, sZoneAlarmAlertClass, _
ID_BTNNO, "&No")
End If

Loop until (bExitClick or bCloseFlag)


' ---------------- WARNING!!! ------------------
' N.B. Any subclassed form/window MUST BE UN-SUBCLASSED before exiting...
' ----------------------------------------------
oSCO.UnSubclassWindow oForm.OptBtn(1).hWnd ' so, un-subclass the OptBtn(s)...
oSCO.UnSubclassWindow oForm.OptBtn(2).hWnd
oSCO.UnSubclassWindow oForm.OptBtn(3).hWnd

oMsgFile.WriteLine(FormatDateTime(Time, vbLongTime) & ": " & "file closed... ")
oMsgFile.Close ' close the output file...
Set fso = nothing

Set oATO = nothing ' clean up
oNMD.ShowDialog False ' vendor-approved way to shut down oNMD...
oNMD.UnloadDialog
Set oNMD = nothing

' finished, but provide a warning to shut down the connection,
' nRtn = MsgBox("Don't forget to disconnect your Connectoid", vbInformation, " < Reminder >")
' Now using a Timeout Popup, (so you don't have to close the dialog)...
Const sDontForget = "Don't forget to DISCONNECT YOUR CONNECTOID!"
Const sReminder = " < Reminder >"
iBtn = CreateObject("WScript.Shell").Popup(sDontForget, 2, sReminder, vbInformation)
WScript.Quit



' ================================================
' === SUBROUTINES FOLLOW =========================
' ================================================


' --- SUBCLASSING CALLBACK ROUTINE ---------------

Function myOptBtnWndProc(hWin, uMsg, wParam, lParam)
Const sMe = "[myOptBtnWndProc], "
Const WM_KEYDOWN = &H100
Const WM_LBUTTONDOWN = &H201 ' (left mouse button)
Const WM_LBUTTONUP = &H202

' --- discussion -------------------------------
' The developer of wshLtWtNonModalDialog refused to provide for optBtn clicks,
' (ugh!, how dare he leave that out!). So, we are going to resort to something
' very ugly here, i.e., subclassing the buttons to detect the clicks for
' ourself. (Take that, you lazy wshNMD developer!). Here you see us checking
' for left-mouse-button-down system messages. If we detect a such message,
' we will call a optbtn click event handler, almost as if wshNMD had done it...
' --- end of discussion ------------------------

If (uMsg = WM_LBUTTONDOWN) Then

' dbPrint sMe & "detected WM_LBUTTONDOWN"


if (hWin = oForm.OptBtn(1).hWnd) then
' dbPrint "button1"
' bRejectClick = True
Call OptionButton_Click(1)

ElseIf (hWin = oForm.OptBtn(2).hWnd) then
' dbPrint "button2"
' bAcceptClick = True
Call OptionButton_Click(2)

ElseIf (hWin = oForm.OptBtn(3).hWnd) then
' dbPrint "button3"
' bIgnoreClick = True
bIgnoreIEDialogs = True
dbPrint sMe & " operating mode set to: STAND-BY... "
oForm.Caption = sDlgCaption & sIgnoreOption

End If


End If ' test wm_keydown

myOptBtnWndProc = True
End Function



' --- SUBCLASSING CALLBACK ROUTINE ---------------
' (unused for now, but could have subclassed frame-or-form,
' looking for wm_command, ilo mouse down)...

Function mySubClsWinProc(hWin, uMsg, wParam, lParam)
Const sMe = "[mySubClassWndProc], "
'
Const WM_COMMAND = &H111
Const WM_LBUTTONDOWN = &H201
Const WM_DESTROY = &H2
' (some) User Button Notification Codes
Const BN_CLICKED = 0
Const BN_DISABLE = 4
Const BN_DOUBLECLICKED = 5
'
Dim idCtrl, typNotify ' as integer(s)
Dim hWndCtrl ' as long
'
' --- Discussion about what this subclasser is doing ---
' This "subclasser" is going to be looking for just a few specic
' messages, associated with just a few windows (that is, the
' main (parent) window, and the button child windows. The
' vast majority of windows messages flowing through here are
' being ignored...
'
' The WM_COMMAND notify messages are formatted as follows:
' - hWnd is the window handle of the form...
' - uMsg is the windows message number (WM_XXX number)
' - wParam has two parts, the "High Word" contains the
' "notification type", in other words, one of the specific
' notifications associated with that type of control.
' And the "Low Word" contains the "control ID number"
' which is assigned by the programmer when the control
' is created, but generally not used by visual basic.
' - lParam contains the window handle of the form/control
' that originates the window message...
' --- end of discussion --------------------------


If uMsg = WM_COMMAND Then ' button click message...

typNotify = HIWORD(wParam) ' parse msg parameters...
idCtrl = LOWORD(wParam)
hWndCtrl = lParam

if (typNotify = BN_CLICKED) then ' check for button click notification...
dbPrint sMe & "detected button click, ctrlID/hWnd: " & CStr(idCtrl) & " / " & CStr(hWndCtrl)

' found click, test which button it was...
if (idCtrl = m_MyBtnChildID) AND (hWndCtrl = m_hMyBtnWnd) then
dbPrint sMe & "SOMEBODY CLICKED MY BUTTON!"
m_myBtnClickEvent = True ' pass a notification back to script...
End If ' my button
End If ' btn click notification
End If ' wm_command

' the rest of the msgs will be handled by defWinProc (inside wshATO)...
End Function





' --- CHECK FOR COOKIE ALERT WINDOW --------------

Sub CheckZoneAlarmAlert(sAlertCaption, sAlertClass, ID_BTN, sBtnText)
Const sMe = "[ckZoneAlarmWin], "
Dim hWnd, hBtn, hStatic ' as long
Dim sText ' as string
Dim cbTxt ' byte count of text returned...
Dim iLoop ' as integer (loop counter)
'
Const id_Static = 131 ' zone alarm control id's
Const sAlertMsg = "The firewall has blocked Internet access"
Const id_OKBtn = 1
'
Dim lParam ' as long
Const BM_CLICK = &HF5
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
' --- end of declarations and constants ----------


' look for window...
hWnd = FindWindow(sAlertClass, sAlertCaption) ' (send null str for class)
if hWnd = 0 then Exit Sub ' not found...
' dbPrint sMe & "found designated zone alarm window: " & sAlertCaption
if (IsWindowVisible(hWnd) = 0) then Exit Sub

' look for a static control, with the expected "alert message",
' (or at least partial msg)...
hStatic = GetDlgItem(hWnd, id_Static)
if hStatic = 0 then Exit Sub ' not found
' dbPrint sMe & "found designated static (message) window.. "

' retrieve the static control's text...
cbTxt = GetWindowText(hStatic, sBuffer, MAX_STRING - 2)
BugAssert cbTxt > 0, sMe & "could not read text from button window"

' retrieve the string (static control text), and "trim"...
sText = Left(sBuffer, cbTxt)
' dbPrint sMe & "Found static text as: " & sText
' verify that the static text is as expected...
if (InStr(sText, sAlertMsg) <> 1) then Exit Sub

' save this alert message (for comparison with others, later)...
oMsgFile.WriteLine(FormatDateTime(Time, vbLongTime) & ": " & sText)

' look for the dialog's OK button (by btn ID)...
hBtn = GetDlgItem(hWnd, id_OKBtn)
if hBtn = 0 then Exit Sub ' not found
' dbPrint sMe & "found OK button: " & CStr(hBtn)

' and, re-check the button text (aka caption)...
cbTxt = GetWindowText(hBtn, sBuffer, MAX_STRING - 2)
BugAssert cbTxt > 0, sMe & "could not read text from button window"

' retrieve the string (button window caption), and "trim"...
sText = Left(sBuffer, cbTxt)
' check that actual btn caption is as expected...
BugAssert (sText = "OK"), sMe & "found OK button, with WRONG btn text"

' did we get here?, then WE HAVE FOUND ZONE ALARM OK BUTTON, YEA!!!
' ----------------------------------------------
' Call SendMessage(hBtn, BM_CLICK, 0, 0)
' WScript.Sleep tDoEvents
' uh-oh. the zone alarm button doesn't seem to respond to the bm_click msg, so...


' --- click the button, the BRUTE FORCE way ----
' note: the "proper" way to do this would be to get the "rectangle" of the
' button, then calculate the center of it, and click on the center.
Dim tRECT : Set tRECT = oTD.createRECT
Call GetWindowRect(hBtn, tRECT) ' get button rectangle
With tRECT
' pxBtnWidth = .Right - .Left : pxBtnHeight = .Bottom - .Top ' in pixels
lParam = oATO.MakeLong((.Right - .Left) \ 2, (.Bottom - .Top) \ 2) ' btn center
End With
Set tRect = nothing

' wait-a-bit, so as to see (briefly) the zone alarm dialog...
WScript.Sleep tWaitABit

' uh-oh. Had used SendMessage, but that doesn't appear to work properly.
' api newsgroup advises that mouse messages must be POSTED!!!
' (Makes sense. Otherwise some messages may be missed)...
Call PostMessage(hBtn, WM_LBUTTONDOWN, 0, lParam) ' wParam, lParam = x,y
WScript.Sleep tDoEvents
Call PostMessage(hBtn, WM_LBUTTONUP, 0, lParam)
WScript.Sleep tDoEvents
dbPrint sMe & "clicked the ZoneAlarm OK button at: [" & CStr(Time) & "]"
' MsgBox("detected alert")

End Sub




' --- CHECK FOR COOKIE ALERT WINDOW --------------

Sub CheckCookieAlert(sWinCaption, sWinClass, ID_BTN, sBtnText)
Const sMe = "[ckCookieWin], "
Dim hWnd, hBtn ' as long
Dim sText ' as string
Dim cbTxt ' byte count of text returned...
Dim iLoop ' as integer (loop counter)


' look for window...
hWnd = FindWindow(sWinClass, sWinCaption) ' (send null str for class)
if hWnd = 0 then Exit Sub ' not found...
' dbPrint sMe & "found designated window: " & sWinCaption

' look for the designated button (by button ID)...
' (note: previously did a "walk" through the child windows
' to find applicable button. Now, by making use of the
' child window "ID" - which is hopefully unique and consistent -
' then we can find the designated button directly)...
hBtn = GetDlgItem(hWnd, ID_BTN)
if hBtn = 0 then Exit Sub ' not found
' dbPrint sMe & "found designated window (and button): " & sWinCaption

' and, re-check the button text (aka caption)...
' retrieve the button text/caption...
cbTxt = GetWindowText(hBtn, sBuffer, MAX_STRING - 2)
BugAssert cbTxt > 0, sMe & "could not read text from button window"

' retrieve the string (button window caption), and "trim"...
sText = Left(sBuffer, cbTxt)

' check that actual btn text/caption is the same as expected...
BugAssert (sText = sBtnText), _
"uh, oh. button text/caption does NOT match expected text " & vbCrLf _
& " the target btn text is: [" & sText & "]" & vbCrLf _
& " the expected btn text is: [" & sBtnText & "]"

' did we get here?, then WE HAVE FOUND THE BUTTON, YEA!!!


' found the button, now get it's location...
Dim tR : Set tR = oTD.CreateRECT ' create a rect typedef...

nRtn = GetWindowRect(hBtn, tR)
BugAssert nRtn <> S_ERR, sMe & "could not get window rect for button"

' calculate the center of (Yes/No) button, (RECT units are pixels)...
Dim btnCtrX : btnCtrX = (tR.Left + tR.Right) \ 2
Dim btnCtrY : btnCtrY = (tR.Top + tR.Bottom) \ 2
' dbPrint sMe & "button Center (X/Y): " & CStr(btnCtrX) & "/" & CStr(btnCtrY)

Set tR = nothing ' returns typedef memory block

' --- mouse coordinates vs. screen coordinates ---
' The (mouse) cursor is moved by setting the desired coordinates for the
' mouse, measured in the "MOUSE COORDINATE SYSTEM" (not twips or pixels).
' The top-left corner is (0,0) and the bottom-right is (65535,65535).
' In order to move the cursor accurately, you have to convert any
' coordinates into this system. Ain't this fun?
'
' The generally the recommended strategy for this is to get the
' screen dimensions in pixels, locate the control (button) you want
' to click on, then convert button position to mouse coordinates.
' Note: the screen dimensions were retrieved at startup, we are
' just using a pre-calculated pixels-to-MouseCoordinates
' conversion factor here. (And, if you change the screen resolution
' on the fly just to screw me up, then shame on you!)...
' --- end of mouse coordinates discussion ------

' convert button position (target) to mouse coordinates...
Dim mseTargetX : mseTargetX = CLng(btnCtrX * m_msePtsPPX)
Dim mseTargetY : mseTargetY = CLng(btnCtrY * m_msePtsPPY)


' ----------------------------------------------
' 17Aug01: bring the cookie alert to the foreground...
' If the cookie alert window is NOT in the foreground,
' you can click all you want, and nothing will happen...
' ----------------------------------------------

nRtn = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, swpFlags) ' make topmost...
nRtn = SetFocusAPI(hWnd)


' --- discussion about mouse_event -------------
' I have seen discussions/code examples on the web
' that indicate you can "or" all the mouseevent flags together,
' so as to move/mseDN/mseUP all in one call.
' Unfortunately, that doesn't work for me. I had to
' separate out the move/msdDN/mseUP into separate calls
' to get it to work right. Ain't this fun?
'--- end of discussion -------------------------

' move to target (button) position...
mouse_event mseMoveFlags, mseTargetX, mseTargetY, 0,0
' WScript.Sleep tDoEvents

WScript.Sleep tShowDlg ' this delay intentionally inserted between
' finding the alert dlg and clicking the button. Without some
' delay here, the appearance of the alert dlg is almost
' "subliminal", that is, you can barely notice it. Since the
' main purpose of this script is to notice attempts to plant
' cookies on your pc, then you want the alert dlg to stay on
' the screen long enough to (at least) be BARELY noticable...

' and FINALLY, click the mouse, (button down / button up)...
mouse_event mseLBtnDnFlags, mseTargetX, mseTargetY, 0,0
WScript.Sleep tDoEvents
mouse_event mseLBtnUpFlags, mseTargetX, mseTargetY, 0,0
WScript.Sleep tDoEvents
dbPrint "[" & CStr(Time) & "], found [" & sWinCaption & "] window, " _
& "clicked (" & sBtnText & ") button: " & CStr(btnCtrX) & "/" & CStr(btnCtrY)

' --- discussion about those sleep calls -------
' Yes, I know what you're thinking. Why is he SLOWING THINGS DOWN
' by putting in those sleep calls??? Well, not so fast. Those
' sleep calls are acting like vb's "DoEvents", and in effect
' serve to give up the processor so that the system can have some
' cpu time to actually process those mouse_events. In other words,
' I am attempting to SPEED THINGS UP here. If you don't believe
' all this, take out the sleep calls and try it for yourself...
' --- end of discussion ------------------------

' the applicable button in the cookie window has been clicked,
' give it some time to close...

For iLoop = 0 to 10 ' wait about 2 seconds...

WScript.Sleep tWaitLoop

nRtn = IsWindow(hWnd) ' is the cookie alert window handle still valid???
' non-zero indicates yes (i.e., the window IS still valid)
' zero indicates NO, the window is gone...
if nRtn = 0 then Exit Sub ' when window disappears, go back to looking again...
Next ' iLoop

' you considered placing a fatal error here, but decided against it...
' Explanation: if the windows DIDN'T close, then maybe something
' interviened to throw you off. So...
' Re-enter the program, and maybe pick it up on the next go-around.
End Sub


' --- INITIALIZE MOUSE GEOMETRY AND EVENT FLAGS ---

Sub Initialize() ' get screen dimensions...
Const sMe = "[Initialization], "

Const SM_CXSCREEN = 0 ' getsystemmetrics constants...
Const SM_CYSCREEN = 1

m_pxWdScreen = GetSystemMetrics(SM_CXSCREEN)
m_pxHtScreen = GetSystemMetrics(SM_CYSCREEN)
dbPrint sMe & "screen dimensions (X/Y): " & CStr(m_pxWdScreen) & "/" & CStr(m_pxHtScreen)

' mouse points per pixel...
m_msePtsPPX = 65535 / m_pxWdScreen
m_msePtsPPY = 65535 / m_pxHtScreen
dbPrint sMe & "mouse points per pixel (X/Y): " & CStr(m_msePtsPPX) & "/" & CStr(m_msePtsPPY)

Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_ABSOLUTE = &H8000
'
mseMoveFlags = MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE
mseLBtnDnFlags = MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN
mseLBtnUpFlags = MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP
End Sub

' --- ANOTHER WAY TO GET SCREEN INFO (using oNMD.vbScreen) ---
' (No doubt slower than using GetSystemMetrics)

Sub GetScreenDims_fromNMDvbScreenObj(pxScrWidth, pxScrHeight)
' Dim oScreen : Set oScreen = oNMD.vbScreen ' getref to vb screen object...
' Dim htScreen : htScreen = oScreen.Height ' measured in "twips"...
' Dim wdScreen : wdScreen = oScreen.Width
' Dim tppx : tppx = oScreen.TwipsPerPixelX ' twips per pixel...
' Dim tppy : tppy = oScreen.TwipsPerPixelY
' Dim pxScrWidth : pxScrWidth = wdScreen \ tppx ' in pixels...
' Dim pxScrHeight: pxScrHeight= htScreen \ tppy
' dbPrint sMe & "screen dimensions (from vbScreen): " & CStr(pxScrWidth) & "/" & CStr(pxScrHeight)
' Set oScreen = nothing
End Sub


' ------------------------------------------------
' --- click event handlers -----------------------
' ------------------------------------------------

' note: there is no wshNMD optBtn click event, the event is generated internally
Sub OptionButton_Click(index)

' check which optBtn was clicked...
Select Case index

Case 1 ' reject
dbPrint sMe & " operating mode set to: REJECT cookies"
oForm.Caption = sDlgCaption & sRejectOption
' setup to look for &No, oops, make that &Block Cookie...
' ID_BTNTARGET = ID_BTNNO : sBtnText = "&No" ' no btn ID / text
ID_BTNTARGET = ID_BTNNO : sBtnText = "&Block Cookie" ' reject btn ID / text
bIgnoreIEDialogs = False

Case 2 ' acceptElseIf bAcceptClick then ' setup to look for "&Yes"
dbPrint sMe & " operating mode set to: ACCEPT cookies"
oForm.Caption = sDlgCaption & sAcceptOption
' setup to look for &Yes, oops, make that &Allow Cookie...
' ID_BTNTARGET = ID_BTNYES : sBtnText = "&Yes" ' yes btn ID / text
ID_BTNTARGET = ID_BTNYES : sBtnText = "&Allow Cookie" ' accept btn ID / text
bIgnoreIEDialogs = False

Case Else
MsgBox("detected illegal index in optBtn click event handler")

End Select

End Sub


Sub oNMD_ButtonClick(btnID)
' MsgBox("Button Clicked, ID = " & CStr(btnID))
Select Case btnID
' (this is old code, when cmdBtns were used, before optbtns)...
' Case m_btnRejectID : bRejectClick = True
' Case m_btnAcceptID : bAcceptClick = True
' Case m_btnIgnoreID
' bIgnoreClick = True
' dbPrint sMe & " operating mode set to: STAND-BY... "
' oForm.Caption = sDlgCaption & sIgnoreOption

Case m_btnExitID : bExitClick = True
Case Else : MsgBox("detected unknown button click event")
End Select
End Sub

Sub oNMD_UserClose()
' MsgBox(" .. user close detected")
bCloseFlag = TRUE
End Sub



' --- Simulate "debug.print" ---------------------

Sub dbPrint (sMsg)
oNMD.AddLine sMsg
End Sub

' --- Create Debug Dialog (immediate window) -----

Sub Create_Dialog(sCaption)
Dim wdForm, htForm, wdBtn, htBtn, wdBtnSp ' as long
Const sSelect = "Select Operating Mode, (sorry no radio buttons)... "
Const sLBLabel = "Activity Log... "
Const sLogo = "brought to you by: jawar productions. (clap, clap, clap)... "

' do some geometry calculations...
wdForm = 450 : htForm = 270 : wdBtn = 100 : htBtn = 25
wdBtnSp = Int((wdForm - wdBtn) / 2) - 3
Dim wdOptBtn : wdOptBtn = 115
Dim htOptBtn : htOptBtn = 22

' position in upper left corner...
oNMD.CreateDialog sCaption, 300,200, wdForm,htForm
oNMD.MinMaxBtns = False ' min/max buttons not needed for this demo...

Set oForm = oNMD.frmDialog ' get "form object"...

With oForm.Font ' set form's font to the ususal...
.Name = "MS Sans Serif" : .Size = 8 : .Bold = False
End With

' oNMD.AddLabel sSelect, 30,5, 400,20
' oNMD.AddButton "Reject Cookies", 30,22, wdOptBtn,htOptBtn
' m_btnRejectID = 101 ' the first button created has an ID of 101
' oNMD.AddButton "Accept Cookies", 50 + wdOptBtn ,22, wdOptBtn,htOptBtn
' m_btnAcceptID = 102
' oNMD.AddButton "Set Manual Mode", 70 + (2*wdOptBtn),22, wdOptBtn,htOptBtn
' m_btnIgnoreID = 103

' ==============================================
' === Draw the "Etched Edge" separator =========

Const vbFSSolid = 0 ' fill style constant
Const crOffWhite = &HF0F0F0
Const crDkGray = &H808080

' set autoredraw (so as to "persist" the vb graphics)...
oForm.AutoRedraw = True
oForm.FillStyle = vbFSSolid

' draw a home-made "etched edge" line, using vbRect and accent line,
' (Note: you started with white, but then "softened" it a bit)...
' oForm.FillColor = crOffWhite ' start with white box (ht = 2pix)
' oForm.vbRectangle 20,49, wdForm-45,2, crOffWhite
' oForm.vbLine 20+1,49, wdForm-45-2,0, crDkGray ' vbBlack ' black accent line
' ==============================================

oNMD.AddLabel sLBLabel, 25,55, 400,20
oNMD.AddLstBox 20,70, 400,130

oNMD.AddButton "Exit", wdBtnSp,200, wdBtn,htBtn
m_btnExitID = 101 ' now the only button (was 104)

oForm.Button(1).Font.Bold = True ' make exit button font more pronounced...

oNMD.AddLabel "(last rev: 10Nov04)", 20,230, 150,20

' note: now using built-in logo...
' oNMD.AddLabel sLogo, 180,230, 400,20
' With oForm.Label(3).Font ' set (less conspicuous) font for logo...
' .Name = "Arial" : .Size = 7 : .Bold = False : .Italic = True : End With

' ----------------------------------------------
' Changing from cmdButtons to optButtons in frame, must be LAST controls defined...
' ----------------------------------------------
Const topOptBtn = 18 ' (relative to FRAME!)
oNMD.AddFrame " Select Cookie-Treatment Option ", 10,5, 420,45
oNMD.AddOptBtn "Reject Cookies", 20,topOptBtn, wdOptBtn,htOptBtn
oNMD.AddOptBtn "Accept Cookies", 40 + wdOptBtn,topOptBtn, wdOptBtn,htOptBtn
oNMD.AddOptBtn "Set Manual Mode", 60 + (2*wdOptBtn),topOptBtn, wdOptBtn,htOptBtn


' --- finished with creating the form ---

' adjustments: change optbtn style to vbGraphic.
' oops, vb doesn't all that change (at run time). so resort to api's...
' oForm.OptBtn(1).Style = 1 ' graphic style (looks like cmdbtn)...
Call ChangeStyleAtRunTime(oForm.OptBtn(1))
Call ChangeStyleAtRunTime(oForm.OptBtn(2))
Call ChangeStyleAtRunTime(oForm.OptBtn(3))

oForm.OptBtn(1).Value = True ' set "reject cookies" as the default...

oNMD.ShowDialog True

oForm.Button(1).SetFocus ' dialog must be showing to SetFocus...

End Sub


Sub ChangeStyleAtRunTime(OptBtn) ' as control (with handle)
Const sMe = "[chgOptBtnStyle], "
Const GWL_STYLE = (-16)
Const GWL_EXSTYLE = (-20)
'
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Const WS_CLIPSIBLINGS = &H4000000
Const WS_BORDER = &H800000
Const WS_GROUP = &H20000
Const WS_TABSTOP = &H10000
'
Const WS_EX_NOPARENTNOTIFY = &H4
Const WS_EX_CLIENTEDGE = &H200
'
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
Const SWP_NOACTIVATE = &H10
Const SWP_FRAMECHANGED = &H20 ' The frame changed: send WM_NCCALCSIZE
'
Dim SWP_REDRAWFRAME
SWP_REDRAWFRAME = SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_FRAMECHANGED
'
Dim optStyle, optExStyle ' as long

' dbPrint sMe & "entered.. "

' get existing style-bits, (for debugging only)...
' optStyle = GetWindowLong(OptBtn.hWnd, GWL_STYLE)
' optExStyle = GetWindowLong(OptBtn.hWnd, GWL_EXSTYLE)
' dbPrint sMe & "Style/ExStyle: " & Hex(optStyle) & "/" & Hex(optExStyle)

' Const oldOptStyle = &H54012004 ' (found default) style of optbtn (before machinations)...
' Const oldOptExStyle = &H0

Const BS_PUSHLIKE = &H1000& ' forces optbtn to look-and-behave like std button
Const BS_AUTORADIOBUTTON = &H9& ' btn autochecks itself, and unchecks others in group

' --------------------------------------------
' changing the optbtn from "classic" style to "button" style
' seems to cause vb to lose the optbtn group treatment.
' That is, only one button down at a time. This code
' is to remedy that, using "brute force"...
' --------------------------------------------


' --- discussion -------------------------------
' Note: we incompetents don't know how to get "latching" buttons using the
' optbtn's properties, (other than to code in vb's "graphic buttons", which
' may only be done at design time). And so, we have to resort to "brute force",
' and "trial-and-error" techniques. After about fifty t-and-e's, we found what
' you see here. It does give the desired result, BUT vb somehow "loses touch"
' with these buttons, and doesn't supply the usual radio button treatment.
' (That is, click one "on" and the others "automagically" click off. That is
' why you see the "autoRadioButton" style set. It invokes the SYSTEM,
' (rather than VB) to supply the expected radio button treatment...
' --- end of discussion ------------------------

' new optbtn style flags...
' Const newOptStyle = &H54011009 ' default, plus "pushlike" and auto-radio
Dim newOptStyle
newOptStyle = WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or WS_TABSTOP _
Or BS_PUSHLIKE Or BS_AUTORADIOBUTTON
Const newOptExStyle = &H0 ' note that the extended style doesn't change...

Call SetWindowLong(OptBtn.hWnd, GWL_STYLE, newOptStyle)
' Call SetWindowLong(OptBtn.hWnd, GWL_EXSTYLE, newOptExStyle) ' no change (for now)
Call SetWindowPos(OptBtn.hWnd, 0, 0, 0, 0, 0, SWP_REDRAWFRAME)

End Sub


' --- INSTANTIATE ACTX OBJECT (or class) AND CHECK ----
' (using a sub to get this ugly instantiation code out of main line code)...

Sub Instantiate (oObject, sProgramID, sEventPrefix)
Const sME = "[sub Instantiate], "
' check variant sub-type parameters...
BugAssert (VarType(sProgramID) = vbString), sME & "sProgramID must be a STRING!"
BugAssert (VarType(sEventPrefix) = vbString), sME & "sEventPrefix must be a STRING!"
On Error Resume Next ' turn on error checking
Set oObject = WScript.CreateObject(sProgramID, sEventPrefix)
BugAssert (err.number = 0), sME & "This script requires: " & sProgramID & vbCrlf _
& " kindly INSTALL and REGISTER this ActX component... "
On Error goto 0 ' turn off error checking...
End Sub


' --- BUGASSERT (yes, it's for debugging) --------

Sub BugAssert (bTest, sErrMsg)

' BugAssert is a Bruce McKinney creation.
' It is used to test for intermediate results...
if bTest then Exit Sub
MsgBox "Error Detected by BugAssert: " & vbCr & vbCr & sErrMsg, _
vbCritical, " << BugAssert FAILED >> "
WScript.Quit

End Sub





' === OLD CODE STORAGE ===========================

' --- end of old code ----------------------------