Re: Maybe I should try a different approach

James wrote:
Is is possible to simply display a message box with NO BUTTONS for the entire time my script is running, then have it close when my script is done and maybe have some dots keep adding to the text message until the script is fully completed?


hi James,

Since none of "the usual suspects" are going to satisfy you,
here are some suggestions which the professional scripters here
consider "beyond the pale", i.e., outside the limits of acceptable
scripting behavior.

For one, I dislike using IE as a dialog, and much prefer the
3rd-party (actX) controls which bring to scripting the equivalent
of the "vb forms" capability. Here are a couple of examples:

wshDialog (by Peter J.C. van der Klugt):
http://home.hccnet.nl/p.vd.klugt/

KIXForms (by Shawn Tassie). Note that this package was intended
for the KIXtart language, but works perfectly well with wsh/vbs.
http://www.kixforms.org/

With these two packages (and others) you can bring to scripting
just about any dialog you can imagine.

Going even further "beyond the pale", if you are willing to
resort to calling the system api from script, you can get
even more unorthodox, even to the extent of showing a
msgbox WITHOUT any buttons.

Attached you will find an example of that, which I call
the "Three Ugly Hack Script". First, it uses a timer to get
control back to the script, after showing the "modal" msgbox.
(Note: you normally DON'T get control back after showing a
modal dialog). Secondly, I am using an illegal character to
make a little box, thus giving the semblance of a progressbar
(box style) where you normally find the text in the msgbox.
Thirdly, I resized the msgbox to "cut off" the button, with the
thought that "if he/she can see it, they can't click it".
You could also just hide the button, by calling the showwindow
- hide system api. Isn't that the ugliest thing you ever
heard?

cheers, jw
____________________________________________________________

You got questions? WE GOT ANSWERS!!! ..(but, no guarantee
the answers will be applicable to the questions)

p.s., the attached script uses a proprietary utility called
"wsh API Toolkit Object" to call system api's. However,
it could easily be recoded to use the more acceptable
DynaWrap, found here:

http://people.freenet.de/gborn/WSHBazaar/WSHDynaCall.htm

' The "Three Ugly Hack" Script, jw 16Apr00
'
' --- description block --------------------------
'
' Title: The "Three Ugly Hack" Script...
'
' Description: how to use three ugly hacks to turn an
' ordinary MsgBox into a progress dialog (gasp!)...
'
' Author: mr_unreliable
' Website: none at present, (by may be found lurking around vbs ng)
'
' Usage: Use at you own risk, tested on win98se...
'
' --- revision history ---------------------------
' 16Apr00: initial attempt...
' 16Nov00: converted to use api toolkit...
' Nota Bene! The wshATO api call routine can transfer strings
' up to MAX_PATH (260) characters. So you can't get too long-winded
' in setting the text in the msgbox label, or you'll get an error msg.
' In addition, one of the opening lines has to be long enough so that
' the msgbox will be wide enough (about 3in) to hold all the
' "little blocks" that make up the "progress bar"...
' 09Sept02: changed direct wshATO calls to "wrapped" api calls...
' 09Sept02: changed timer from sSubTmr.dll to vbTimer feature of wshATO...
' 11Sept02: added code to resize the mb, after the button has been hidden...
' 11Sept02: revised to use LockWindowUpdate (to hide some ugliness)...
' --- end of description block -------------------

' --- Discussion (added 09Sept02) ----------------
' In this demo script, you can "see" what is going on.
' In other words, you can see the message box appear in its
' original configuration, and then get modified. This was
' done deliberately. However, if you really wanted to use
' this (I hope you don't), then you would want to hide the
' ugliness. To do that, you would "hook" the mb window
' (there is code in the oATO download showing how to do
' "hooking". The hook allows for notification BEFORE the
' MsgBox is shown. You would then perform the "ugly hacks"
' to transform the mb into a prog bar, and then show it.
' Added 11Sept02:
' Or, you could use the more pedestrian LockWindowUpdate,
' (it's less sophisticated, but works just as well)...
' --- end of discussion --------------------------

