A Christmas Present (that you didn't ask for)...

In the great tradition of (most) Christmas Presents,
this is one you didn't ask for, you didn't want,
and you will probably never use.

It is a status message / progressbar utility.
A StatusMsg/ProgBar capability is one of the most
serious omissions of wsh/vbs, if not _the_ most
serious omission.  Every other scripting language
(that I know of) does have a StatusMsg/ProgBar
capability.

As you know, scripters have not stood idly by and
accepted this deficiency.  There are a great number
of StatusMsg/ProgBar utilities already available out
there (and most are offered for free).  They are
usually written in vb, but any competent language
could be used.

What is unusual about _THIS_ StatusMsg/ProgBar utility
is that it is written in script.  More specifically,
it is written in vbs using api's called by DynaWrap to
create the graphical interface.  I know what you're
thinking --  DynaWrap is a 3rd-party control, and
not "pure" script.

I would assert that DynaWrap is "almost pure" script.
Here's the argument.  For one, it comes with code,
and so you can reassure yourself that nothing under-
handed is going on.  For another, the code was
originally published in the Microsoft Developer's
Journal, and so by implication it bears the imprimature
of Microsoft.  DynaWrap is no stranger to the scripting
ng's.  It has been mentioned in the scripting ng's for
years (since 1999) and is frequently suggested for use
when somebody wishes to do something outside the realm
of "pure" script.  Finally, it is "lite weight".  The dll
is only 36kb, and there are no vbRuntimes used.  Compared
with (bloated) InternetExplorer, which is the usual
suggestion here for use as a scripting StatusMsg/ProgBar
dialog, DynaWrap is exceedingly "lite weight".

Yes, DynaWrap is lacking in features for use with serious
heavy-duty api's.  Most importantly for gui programming,
it is lacking in any typedef capability, and there is no
provision for callbacks.  With this in mind, a StatusMsg/
ProgBar utility is about as far as one can go with DynaWrap,
because it is a "dialog" -- but the dialog is only "one-way"
(you are telling the user something, but not allowing him/her
to talk back).  It is the "talking-back" part that requires
callbacks.  That is, you need to make provisions for the
system send to you notification messages indicating that
the user is interacting with your dialog (buttons were
clicked, etc).

So here it is, for what it's worth.  The first attachment
is the StatusMsg/ProgBar utility, wrapped up as a scripting
component in a "wsc" file.  You may regester the wsc and
call it from script, or you may also just load it from a
local file.  Or, if you don't like dealing with components,
you can just extract the relevant code and stick it directly
into your script.  The other attachment is a demo script.
The "boilerplate" below describes how to get DynaWrap,
just in case you don't have it.

cheers, jw


--- <DynaWrap Boilerplate> ---
It is possible to declare-and-call an api from script,
but you must use a third-party control to do so,
or else write one yourself.

It has already been correctly pointed out that there
is no api-capability in "pure" script.

If you are willing to use a third-party control, then
one such control, called "DynaWrap", can be found on
Guenter Born's website (note: Guenter refers to it as
"DynaCall").  Here is the link to it:

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

On that page you will find a download for the control,
plus some code samples.

Note: you may find additional sample code by searching
the archives of the wsh and vbscript ng's.

Note also: DynaWrap does have its limitations.  There are
certain things it can't do.  For example, you can't call
api's which take typedefs as parameters, and you can't call
api's "by ordinal".  But it will work for most of the
"usual suspects".

And finally, DynaWrap doesn't work entirely as advertised.
For example, it is supposed to allow for the declaration of
several api definitions in one instance of itself.  I could
never get that to work (in win9x).  You will need a new
instance of DynaWrap for every api, or else re-instantiate
the object for every api.  Someday I'm going to learn enough
c++ to fix that...
--- </DynaWrap Boilerplate> ---

<?xml version="1.0"?>
<component>

<?component error="true" debug="true"?>

<registration
description="StatusMsgProgBarDialog"
progid="StatusMsgProgBarDialog.WSC"
version="1.00"
classid="{e3638360-6d72-11da-a061-d0265bc1a60b}"
>
</registration>

<public>
<property name="pbBackColor">
<get/>
<put/>
</property>
<property name="pbForeColor">
<get/>
<put/>
</property>
<property name="titlebarCaption">
<get/>
<put/>
</property>
<property name="txtStatusMessage">
<get/>
<put/>
</property>
<property name="iPctComplete">
<get/>
<put/>
</property>
<method name="Create_ProgbarDialog">
<PARAMETER name="sCaption"/>
</method>
<method name="PostStatusAndPct">
<PARAMETER name="sStatusMsg"/>
<PARAMETER name="iPct"/>
</method>
<method name="CloseDialog">
</method>
</public>

