2013-06-19 07:49

' wshRQStatusMsgProgBarDemo, jw 19Aug00
'
' --- description block --------------------------
'
' Title:   demo rqStatusMsg/ProgBar Helper Utility...
'
' Description: demo script, to show how to use WM_SETTEXT
'          to send messages to another process (or another
'          script).
'          In this case, we are sending wm_settext messages
'          to a helper utility, which will be showing
'          status messages and a progress bar...
'
' 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 ---------------------------
' 19Aug00: initial attempt...
' 04Sept02: revised to use wshATO instead of DynaWrap,
'   to call api's, AND wrapping up all the api calls to
'   resemble vb api calls.  After all "we-do-eat-our-own-dogfood"...
' 04Sept02: also, "modernized" this code a bit, by recycling
'   some code from "automating non-Com apps" class code...
' --- end of description block -------------------
'
     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", "")  ' (no events)
     DIM oShell : SET oShell = WScript.CreateObject("WScript.Shell")

     DIM nRtn  ' as long
     DIM nPct  ' as Integer

     DIM sProgBarPath  ' as string
     CONST sProgBarExe = "rqStatusMsgProgBar.exe"  ' as string
'
     CONST sMainWinClass = "TForm"
     CONST sMainWinCaption = "< rq StatusMessage / ProgressBar Helper Utility >"
     CONST sTxtBoxClass = "TEdits"
     CONST ID_TXTBOX = 1324  ' (uh-oh. This value is NOT consistent)
'
     DIM m_hMainWnd, m_hTxtBox  ' as long(s)
' --- end of declarations and constants ----------


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

  ' get THIS path (assume progbar helper is here)...
     sProgBarPath = GetLocalDirectory() & sProgBarExe
  ' MsgBox("[frmLoad], sProgBarPath: " & sProgBarPath)

  ' launch the other script (or app)...
     nRtn = oShell.RUN(sProgBarPath, 1, False)  ' (don't wait)

  ' ----------------------------------------------
  ' At this point, the helper utility should be launched and running.
  '   Allow a short time for the utility to initialize,
  '   then find the txtBox (window) to write to and get its handle,
  '   then "ping it" to make sure it is alive and responding.
  ' ----------------------------------------------
     WScript.SLEEP 400  ' allow time for helper app to load (adjust to suit)
     m_hMainWnd = WaitForWindow(sMainWinClass, sMainWinCaption)
  ' now, go get the child window, i.e., the hidden text box,
  '   which is used for inter-process communication...
  ' m_hTxtBox = GetDlgItem(m_hMainWnd, ID_TXTBOX)  ' get textbox hWnd
  ' Ugh!!!  That didn't work because apparently RapidQ doesn't follow
  '   the usual windows (i.e., Microsoft) practice of using consistent
  '   child id's.  So, we will have to revert to the "old-fashioned"
  '   (slower) way of finding a child window...
     m_hTxtBox = FindWindowEx(m_hMainWnd, 0, sTxtBoxClass, "")  ' get textbox hWnd
     BugAssert (m_hTxtBox <> 0), sMe & "couldn't find hidden Textbox Window"

  ' verify that communications with the helper utility are working...
     CALL WriteStringToDialog("ping")  ' ping the helper dialog...

  ' post your opening message...
     WScript.SLEEP 100  ' 0.1 sec
     CALL WriteStringToDialog("Start of Demo Script")

  ' ----------------------------------------------
  ' plod through the demo, a little at a time...
     FOR nPct = 2 TO 100 STEP 2

      WScript.SLEEP 300
      CALL WriteStringToDialog("Sending:  " & CStr(nPct) & "% Complete")

    ' periodically send a status message...
      IF (nPct MOD 10) = 0 THEN
       CALL WriteStringToDialog("Milestone Message, script is:  " & CStr(nPct) & "pct Complete")
      END IF
     NEXT

  ' finished with demo, say sayonara folks...
     WScript.SLEEP 300
     CALL WriteStringToDialog("That's all folks... ")
     WScript.SLEEP 50
     CALL WriteStringToDialog("   (this script will close in 2 seconds) ")
     WScript.SLEEP 50
     CALL WriteStringToDialog("    ")  ' bump up the last message to emphasize it...

     WScript.SLEEP 2500  ' 2 secs, (plus a little extra for slow readers)...
     CALL WriteStringToDialog("Quit")

' Cleanup:  (oops, no labels in vbs)
     SET oShell = nothing
     SET oATO = nothing
     WScript.Quit


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