Option Explicit
'
' instantiate ActX components here...
' (note: using "call instantiate" to provide better info in case obj is missing)
Dim oATO : Call Instantiate (oATO, "wshAPIToolkitObject.ucATO", "oATO_")
'
' --- module level variables ---------------------
' define block character (for "progress bar")
Dim sBlock : sBlock = Chr(127) ' "illegal" character (displays as a little box)
'
Dim nPctComp ' as long
'
' make these handles Dim because no "static" variables...
Dim hMBWnd, hMBTxt, hMBBtn ' as long

' --- declarations and constants -----------------
Const tBeepInterval = 1000 ' timer interval
Const sMBTitle = " << The 'Three Ugly Hack' (or MsgBox Progress Bar) >> "

Const SW_HIDE = 0 ' ShowWindow constants...
Const SW_SHOW = 5
'
Dim tRect ' as object (RECT typedef)
' --- end of declarations and constants ----------


With oATO.vbTimer ' turn on the timer here...
.Interval = tBeepInterval : .Enabled = True
End With

nPctComp = -1 ' initialize flag...

Dim m_hDesktop ' as long
' LockWindowUpdate (so as to not show the mb until it gets reconfigured)...
m_hDesktop = GetDesktopWindow()
Call LockWindowUpdate(m_hDesktop)


' now, show the msgbox (modally),
' and hope to get control back via the timer...
' (Programmer's note: this messagebox has to be wide enough to
' allow the progressbar to fit, that may take some adjustment)
MsgBox "You should be hearing beeps, about one per second. " & vbCrLf _
& " That should convince you that the script is doing stuff, " & vbCrLf _
& " even while this MODAL form is showing!!! " & vbCrLf & vbCrLf _
& " When you get tired of listening to the beeps, click OK", _
vbOKOnly, sMBTitle

' upon return from the msgbox, turn off the timer.
' (for impatient users, if allowed to run out, the timer will be off already)...
oATO.vbTimer.Enabled = False

Set tRect = nothing ' don't need the RECT typedef any more...
Set oATO = nothing ' clean up ATO
WScript.Quit



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

Sub oATO_vbTimerEvent() ' timer event handler...
Dim sPctComp, sPB, sFinished ' as String
'
Const pxHtChange = 55
Dim pxMBHt, pxMBWd ' as integer (mg wd/ht in pixels)

' ring the bell, (as reassurance that timer is firing)...
Call Beep(1000,1000) ' middle C over A

' ----------------------------------------------
' The first time through, do some ugly stuff:
' - Find the mb window, find the mg message (static) window,
' find the button and hide it...
' ----------------------------------------------
If nPctComp = -1 then ' check if first time...
' find the msgbox, get handle...
hMBWnd = FindWindow("#32770", sMBTitle)
BugAssert (hMBWnd <> 0), " ..couldn't find the MsgBox Window"

' find the static (message text) control...
hMBTxt = FindWindowEx(hMBWnd, 0, "Static", 0)
BugAssert (hMBTxt <> 0), " ..couldn't find the static (mbMsgText) control"

' and find the button control...
hMBBtn = FindWindowEx(hMBWnd, 0, "Button", 0)
BugAssert (hMBBtn <> 0), " ..couldn't find the mbButton control"

' looks like we did find the button, so hide it...
Call ShowWindow(hMBBtn, SW_HIDE)

' More Ugly Stuff (gasp!). OK, so this wasn't in the original demo,
' but let's have some fun here, and re-size the mgdialog to get rid of
' that ugly blank space where the OK button used to be...
Set tRect = New clsRECT ' instantiate the RECT typedef...
Call GetWindowRect(hMBWnd, tRect)
' calculate a new height for the msgbox...
pxMBHt = tRect.Bottom - tRect.Top - pxHtChange
pxMBWd = tRect.Right - tRect.Left
' then "MoveWindow" (which also can be used to change the height)...
Call MoveWindow(hMBWnd, tRect.Left, tRect.Top, pxMBWd, pxMBHt, True)

nPctComp = 0 ' reset (so as to move on)...
' now, attempt to change the text...
sPctComp = "Percent Complete is: [" & CStr(nPctComp) & "%]" & vbCrLf & vbCrLf
sPB = String(nPctComp,sBlock) ' generate "progressbar"...
Call SetWindowText(hMBTxt, sPctComp & sPB)
Call UpdateWindow(hMBWnd) ' force update
Call LockWindowUpdate(False) ' UN-lock window update (to show new creation)
Exit Sub ' leave sub directly