<script language="VBScript">
<![CDATA[
Option Explicit
'
' --- description block --------------------------
' Title: A Status Message / Progressbar Utility...
'
' Description: O.K., so there are plenty of these dialogs around,
' but it was in intriguing challenge to program this
' with DynaWrap...
'
' Author: mr_unreliable
'
' Usage: Use at you own risk, tested on win98se...
'
' --- revision history ---------------------------
' 10Dec05: original attempt, using the wshATO "MakeWindow" script as inspiration...
' 11Dec05: couldn't get valid instance handle for THIS script, and so using
' the desktop instance handle, for now. (Maybe inspiration will strike later)...
' 11Dec05: in an attempt to get color into the progbar, used "SetTextColor" but
' that didn't work(?). So, used "DrawText" to draw the text (i.e., the blocks)
' to the textbox, but that apparently draws "on" the box, not "in" the box,
' that is, the image doesn't "persist" (ugh!)...
' 12Dec05: changing approach to using a static control, and inserting a bitmap
' image (i.e., a "rectangle" drawn in to resemble a progbar)...
' 14Dec05: redraw the bitmap "every time" (rather than attempting to retain/modify it)...
' 15Dec05: move the status msg / progbar dialog code to a "wsc" component,
' for the "usual reasons", i.e., "packaging"...
' --- end of description block -------------------
'
' --- global variables ---------------------------
Dim oDW ' as object (instantiated later)...
Dim m_hWndDlg, m_hStatic, m_hProgbar ' as long(s) (handles)
Dim m_hFontMsg, m_hFontLogo ' as font handle(s)
Dim m_hInstance ' as instance handle

Dim wdDlg : wdDlg = 440
Dim htDlg : htDlg = 115
Dim wdProgbar, htProgbar ' as long
'
Dim hDCProgbar, hDCPBSave ' as long
Dim hBmp : hBmp = 0 : Dim hDCMem : hDCMem = 0 ' as handles to system objects
Dim hBackPen, hBackBrush ' as long (handles)
Dim hBarPen, hBarBrush ' as long (handles)
'
Dim pbBackColor : pbBackColor = "&HFFFFFF" ' white
Dim pbForeColor : pbForeColor = "&HFF0000" ' blue
Dim titlebarCaption : titlebarCaption = " StatusMsg / ProgressBar Dialog "
Dim txtStatusMessage: txtStatusMessage = " StatusMsg goes here... "
Dim iPctComplete : iPctComplete = 0

' system constants (oops, can't use constants here -- FOR SHAME MICROSOFT!!!)
Dim SW_HIDE : SW_HIDE = 0 ' showwindow constants
Dim SW_SHOW : SW_SHOW = 5
Dim FW_NORMAL : FW_NORMAL = 400 ' 100=Light, 400=Normal, 700=Bold, 900=Heavy
Dim FW_BOLD : FW_BOLD = 700
'
Dim nRtn ' as long (hold api return value)
' --- End of declarations and constants ----------

Public Function get_pbBackColor()
get_pbBackColor = pbBackColor
End function

Public Function put_pbBackColor(crNew)
pbBackColor = crNew
End function

Public Function get_pbForeColor()
get_pbForeColor = pbForeColor
End function

Public Function put_pbForeColor(crNew)
pbForeColor = crNew
End function

Public Function get_titlebarCaption()
get_titlebarCaption = titlebarCaption
End function

Public Function put_titlebarCaption(sNewCaption)
titlebarCaption = sNewCaption

' todo: add code to insert this caption into the titlebar...
End function

Public Function get_txtStatusMessage()
get_txtStatusMessage = txtStatusMessage
End function

Public Function put_txtStatusMessage(sNewMsg)
txtStatusMessage = sNewMsg

' stick the new status message into the static control...
Call SetWindowText(m_hStatic, txtStatusMessage)

Call UpdateWindow(m_hWndDlg) ' otherwise known as: form.refresh

End function

Public Function get_iPctComplete()
get_iPctComplete = iPctComplete
End function

Public Function put_iPctComplete(iNewPctComp)
iPctComplete = iNewPctComp

Call RepaintProgBar(iPctComplete) ' update progbar...

Call UpdateWindow(m_hWndDlg) ' otherwise known as: form.refresh

End function


' --- CREATE PROGBAR DIALOG ----------------------

Public Function Create_ProgbarDialog(sCaption, pxLeft, pxTop)
' MsgBox(sCaption)

Dim hWndDlg, hLogo ' as long(s) handles
Dim dwStyle, dwExStyle ' as long
'
Const WS_VISIBLE = &H10000000 ' window style bits
Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
Const WS_POPUP = &H80000000
Const WS_CHILD = &H40000000
'
Const WS_EX_NOPARENTNOTIFY = &H4
Const WS_EX_CLIENTEDGE = &H200
'
Const SS_BITMAP = &H0000000E ' static control style bits
'
Const WM_SETFONT = &H30
'
Const PS_SOLID = 0 ' pen style
'
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
Const SWP_NOSIZE = &H1
Const SWP_SHOWWINDOW = &H40
Const HWND_TOPMOST = -1
'
Dim swpFlags ' as long
' --- end of declarations and constants ----------

titlebarCaption = sCaption

' get an instance handle for THIS instance of wscript (tricky)...
m_hInstance = GetInstanceHandle()

dwStyle = WS_POPUP Or WS_CAPTION
dwExStyle = WS_EX_NOPARENTNOTIFY

' ----------------------------------------------
' note: typically, one would set up a window class of one's own, so as to
' be able to define the look-and-feel of the window. That is, the icon
' the cursor, the background/text colors, etc. But more importantly,
' you also supply a wndproc address, i.e., a routine to process messages
' coming from the window (i.e., to detect "events").
' But that requires a typedef, and a wndproc, things that are way
' beyond the capabilities of DynaWrap. And so, we will attempt to
' get by with a "system standard" window class, namely: "#32770"...
' That is the standard "dialog class", and as such there is a "default
' wndproc" built into the system, which will handle the minimal functions
' expected of a window. (Good Luck!)...
' ----------------------------------------------
hWndDlg = CreateWindowEx(0, "#32770", titlebarCaption, dwStyle, _
pxLeft,pxTop, wdDlg,htDlg, 0, 0, m_hInstance, 0) ' was CStr(m_sWndClass)
' ----------------------------------------------

' add some (child) controls to the window (note: static = label)...
m_hStatic = CreateWindowEx(0, "Static", "Script Status Messages go here.. ", _
WS_CHILD Or WS_VISIBLE, 20, 5, wdDlg - 20, 20, hWndDlg, 0, m_hInstance, 0)

' create the "progbar" window (i.e., using a "static" showing a bitmap)...
wdProgbar = wdDlg - 25 - 6 : htProgbar = 22
m_hProgbar = CreateWindowEx(WS_EX_CLIENTEDGE, "Static", "", _
WS_CHILD Or WS_VISIBLE Or SS_BITMAP , 10, 35, wdProgbar, htProgbar, hWndDlg, 0, m_hInstance, 0)

hLogo = CreateWindowEx(0, "Static", "brought to you by jawar productions (all rights reserved)... ", _
WS_CHILD Or WS_VISIBLE, wdDlg - 290, 75, 380, 25, hWndDlg, 0, m_hInstance, 0)


' (note: should probably go get these colors from sysinfo)...
hBackPen = CreatePen(PS_SOLID, 1, pbBackColor) ' C0C0C0) ' msGray
hBackBrush = CreateSolidBrush(pbBackColor) ' C0C0C0) ' aka, Silver

hBarPen = CreatePen(PS_SOLID, 1, pbForeColor) ' crBlue)
hBarBrush = CreateSolidBrush(pbForeColor) ' crBlue)

Call RepaintProgBar(0) ' paint in background...

' create fonts (otherwise the default fonts for this system will be used)...
m_hFontMsg = GetFontHandle("MS Sans Serif", 10, 0, FW_BOLD, False)
m_hFontLogo = GetFontHandle("Arial", 7, 0, FW_NORMAL, True) ' aspect ratio = 0 is default

' now, set prepared fonts into their respective controls.
Call SendMessage(m_hStatic, WM_SETFONT, m_hFontMsg, 0)
Call SendMessage(hLogo, WM_SETFONT, m_hFontLogo, 0)

' Call ShowWindow(hWndDlg, SW_SHOW) ' show the window here...
' msgbox("ck static")

' show the window here, and attempt to push it to the front...
swpFlags = SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
Call SetWindowPos(hWndDlg, HWND_TOPMOST, 0, 0, 0, 0, swpFlags)

' note: this "ought not" to be necessary, but without it the logo
' seems to be reluctant to initially appear (paint itself)???
Call UpdateWindow(hWndDlg) ' otherwise known as: form.refresh

Create_ProgbarDialog = hWndDlg ' return value (window handle)

End Function


' --- POST STATUS MSG _AND_ PCT COMPLETE ---------

Public Function PostStatusAndPct(sNewMsg, iNewPctComp)
txtStatusMessage = sNewMsg
iPctComplete = iNewPctComp

' stick the new status message into the static control...
Call SetWindowText(m_hStatic, txtStatusMessage)

Call RepaintProgBar(iPctComplete) ' update progbar...

Call UpdateWindow(m_hWndDlg) ' otherwise known as: form.refresh

End function


' --- CLOSE DIALOG -------------------------------

Public Function CloseDialog()

Call ShowWindow(m_hWndDlg, SW_HIDE) ' hide the window, before messing around...

' nota bene: if you save/restore the COMPLETE device context, then
' you don't need to put the dc back the way it was before exiting...
' clean-up gdi system objects...
Call RestoreDC(hDCProgbar, hDCPBSave) ' return progbar DC to original state

Call DestroyWindow(m_hWndDlg)

' release "system objects" (we do our bit to help prevent "memory leaks")...
Call DeleteObject(hBmp)

Call DeleteObject(hBackPen) ' return system object(s)
Call DeleteObject(hBackBrush)

Call DeleteObject(hBarPen) ' return system object(s)
Call DeleteObject(hBarBrush)

Call DeleteObject(m_hFontMsg)
Call DeleteObject(m_hFontLogo)

End Function


' ================================================
' PRIVATE (INTERNAL) FUNCTIONS, (from here on out)
' ================================================

' --- REPAINT PROGBAR ----------------------------

Private Function RepaintProgBar(iPct)
Const STM_SETIMAGE = &H172 ' winuser.h
Const IMAGE_BITMAP = 0

' ==============================================
' Discussion: dealing with the problem of "persistance". You can get a reference
' to the device context of a static control, set the fore/back colors and then
' draw shapes or text on it, and it looks ok. BUT what is happening is that
' you are drawing on the screen. You can see what you draw, at least when
' you draw it -- but if your window gets hidden and then re-appears that drawing
' will have disappeared. In geek-speak, your image didn't "persist".
'
' In vb, that "persistance" issue is auto-magically taken care of for you.
' VB intercepts any system messages telling you to re-draw the control, and
' does it. However, in this case we are "flying-without-the-net", i.e., we
' are relying on the "default wndproc's" because we can't setup a callback
' wndproc for our window with dynawrap.
'
' And so, we are going to have to take other measures to insure that we get
' "persistance" of the progbar graphics. We are going to use "brute force".
' That is, we are going to make up a "memory bitmap" with the graphics we want,
' and then insert the bitmap into an appropriately-styled static control,
' which will then take over and resolutely display the graphics "come-what-may"...
' ==============================================

' get device context (of the progbar/static control)...
hDCProgbar = GetDC(m_hProgbar)
' save existing device context of control, before messing around (DA, pg 490)...
hDCPBSave = SaveDC(hDCProgbar)

Dim hNewBmp
' create a bitmap (compatible with the display), in memory...
hNewBmp = CreateCompatibleBitmap(hDCProgbar, wdProgbar, htProgbar)
BugAssert (hNewBmp <> 0), " could not create compatible bitmap"

' then create a "memory device" compatible DC...
hDCMem = CreateCompatibleDC(hDCProgbar)
BugAssert (hDCMem <> 0), " could not create compatible dc"

' select the new bitmap, pen and brush objects into the (memory) device context...
Dim hPrevBmp, hPrevPen, hPrevBrush ' as long
hPrevBmp = SelectObject(hDCMem, hNewBmp)
hPrevPen = SelectObject(hDCMem, hBackPen) ' select pen into DC...
hPrevBrush = SelectObject(hDCMem, hBackBrush)

' clean up (erase) the memory bitmap, by painting in a rectangle with the
' background (msGray) color. This is being done because the progressbar bar
' doesn't initially fill up the static control...
' Windows draws the outline of the figure with the current pen selected,
' and the figure is filled with the current brush selected (CP 558)...
nRtn = Rectangle(hDCMem, 0,0, wdProgbar, htProgbar)
BugAssert (nRtn <> 0), " .. Rectangle returned an error"

' --- draw in the progbar, if any --------------
If (iPct > 0) then
' change pens (to draw color portion)...
hPrevPen = SelectObject(hDCMem, hBarPen) ' select pen into DC...
hPrevBrush = SelectObject(hDCMem, hBarBrush)

' calculate the length of the progbar. Let 100pct be (wdProgbar - 2).
' then, the length is iPct/100 * (wdProgbar - 2)...
Dim pxProgbar : pxProgbar = iPct/100 * (wdProgbar - 2)
nRtn = Rectangle(hDCMem, 2,2, pxProgbar, htProgbar - 1) ' allowance for frame
BugAssert (nRtn <> 0), " .. Rectangle returned an error"
End If ' test iPct
' --- finished with drawing the progbar --------

' set bitmap image into the static control...
nRtn = SendMessage(m_hProgbar, STM_SETIMAGE, IMAGE_BITMAP, hNewBmp)

' cleanup time...
Call SelectObject(hDCMem, hPrevBmp) ' probably not necessary (see RestoreDC)
if (hBmp <> 0) then Call DeleteObject(hBmp) ' release old bitmap...
hBmp = hNewBmp ' preserve this (new) bitmap, while it's being displayed

' finished drawing, restore device context, release system resources...
Call RestoreDC(hDCMem, hDCPBSave) ' note PB DC same as original hDCMem(?)
Call DeleteDC(hDCMem)
Call ReleaseDC(m_hProgbar, hDCProgbar)
' ==============================================

' Call UpdateWindow(m_hWndDlg) ' otherwise known as: form.refresh

End Function



' --- GET INSTANCE HANDLE (of Desktop -- cheat, cheat) ---

Private Function GetInstanceHandle()
' Dim hInstance

' Discussion: getting an instance handle with vb is easy, as there is
' an already defined hInstance property of the vbApp object.
' Unfortunately, wscript doesn't provide this, so we will have to
' go get it using "brute force" (i.e., go get it the hard way).
' That involves some tricky-dicky stuff. First, we are going to
' have to find wscript's "hidden window" (yes Dorothy, there _IS_
' a wscript window -- how do you think wscript communicates with
' the system, eh?). Assuming we can find that hidden window, then
' we can use that go get our hInstance, using gwl_hInstance which
' gets the instance handle for a window...
' --- end of discussion --------------------------

' get an instance handle (from vbApp object, for now),
' but that's not a "pure" DynaWrap play...
' hInstance = oATO.vbApp.hInstance ' requires wshATO, verboten here...

' More Discussion: had to temporarily give up on getting the hInstance
' for THIS script. Enumming the "thread windows" would have found it
' directly, but that requires a "callback routine" which can't be done in
' script without using something with more capabilities than DynaWrap.
' Another approach would be enumming ALL the desktop windows, which would
' work with DynaWrap, using getDesktop window and then GetNextWindow on
' down the chain, but then, if you have more than one wscript instance
' running, how do you detect which one is yours??? (Maybe comparing
' command lines would work -- if one could guarantee a unique command line)...
'
' And so for now, we will be using the "desktop instance", which is easy
' to get. (Caveat Emptor: if your window uses the wscript instance, then
' the window auto-magically goes away when your script terminates.
' But, if you use the "desktop instance" then you better make sure that
' you kill the window BEFORE you close, or the window is most likely to
' hang around forever). Yes, yes, I know, it's ugly...
' --- end of discussion (part2) ------------------

Dim hDesktop ' as long (handle)
Const GWL_HINSTANCE = (-6)
Dim hDeskInstance ' as long (handle)

hDesktop = GetDesktopWindow()
hDeskInstance = GetWindowLong(hDesktop, GWL_HINSTANCE)

GetInstanceHandle = hDeskInstance ' hInstance ' return result
End Function


' --- GET FONT HANDLE ----------------------------

Private Function GetFontHandle(sFontName, ptSiz, AspectRatio, fntWeight, vItalic)
Dim hFont ' as font handle
' font-related constants, (note: the "weight constants defined globally)...
' Const FW_NORMAL = 400 ' 100=Light, 400=Normal, 700=Bold, 900=Heavy
' Const FW_BOLD = 700
'
Const DEFAULT_ASPECTRATIO = 0
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_DONTCARE = 0
'
Const LOGPIXELSY = 90 ' Logical pixels/inch in Y
' --- end of declarations and constants ----------

' Make it negative, so as to apply to "glyph", rather than "cell".
' Dim cf_PtSize : cf_PtSize = - CSng(GetDeviceCaps(GetDC(hWndDlg), LOGPIXELSY) / 72)
' forget the api's for now, just plug it in...
Dim cf_PtSize : cf_PtSize = - CSng(96 / 72) ' micron crt logpixelsy = 96
' --- finished with font conversion factor -----

Dim htFont, wdFont ' as long
htFont = Int(ptSiz * cf_PtSize)
wdFont = Int((ptSiz * cf_PtSize) * AspectRatio) ' was DEFAULT_ASPECTRATIO

' convert vbScript boolean to system true/false...
Dim bItalic ' as system t/f
If vItalic then
bItalic = 1 ' system true, i.e., want it as italic
Else
bItalic = 0 ' system false, i.e. not italic (regular)
End If

hFont = CreateFont(htFont, wdFont, 0, 0, fntWeight, bItalic, _
0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
DEFAULT_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, sFontName)

GetFontHandle = hFont
End Function



' ================================================
' ================================================
' === "WRAPPERS" FOR API CALLS (DynaWrap style) ==
'
' the DynaWrap doc is rather inscrutable, but as best I can make out,
' DynaWrap can only accomodate ONE api declaration at a time.
' (If I'm wrong, maybe you experts can straighten me out on this).
'
' Assuming that my one-at-a-time hypothesis is correct,
' then one has two choices:
' - you need to set up a separate obj for EVERY api (ugh!), or
' - declare the api's to be used (one-at-a-time) as you go,
' which is what you see here (yes, it's "ugly")...

