Solved

Webbrowser Control and Javascript

Posted on 2006-07-24
2
1,014 Views
Last Modified: 2013-12-25
Hello guys,

What i want to do is to call a vb function when javascript alert function is run from the webbrowser window. So that no alertbox will appear on the screen and page will continue running... I've tried several ways before, one of them is to overwrite the existing javascript function, but it doesnt prevent the alerts when the page is loading... etc...

in short here is what i want;
when called from the browser window

alert("Hello") must call my alerthandle function in vb with "Hello" as parameter

if its not possible then i am looking for a way to disable alert boxes...

Thanks.


Cem
0
Comment
Question by:Cem Türk
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
2 Comments
 
LVL 17

Accepted Solution

by:
vb_elmar earned 500 total points
ID: 17175414
Hi,

JavaScript Messageboxes (e.g. alert"Hello") are modal windows, and a standard VB Timer1 timer stops, when a
modal JavaScript Messagebox pops up.

So, a normal VB timer would not be helpful.

To detect Javascript alert dialog boxes, you need a subclassing timer
that doesn't stop, when a VB MsgBox or a JS MsgBox pops up.

The following sample works with a subclassing Timer.

How the sample works :

1)   It detects the alertbox (using findwindow).
2)   If found, it sends a sendkeys"{Enter}".
---> Then the alertbox will disappear


Needs:
======
1 Form with "WebBrowser1" (press Ctrl-T   --->  "Microsoft Internet Controls")
1 Module
1 Class module (name: TimerInterface)





=========
Form1:
=========
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetTimer& Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Private Declare Function KillTimer& Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long)


Dim cnt%
Private TIS As TimerInterface 'declare Interface
Implements TimerInterface 'and Implement interface to form


'**********************REQUIRED BY DELEGATON PER METHOD!************************
Private ObjectProcedures() As FunctionSPointerS '<------Class Procedure pointers and addresses!
Private HMEM As Long   '<--------------Memory Handle
Private TIMERPROC As Long  '<---------AddressOf Delegator (who call our Class Method!)
Private HTIMER As Long '<--------Timer Handle
'*******************************************************************************

Private Sub Form_Activate()
    WindowState = 2: BackColor = RGB(166, 166, 144): AutoRedraw = True
    Me.Caption = ""
    WebBrowser1.Move 0, 0, Screen.Width / 2, Screen.Height * 0.9: DoEvents
   
   
       
    WebBrowser1.Navigate "C:\WINDOWS\Desktop\Msgbox.HTM"
       
    Do
    a = WebBrowser1.ReadyState
    If a <> myState Then myState = a: Me.Caption = Me.Caption & "      readystate-->:" & a
    DoEvents
    Loop While a <> myState Or a <> 4
   
    Caption = Caption & "      ***READY***"
   
   
    Set o = WebBrowser1.Document
End Sub

Private Sub Form_Load()
'******************
'REQUIRED! Set Interface Procedure Pointer on TIS to Our Form Implemented Interface!!!
Set TIS = Me
'******************


'REQUIRED BY DELEGATION PER METHOD!**********************************************
ObjectProcedures = GetObjectFunctionsPointers(TIS, 1)
HMEM = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, CalculateSpaceForDelegation(4))
TIMERPROC = GlobalLock(HMEM) 'Get Address
DelegateFunction TIMERPROC, TIS, ObjectProcedures(0).FunctionAddress, 4
'USE DELEGATION For 1st Method In SubclassingInterface Class!!! -->ObjectProcedures(0)
'********************************************************************************


'Set Timer!
HTIMER = SetTimer(Me.hwnd, 0, 0, TIMERPROC) '<<---Call ASM Code!

End Sub

Private Sub Form_Unload(Cancel As Integer)
'Kill Timer!
KillTimer Me.hwnd, HTIMER

'Free Memory Allocated For Delegation
Call GlobalUnlock(HMEM)
Call GlobalFree(HMEM)
End Sub


Private Sub TimerInterface_TIMERPROCEDURE(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    If cnt = 0 Then
    Beep
    Caption = "dwTime: " & dwTime
        Dim fw&
        fw = FindWindow("#32770", "Microsoft Internet Explorer")
        If fw Then SendKeys "{Enter}"
    End If
    cnt = IIf(cnt = 14, 0, cnt + 1)
End Sub





==========
Module1:
==========
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalFree Lib "kernel32.dll" (ByVal HMEM As Long) As Long
Declare Function GlobalLock Lib "kernel32.dll" (ByVal HMEM As Long) As Long
Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal HMEM As Long) As Long


Public Const GMEM_MOVEABLE As Long = &H2
Public Const GMEM_ZEROINIT As Long = &H40


Public Type FunctionSPointerS
FunctionPtr As Long
FunctionAddress As Long
End Type