' after the first time, advance the "progressbar"...
ElseIf nPctComp >= 0 AND nPctComp < 100 then
nPctComp = nPctComp + 5 ' move along at 5pct per event

' now, attempt to change the text...
sPctComp = "Percent Complete is: [" & CStr(nPctComp) & "%]" & vbCrLf & vbCrLf
sPB = String(nPctComp,sBlock) ' generate "progressbar"...
Call SetWindowText(hMBTxt, sPctComp & sPB)
Call UpdateWindow(hMBWnd) ' force showing text NOW!!!
Exit Sub ' leave sub directly

ElseIf nPctComp >= 100 then ' ckeck LAST time...

' last time, so reset the mb wd/ht back to what it was...
pxMBHt = tRect.Bottom - tRect.Top
pxMBWd = tRect.Right - tRect.Left
Call MoveWindow(hMBWnd, tRect.Left, tRect.Top, pxMBWd, pxMBHt, True)

' change the text (yet again)...
sFinished = "That completes the progressbar demo. " & vbCrLf & vbCrLf _
& " Click the OK button to terminate the script." & vbCrLf & vbCrLf _
& " hope you enjoyed the show, jawar productions"
Call SetWindowText(hMBTxt, sFinished)

' and, show the button...
Call ShowWindow(hMBBtn, SW_SHOW)

oATO.vbTimer.Enabled = False ' turn off the timer...
' Exit Sub ' leave sub
End If ' testing nPctComp...

End Sub



' ================================================
' === API CALL WRAPPERS ==========================
' ================================================

Function LockWindowUpdate(hWndLock)
' Declare Function LockWindowUpdate Lib "user32" Alias "LockWindowUpdate" _
' (ByVal hWndLock As Long) As Long
LockWindowUpdate = oATO.CallAPI("USER32.DLL", "LockWindowUpdate", hWndLock)
End Function

Function GetDesktopWindow()
' Declare Function GetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long
GetDesktopWindow = oATO.CallAPI("USER32.DLL", "GetDesktopWindow")
End Function

Function MoveWindow(hWnd, x, y, nWidth, nHeight, bRepaint)
' Declare Function MoveWindow Lib "user32" Alias "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) As Long
MoveWindow = oATO.CallAPI("USER32.DLL", "MoveWindow", hWnd, x, y, nWidth, nHeight, bRepaint)
End Function

Function GetWindowRect(hWnd, lpRect)
' Declare Function GetWindowRect Lib "user32" Alias "GetWindowRect" _
' (ByVal hWnd As Long, lpRect As RECT) As Long
GetWindowRect = oATO.CallAPI("USER32.DLL", "GetWindowRect", hWnd, lpRect)
End Function

Function UpdateWindow(hWnd)
' Declare Function UpdateWindow Lib "user32" Alias "UpdateWindow" _
' (ByVal hWnd As Long) As Long
UpdateWindow = oATO.CallAPI("USER32.DLL", "UpdateWindow", hWnd)
End Function

Function SetWindowText(hWnd, lpString)
' Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
' (ByVal hWnd As Long, ByVal lpString As String) As Long
SetWindowText = oATO.CallAPI("USER32.DLL", "SetWindowTextA", hWnd, lpString)
End Function

Function ShowWindow(hWnd, nCmdShow)
' Declare Function ShowWindow Lib "user32" Alias "ShowWindow" _
' (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
ShowWindow = oATO.CallAPI("USER32.DLL", "ShowWindow", hWnd, nCmdShow)
End Function

Function FindWindowEx(hWndParent, hWndChildAfter, lpClassName, lpWindowName)
' Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
' (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
FindWindowEx = oATO.CallAPI("USER32.DLL", "FindWindowExA", _
hWndParent, hWndChildAfter, lpClassName, lpWindowName)
End Function

Function FindWindow(lpClassName, lpWindowName)
' Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
' (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
FindWindow = oATO.CallAPI("USER32.DLL", "FindWindowA", lpClassName, lpWindowName)
End Function