' ----------------------------------------------
' the DynaWrap parameters are:
' i => the number and data type of the function's parameters
' f => type of call _stdcall or _cdecl.
' (Default to _stdcall. If that doesn't work use _cdecl).
' r => return data type.

' the data type declarations are:
' c => VT_I4: c signed char
' d => VT_R8: d 8 byte real
' f => VT_R4: f 4 byte real
' h => VT_I4: h HANDLE
' l => VT_I4: l long
' p => VT_PTR: p pointer
' s => VT_LPSTR: s string
' t => VT_I2: t short
' u => VT_UINT: u unsigned int
' w => VT_LPWSTR: w wide string
' r => VT_BYREF: (pass by reference) for strings only.
'
' the call type declarations are:
' s => _stdcall (standard vb-type call)
' => _cdecl (c++ type call)
' ----------------------------------------------

' ================================================
' ================================================



Private Function CreateWindowEx(dwExStyle, sClassName, sWindowName, dwStyle, dwLeft,dwTop, _
dwWidth,dwHeight, hWndParent, hMenu, hInstance, lpParam)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "CreateWindowExA", "i=lsslllllllll", "f=s", "r=h"
CreateWindowEx = oDW.CreateWindowExA(CLng(dwExStyle), CStr(sClassName), CStr(sWindowName), _
CLng(dwStyle), CLng(dwLeft),CLng(dwTop), CLng(dwWidth),CLng(dwHeight), _
CLng(hWndParent), CLng(hMenu), CLng(hInstance), CLng(lpParam))
End Function