' --- SET WINDOW TEXT IN HELPER COMMUNICATIONS WINDOW ---

     SUB WriteStringToDialog(sMsg)
      CONST sMe = "[WriteStringToDlg], "
      DIM iTry  ' as integer
      CONST WM_SETTEXT = &HC
'
      DIM sInvalidHWnd : sInvalidHWnd = sMe & "Inter-Process Message Box gone, " _
       & vbCrLf & vbCrLf & "USER CANCELLED HELPER UTILITY, SCRIPT TERMINATING NOW"

  ' Dan Appleman says that SetWindowText and Sending a WM_SETTEXT Message are
  '   the same.  Sorry Dan, but you are WRONG, WRONG, WRONG!
  ' SetWindowText sets the caption text, but... for a textbox the caption text
  '   doesn't ever appear on the screen, or more importantly in the textbox itself.
  ' However, sending a WM_SETTEXT does plunk down the string into the textbox,
  '   and further, it triggers firing of the onChange event for the textbox (whew!).

  ' Note: before (blindly) sending messages to a window, it's good programming
  '   practice to make sure the window handle is still valid,
  '   (to handle the situation where the user may have closed the dialog
  '   either by clicking the cancel button or close [X])...
  ' nRtn = IsWindow(m_hTxtBox)  ' non-zero means yes (i.e., window is valid)...
  '   BugAssert (nRtn <> 0), sInvalidHWnd

  ' before sending the text string, make sure that the helper has cleared the
  '   txtbox, just to make sure that we are not sending messages too fast for
  '   the helper to handle them...
      FOR iTry = 1 TO 5

       BugAssert (IsWindow(m_hTxtBox) <> 0), sInvalidHWnd  ' is window still valid?
    ' get text length (easier than getting the actual text)...
       nRtn = GetWindowTextLength(m_hTxtBox)
       IF nRtn = 0  THEN  EXIT FOR
    ' if the textbox hasn't been cleared yet,
    '   then wait-a-bit, and go around again...
       WScript.SLEEP 50
      NEXT  ' iTry

  ' if the program flow gets here, and nRtn NOT zero, then helper is not responding...
      BugAssert (nRtn = 0), sMe & "helper utility error, txtbox wouldn't clear"

  ' send the string, using wm_settext...
      BugAssert (IsWindow(m_hTxtBox) <> 0), sInvalidHWnd  ' is window still valid?
      nRtn = SendMessage(m_hTxtBox, WM_SETTEXT, 0, sMsg)

     END SUB


' --- WAIT FOR WINDOW TO APPEAR ------------------

     FUNCTION WaitForWindow(sClass, sCaption)  ' returns object
      CONST sMe = "[WaitForWindow], "
      CONST tWaitLimit = 1000
      CONST tWait = 200  ' (wait delay in millisec)
      DIM hWnd  ' as long
      DIM oWin  ' as object

  ' calculate number of tries...
      DIM nTry : nTry = tWaitLimit / tWait
      DIM i  ' as integer

      FOR i = 1 TO nTry
       hWnd = FindWindow(sClass, sCaption)  ' look for window...
       IF hWnd <> 0  THEN  ' did we find it?
      ' MsgBox(sMe & "it took [" & CStr(i) & "] tries to find this window")
        EXIT FOR
       END IF
       SLEEP tWait  ' wait-a-bit, and try again
      NEXT  ' i

      BugAssert (hWnd <> 0), sMe & "couldn't find window: " & sCaption

      WaitForWindow = hWnd  ' return result (window handle)
     END FUNCTION



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

     FUNCTION SendMessage(hWnd, wMsg, wParam, lParam)
  ' Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  '    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
      SendMessage = oATO.CallAPI("USER32.DLL", "SendMessageA", hWnd, wMsg, wParam, lParam)
     END FUNCTION

     FUNCTION GetWindowTextLength(hWnd)
  ' Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
  '   (ByVal hWnd As Long) As Long
      GetWindowTextLength = oATO.CallAPI("USER32.DLL", "GetWindowTextLengthA", hWnd)
     END FUNCTION

     FUNCTION IsWindow(hWnd)
  ' Declare Function IsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As Long) As Long
      IsWindow = oATO.CallAPI("USER32.DLL", "IsWindow", hWnd)
     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 GetDlgItem(hDlg, nIDDlgItem)
  ' Declare Function GetDlgItem Lib "user32" Alias "GetDlgItem" _
  '   (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
      GetDlgItem = oATO.CallAPI("USER32.DLL", "GetDlgItem", hDlg, nIDDlgItem)
     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



' ================================================
' === end of api call wrappers ===================
' ================================================


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



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


' --- A Place to stash old code, not quite ready for bit-bucket ---

     SUB Old_Code()

     END SUB

2013-06-19 07:49