Public Function CalculateSpaceForDelegation(ByVal NumberOfParameters As Byte) As Long
CalculateSpaceForDelegation = 31 + NumberOfParameters * 3
End Function

Public Function DelegateFunction(ByVal CallingADR As Long, Obj As Object, ByVal MethodAddress As Long, ByVal NumberOfParameters As Byte) As Boolean
On Error GoTo NotSuccess
Dim TmpA As Long
TmpA = CallingADR
CopyMemory ByVal CallingADR, &H68EC8B55, 4
CallingADR = CallingADR + 4
CopyMemory ByVal CallingADR, TmpA + 31 + (NumberOfParameters * 3) - 4, 4
CallingADR = CallingADR + 4

Dim StackP As Byte
StackP = 4 + 4 * NumberOfParameters

For u = 1 To NumberOfParameters
CopyMemory ByVal CallingADR, CInt(&H75FF), 2
CallingADR = CallingADR + 2
CopyMemory ByVal CallingADR, StackP, 1
CallingADR = CallingADR + 1
StackP = StackP - 4
Next u

CopyMemory ByVal CallingADR, CByte(&H68), 1
CallingADR = CallingADR + 1
CopyMemory ByVal CallingADR, ObjPtr(Obj), 4
CallingADR = CallingADR + 4
CopyMemory ByVal CallingADR, CByte(&HE8), 1
CallingADR = CallingADR + 1
Dim PERFCALL As Long
PERFCALL = CallingADR - TmpA - 1
PERFCALL = MethodAddress - (TmpA + (CallingADR - TmpA - 1)) - 5
CopyMemory ByVal CallingADR, PERFCALL, 4
CallingADR = CallingADR + 4
CopyMemory ByVal CallingADR, CByte(&HA1), 1
CallingADR = CallingADR + 1
CopyMemory ByVal CallingADR, TmpA + 31 + (NumberOfParameters * 3) - 4, 4
CallingADR = CallingADR + 4
CopyMemory ByVal CallingADR, CInt(&HC2C9), 2

CallingADR = CallingADR + 2
CopyMemory ByVal CallingADR, CInt(NumberOfParameters * 4), 2

'FINALLY !!! ABSOLUTE CALLING RUTINE!


'WHAT IS BEHIND ASM CODE:
'*****************************
'PUSH EBP
'MOV EBP,ESP
'PUSH OFFSET RETURN ADDRESS

'*********** Depend on Number of Parameters
'PUSH EBP+XX
'  .......
'PUSH EBP+10
'PUSH EBP+0C
'PUSH EBP+08
'***********

'PUSH OBJECT POINTER
'CALL POINTER OBJECT.METHOD
'MOV EAX,DWORD PTR [OFFSET RETURN ADDRESS]
'LEAVE
'RET 00XX Depend on Number of Parameters
'TEMPSTORE dd 00 <------RETURN ADDRESS PTR

'Thats IT! Nothing less than 39 BYTES Of ASM Code!

DelegateFunction = True
Exit Function
NotSuccess:
On Error GoTo 0
End Function
Public Function GetObjectFunctionsPointers(Obj As Object, ByVal NumberOfMethods As Long, Optional ByVal PublicVarNumber As Long, Optional ByVal PublicObjVariantNumber As Long) As FunctionSPointerS()
Dim FPS() As FunctionSPointerS
ReDim FPS(NumberOfMethods - 1)
Dim OBJ1 As Long
OBJ1 = ObjPtr(Obj)
Dim VTable As Long
CopyMemory VTable, ByVal OBJ1, 4
Dim PTX As Long
Dim u As Long
For u = 0 To NumberOfMethods - 1
PTX = VTable + 28 + (PublicVarNumber * 2 * 4) + (PublicObjVariantNumber * 3 * 4) + u * 4
CopyMemory FPS(u).FunctionPtr, PTX, 4
CopyMemory FPS(u).FunctionAddress, ByVal PTX, 4
Next u
GetObjectFunctionsPointers = FPS
End Function




=======================
Class module (name: TimerInterface)
=======================
Public Sub TIMERPROCEDURE(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
End Sub



0
 
LVL 17

Expert Comment

by:vb_elmar
ID: 17175420
==============================
File "C:\WINDOWS\Desktop\Msgbox.HTM" :
==============================


<html><head><title>Test</title>
<script type="text/javascript">
function msgbox () {
  alert('Hello World');
}
</script>

</head>
<body id="HauptBody" onload="javascript:msgbox()" bgcolor="#00FFFF">
</body>
</html>
0

Featured Post

[Webinar] Code, Load, and Grow

Managing multiple websites, servers, applications, and security on a daily basis? Join us for a webinar on May 25th to learn how to simplify administration and management of virtual hosts for IT admins, create a secure environment, and deploy code more effectively and frequently.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question