' Declare Function CreatePen Lib "gdi32" Alias "CreatePen" _
' (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Private Function CreatePen(nPenStyle, nWidth, crColor)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "CreatePen", "i=lll", "f=s", "r=l"
CreatePen = oDW.CreatePen(CLng(nPenStyle), CLng(nWidth), CLng(crColor))
End Function

' Declare Function CreateSolidBrush Lib "gdi32" Alias "CreateSolidBrush" _
' (ByVal crColor As Long) As Long

Private Function CreateSolidBrush(crColor)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "CreateSolidBrush", "i=l", "f=s", "r=l"
CreateSolidBrush = oDW.CreateSolidBrush(CLng(crColor))
End Function

' Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
' (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Function SendMessage(hWnd, wMsg, wParam, lParam)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "SendMessageA", "i=llll", "f=s", "r=l"
SendMessage = oDW.SendMessageA(CLng(hWnd), CLng(wMsg), CLng(wParam), CLng(lParam))
End Function

' Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
' (ByVal hWnd As Long, ByVal lpString As String) As Long

Private Function SetWindowText(hWnd, lpString)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "SetWindowText", "i=ls", "f=s", "r=l"
SetWindowText = oDW.SetWindowText(CLng(hWnd), CStr(lpString))
End Function

' Declare Function ShowWindow Lib "user32" Alias "ShowWindow" _
' (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Private Function ShowWindow(hWnd, nCmdShow)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "ShowWindow", "i=ll", "f=s", "r=l"
ShowWindow = oDW.ShowWindow(CLng(hWnd), CLng(nCmdShow))
End Function