Function Beep(dwFreq, dwDuration)
' Declare Function Beep Lib "kernel32" Alias "Beep" _
' (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Beep = oATO.CallAPI("KERNEL32.DLL", "Beep", dwFreq, dwDuration)
End Function

' --- end of api wrappers ------------------------



' ================================================
' === RECTANGLE (RECT) TYPEDEF CLASS WRAPPER =====
' ================================================

Class clsRECT

' These definitions of the typedef fields OUGHT to be Const declarations.
' However, private const definitions apparently DON'T WORK in a class code.
' (Shame on you Microsoft). So, we are declaring them here,
' and assigning values in the init code.
'
' Private Type RECT ' field name (byte offset)
Private m_Left ' Left As Long (byte 0)
Private m_Top ' Top As Long (byte 4)
Private m_Right ' Right As Long (byte 8)
Private m_Bottom ' Bottom As Long (byte 12)
' End Type
'
Private cbRECT ' as long (byte count of this typedef)
Private adrRECT ' as long
Private tR ' as string (key) = "tR"
'
Private sMe
'
' --- end of declarations and constants ----------

' --- Discussion about storing values in the typedef ---
' Sorry, but you can't use the normal vbScript replace statements.
' You have to use oATO.PutLong (or putWhatever), as it behaves
' something like a "CopyMemory", and gets a long (or whatever)
' into the typedef, instead of a variant...
' --- end of discussion --------------------------

Public Property Get Left()
Left = oATO.GetLong(tR, m_Left)
End Property

Public Property Let Left(vRHS)
oATO.PutLong(tR, m_Left) = vRHS
End Property

Public Property Get Top()
Top = oATO.GetLong(tR, m_Top)
End Property

Public Property Let Top(vRHS)
oATO.PutLong(tR, m_Top) = vRHS
End Property

Public Property Get Right()
Right = oATO.GetLong(tR, m_Right)
End Property

Public Property Let Right(vRHS)
oATO.PutLong(tR, m_Right) = vRHS
End Property

Public Property Get Bottom()
Bottom = oATO.GetLong(tR, m_Bottom)
End Property

Public Property Let Bottom(vRHS)
oATO.PutLong(tR, m_Bottom) = vRHS
End Property

' provides memory address (i.e., a long pointer)...
Public Default Property Get adrSTRUCT()
adrSTRUCT = adrRECT
End Property

Sub Class_Initialize()
sMe = "[clsRECT], "
' MsgBox(sMe & "Initializing")

' fill in the typdef field constants,
' (maybe SOMEDAY we can just use: Private Const dwLength = 0)...
m_Left = 0 ' Left As Long (byte 0)
m_Top = 4 ' Top As Long (byte 4)
m_Right = 8 ' Right As Long (byte 8)
m_Bottom = 12 ' Bottom As Long (byte 12)

cbRECT = 16 ' (byte count)
tR = "tR" ' (key)

On Error Resume Next ' turn on error checking
' create the typedef itself...
' (note: CreateTypeDef allocates memory and clears to zeros)
adrRECT = oATO.CreateTypDef(tR, cbRECT)
' no need to set bytecount for THIS typedef/structure...

' check to make sure that the typedef creation succeeded...
BugAssert (err.number = 0), sME & "Unable to create typedef, " & vbCrlf _
& " most likely because oATO is not instantiated properly... "
On Error goto 0 ' turn off error checking...

End Sub

Sub Class_Terminate()
' MsgBox(sMe & "Terminating")
oATO.DestroyTypDef(tR) ' return typedef memory block(s)...
End Sub

End Class ' clsRECT



' ================================================
' === INSTANTIATE ACTX OBJ and BUGASSERT =========
' ================================================


' --- 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)
Dim sDblSpace : sDblSpace = vbCrLf & vbCrLf

' BugAssert is a Bruce McKinney creation.
' It is used to test for valid intermediate results...

if bTest then Exit Sub ' normally (hopefully) test returns true...

MsgBox "Error Message reported by BugAssert: " & sDblSpace _
& sErrMsg & sDblSpace & " this script will terminate NOW. ", _
vbCritical, " << BugAssert FAILED in Script: " & Wscript.ScriptName & " >> "
WScript.Quit

End Sub


Loading