' Declare Function SetWindowPos Lib "user32" Alias "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) As Long

Function SetWindowPos(hWnd, hWndInsertAfter, x,y, cx,cy, wFlags)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "SetWindowPos", "i=lllllll", "f=s", "r=l"
SetWindowPos = oDW.SetWindowPos(CLng(hWnd), CLng(hWndInsertAfter), _
CLng(x), CLng(y), CLng(cx), CLng(cy), CLng(wFlags))
End Function

' Declare Function UpdateWindow Lib "user32" Alias "UpdateWindow" _
' (ByVal hWnd As Long) As Long

Private Function UpdateWindow(hWnd)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "UpdateWindow", "i=l", "f=s", "r=l"
UpdateWindow = oDW.UpdateWindow(CLng(hWnd))
End Function

' Declare Function DeleteObject Lib "gdi32" Alias "DeleteObject" _
' (ByVal hObject As Long) As Long

Function DeleteObject(hObject)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "DeleteObject", "i=l", "f=s", "r=l"
DeleteObject = oDW.DeleteObject(CLng(hObject))
End Function

' Declare Function DestroyWindow Lib "user32" Alias "DestroyWindow" _
' (ByVal hWnd As Long) As Long

Function DestroyWindow(hWnd)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "DestroyWindow", "i=l", "f=s", "r=l"
DestroyWindow = oDW.DestroyWindow(CLng(hWnd))
End Function

' Declare Function GetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long

Private Function GetDesktopWindow()
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "GetDesktopWindow", "f=s", "r=h" ' no inputs
GetDesktopWindow = oDW.GetDesktopWindow()
End Function


Private Function GetWindowLong(hWnd, nIndex)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "GetWindowLong", "i=ll", "f=s", "r=l"
GetWindowLong = oDW.GetWindowLong(CLng(hWnd), CLng(nIndex))
End Function

' Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long

Private Function GetDC(hWnd)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "GetDC", "i=l", "f=s", "r=l"
GetDC = oDW.GetDC(CLng(hWnd))
End Function

' Declare Function SaveDC Lib "gdi32" Alias "SaveDC" (ByVal hDC As Long) As Long

Private Function SaveDC(hDC)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "SaveDC", "i=l", "f=s", "r=l"
SaveDC = oDW.SaveDC(CLng(hDC))
End Function

' Declare Function CreateCompatibleBitmap Lib "gdi32" Alias "CreateCompatibleBitmap" _
' (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Function CreateCompatibleBitmap(hDC, nWidth, nHeight)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "CreateCompatibleBitmap", "i=lll", "f=s", "r=h"
CreateCompatibleBitmap = oDW.CreateCompatibleBitmap(CLng(hDC), CLng(nWidth), CLng(nHeight))
End Function

' Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" _
' (ByVal hDC As Long) As Long

Private Function CreateCompatibleDC(hDC)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "CreateCompatibleDC", "i=l", "f=s", "r=l"
CreateCompatibleDC = oDW.CreateCompatibleDC(CLng(hDC))
End Function

' Declare Function CreatePen Lib "gdi32" Alias "CreatePen" _
' (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Private Function CreatePen(nPenStyle, nWidth, crColor)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "CreatePen", "i=lll", "f=s", "r=l"
CreatePen = oDW.CreatePen(CLng(nPenStyle), CLng(nWidth), CLng(crColor))
End Function

' Declare Function CreateSolidBrush Lib "gdi32" Alias "CreateSolidBrush" _
' (ByVal crColor As Long) As Long

Private Function CreateSolidBrush(crColor)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "CreateSolidBrush", "i=l", "f=s", "r=l"
CreateSolidBrush = oDW.CreateSolidBrush(CLng(crColor))
End Function

' Declare Function SelectObject Lib "gdi32" Alias "SelectObject" _
' (ByVal hDC As Long, ByVal hObject As Long) As Long

Private Function SelectObject(hDC, hObject)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "SelectObject", "i=ll", "f=s", "r=l"
SelectObject = oDW.SelectObject(CLng(hDC), CLng(hObject))
End Function

' Declare Function Rectangle Lib "gdi32" Alias "Rectangle" _
' (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, _
' ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Function Rectangle(hDC, X1,Y1, X2,Y2)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "Rectangle", "i=lllll", "f=s", "r=l"
Rectangle = oDW.Rectangle(CLng(hDC), CLng(X1), CLng(Y1), CLng(X2), CLng(Y2))
End Function

' Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" _
' (ByVal hWnd As Long, ByVal hDC As Long) As Long

Private Function ReleaseDC(hWnd, hDC)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "USER32.DLL", "ReleaseDC", "i=ll", "f=s", "r=l"
ReleaseDC = oDW.ReleaseDC(CLng(hWnd), CLng(hDC))
End Function

' Declare Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hDC As Long) As Long

Private Function DeleteDC(hDC)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "DeleteDC", "i=l", "f=s", "r=l"
DeleteDC = oDW.DeleteDC(CLng(hDC))
End Function

' Declare Function RestoreDC Lib "gdi32" Alias "RestoreDC" _
' (ByVal hDC As Long, ByVal nSavedDC As Long) As Long

Private Function RestoreDC(hDC, nSavedDC)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "RestoreDC", "i=ll", "f=s", "r=l"
RestoreDC = oDW.RestoreDC(CLng(hDC), CLng(nSavedDC))
End Function


' Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" _
' (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, _
' ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, _
' ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
' ByVal PAF As Long, ByVal F As String) As Long

Private Function CreateFont(Ht, Wd, Es, Ox, Wt, It, Ul, St, Cs, Op, Cp, Q, PAF, sFontName)
Set oDW = nothing ' clear any previous instance
Set oDW = CreateObject("DynamicWrapper") ' start over...
' register (declare) this flavor of api call...
oDW.Register "GDI32.DLL", "CreateFontA", "i=llllllllllllls", "f=s", "r=h"
CreateFont = oDW.CreateFontA(CLng(Ht), CLng(Wd), CLng(Es), CLng(Ox), _
CLng(Wt), CLng(It), CLng(Ul), CLng(St), CLng(Cs), CLng(Op), CLng(Cp), _
CLng(Q), CLng(PAF), CStr(sFontName))
End Function



Private Sub BugAssert (bTest, sErrMsg)
Dim sDblSpace : sDblSpace = vbCrLf & vbCrLf

' BugAssert is a Bruce McKinney creation.
' It is used to test for 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
]]>
</script>
</component>
' make an api window using DynaWrap, jw 10Dec05

Option Explicit

'

' --- description block --------------------------

' Title:   A Status Message / Progressbar Utility... 

'

' Description: O.K., so there are plenty of these dialogs around,

'          but it was in intriguing challenge to program this 

'          with DynaWrap...

'

' Author:  mr_unreliable

'

' Usage:   Use at you own risk, tested on win98se...

'

' --- revision history ---------------------------

' 10Dec05: original attempt, using the wshATO "MakeWindow" script as inspiration...

' 11Dec05: couldn't get valid instance handle for THIS script, and so using

'    the desktop instance handle, for now.  (Maybe inspiration will strike later)...

' 11Dec05: in an attempt to get color into the progbar, used "SetTextColor" but

'    that didn't work(?).  So, used "DrawText" to draw the text (i.e., the blocks)

'    to the textbox, but that apparently draws "on" the box, not "in" the box,

'    that is, the image doesn't "persist" (ugh!)...

' 12Dec05: changing approach to using a static control, and inserting a bitmap

'    image (i.e., a "rectangle" drawn in to resemble a progbar)...

' 14Dec05: redraw the bitmap "every time" (rather than attempting to retain/modify it)...

' 15Dec05: move the status msg / progbar dialog code to a "wsc" component,

'    for the "usual reasons", i.e., "packaging"...

' --- end of description block -------------------

'

' instantiate ActX components here...

Dim oDlg : Call Instantiate_LocalWSC(oDlg, "StatusMsgProgBarDialog.wsc", "")  ' no events

'

' --- module level variables ---------------------

Const m_sCaption = " << A StatusMsg / Progressbar Dialog (made with dynawrap api calls).. >> "

Const sGoodby = "Good-bye folks, and thanks for watching the show... "

'

Dim iPct, iBye  ' as long

Dim sStatusMsg  ' as string

'

Const tDoEvents = 300 ' 100

'

Dim crBlue : crBlue = RGB(0, 0, &HFF)

Dim crGreen: crGreen= RGB(0, &H80, &H80)  ' dk cyan (a.k.a. "teal")

Dim crGrey : crGrey = RGB(&HE0, &HE0, &HE0)  ' (lt grey)

' --- end of declarations and constants ----------





  ' ----------------------------------------------

  ' Note: this script is using a Progbar Dialog, (created with DynaWrap)...

  ' ----------------------------------------------

  oDlg.pbBackColor = crGrey

  oDlg.pbForeColor = crGreen  ' crBlue

  Call oDlg.Create_ProgbarDialog(m_sCaption, 150,150)



  ' ----------------------------------------------

  ' Demo Loop, moving along two pct per loop, to speed things up a bit...

  ' ----------------------------------------------

  For iPct = 2 to 100 step 2



    WScript.Sleep tDoEvents



    ' prepare "status message" text...

    sStatusMsg = "Current Status: Script Processing is " & CStr(iPct) & "% complete." 



    ' oDlg.txtStatusMessage = sStatusMsg  ' set statusmsg only

    ' oDlg.iPctComplete = iPct  ' set pct only

    oDlg.PostStatusAndPct sStatusMsg, iPct  ' update status msg and progbar pct...



  Next  ' iPct



  MsgBox " ..when ready to close the progbar dialog, click OK.  ", vbInformation, _

      " < Pause Here to Review and Admire the Progbar Dialog Results > "



  ' say good-bye to all the good folks out there, 

  '   (reset the statusmsg one last time, and "flash" it)...

  For iBye = 1 to 5

  oDlg.txtStatusMessage = sGoodby

  WScript.Sleep 500

  oDlg.txtStatusMessage = ""

  WScript.Sleep 200

  Next  ' iBye



  oDlg.CloseDialog  ' (and clean up system resources)



Set oDlg = nothing

WScript.Quit







' ------------------------------------------------

' --- Get Local Directory (of this script) -------

' ------------------------------------------------

'

' Note: when fso has been instantiated, then use this: 

'   GetLocalDirectory = fso.GetFile(WScript.ScriptFullName).ParentFolder

'

' --- other suggestions found in the wsh ng, (mikHar)...

'   set shell = createobject("wscript.shell")  ' appropriate for wsh 5.6

'   currentDirectory = shell.currentdirectory  ' (note: not necessarily OF THIS SCRIPT)

'   set fso = createobject("scripting.filesystemobject")  ' for wsh 5.5

'   currentDirectory = fso.getabsolutepathname(".")  ' can't find this one documented(?)

' --- end of other suggestions -------------------

'

' (however, if fso or oShell are NOT instantiated, use the following code,

'   it's more efficient as there are NO additional ole instantiations 

'   required, with all that ugly and slow "late-binding")...

'

Function GetLocalDirectory()

Const sMe = "[GetLocalDirectory], "

Dim iFile  ' as integer



  ' find the LAST backslash...

  iFile = InStrRev(Wscript.ScriptFullName, "\")

    BugAssert (iFile > 0), sMe & " file path problem "  ' if backslash not found...



  ' get the path to this script...

  GetLocalDirectory = Left(Wscript.ScriptFullName, iFile)  ' path (inc "\")... 



End Function  ' getLocalDirectory







' ================================================

' === INSTANTIATE AN UNREGISTERED WSC COMPONENT ==

' ================================================

' (Note: this technique was suggested by Mike Harris (mvp - scripting),

'   see news://microsoft.public.scripting.vbscript, entitled: "wsf vs wsc",

'   and timestamped: 2002-03-26 19:10:05 PST).

'

' suggested syntax:

'

'    set obj = getobject("script:component path#component id")

'

' where component path can be:

'    c:\mypath\mywsc.wsc

'    _or_ \\server\share\mypath\mywsc.wsc

'    _or_ http://server/mysite/mypath/mywsc.wsc 

'

' and, #component id is optional.  

'   You get the 1st component in the WSC by default.  

'   You only need #component id if there is more than one in the WSC, 

'     and you want some other component than the first...

'

' A more exhaustive discussion can be found in the Windows Script Component

'   documentation, at the bottom of the page entitled:

'   "Using a Script Component in an Application"

' --- end of discussion --------------------------



Sub Instantiate_LocalWSC(oWSC, sComponentFileName, sEventPrefix)



  ' get the path to the local directory...

Dim sLocalDir : sLocalDir = GetLocalDirectory()

Dim sComponentPath : sComponentPath = sLocalDir & sComponentFileName

  ' MsgBox(sComponentPath)



  ' go get the (wsc) object...

  ' Set oWSC = WScript.GetObject("script:" & sComponentPath,, sEventPrefix)

  ' uh-oh.  It appears that this approach only works with the VBS getobject

  '   and not the wscript.getobject flavor.

  Set oWSC = GetObject("script:" & sComponentPath) 



  ' (step two:) connect the events, (after making sure you need it)...

  if (sEventPrefix <> "") then WScript.ConnectObject oWSC, sEventPrefix



End Sub  ' Instantiate_LocalWSC







' --- 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 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