Vista - Rearrange desktop

I was wondering if it was possible to arrange the desktop icons to a
configuration with vbscript. I would like to organize them in some
other way than the few default options.


Thanks,
David

David wrote:hi David,

It is possible, but only if you are willing to step outside
the realm of respectable scripters, and sully your reputation
by calling api's from script.

If you wish to dive into this cesspool, then first go to the
freevbcode website (http://www.freevbcode.com), and look up
the "desktop shuffle" code written by: Arkadiy Olovyannikov.
That explains (albeit in vb) how to march through the desktop
icons, and reposition them.

I then wrote a script to do this, more-or-less converting
Arkadiy's vb code into vbs. (I wrote the script because of
my bad habit of downloading and trying out any and every code
sample of interest -- and thereby crashing my system frequently,
and losing the positioning of the desktop items frequently).
I used a couple of proprietary actX objects for calling api's
(oATO and oTD), but you could just as well use DynaWrap.

fwiw, I have attached my script used to reposition desktop
icons, but you probably will take one look and then vomit.

If you are _really_ serious, then you best be is probably
to start with Arkadiy's code and then use a language that
allows for calling api's, either vb or some other scripting
language that has an api capability (there are several).

cheers, jw
____________________________________________________________

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






' wshRepositionDesktopIcons Script, jw 14Apr07
' was: wshShuffleDesktopIcons, jw 21Jan02
'
' --- description block --------------------------
'
' Title: Reposition Desktop Icons (when positioning gets lost)...
'
' Description: (originally) to show how to use wshTypeDefinition object
' in conjunction with Dynawrap, to "Walk the Process List",
' i.e., to show a list of apps currently running on your computer.
' (This version): using wshATO to show the process list...
'
' Author: mr_unreliable
' Website: None at present, but may be found lurking around the wsh/vbs ng's
'
' Usage: Use at you own risk, tested on win98se...
'
' --- Acknowledgment -----------------------------
' The "desktop shuffle" code, or at least the vb version of it,
' was written by: Arkadiy Olovyannikov, and posted by him on
' the freeVBCode website: (http://www.freevbcode.com)
' --- end of acknowledgment ----------------------
'
' --- revision history ---------------------------
' 21Jan02: original "shuffle desktop" script...
' 14Apr07: adapted for repositioning desktop icons after positioning info lost...
' 15Apr07: removing extraneous code...
' 16Jan08: allow for "year extension" (_YR) to change...
' --- end of description block -------------------

Option Explicit
'
' instantiate ActX components here...
' (note: using "call instantiate" to provide better info in case obj is missing)
Dim oNMD : Call Instantiate (oNMD, "wshNonModalDialog.ucNMD", "oNMD_")
' Dim oVBU : Call Instantiate (oVBU, "wshNonModalDialog.ucVBU", "") ' (no events)
Dim oATO : Call Instantiate(oATO, "wshAPIToolkit.ucATO", "") ' (no events)
Dim oTD : Call Instantiate(oTD, "wshAPIToolkit.ucTypedef", "") ' (no events)
'
Dim oDic : Set oDic = CreateObject("Scripting.Dictionary")
' --- end of instantiations ----------------------
'
' --- Module Level Variables and Constants -------
Dim scTPPX, scTPPY ' twips per pixel
Dim m_htTitlebar ' used in geom calcs
Dim bCloseFlag ' t/f if user closed the form...
Dim bExitClick ' as boolean
Const m_btnExitID = 101 ' (first button created)
'
Dim nRtn ' as long (api call return value)
Const m_sDlgCaption = " << wshNonModalDialog Template Demo Script >> "
'
Dim oForm ' oNMD's "form object"
Dim m_hForm ' as long (form's "handle")
Dim m_bStatusBarPresent : m_bStatusBarPresent = False ' as boolean
Const SM_CYCAPTION = 4
'
Dim m_xScreen, m_yScreen ' as long (screen width/height in pixels)
Const m_sMMFileName = "wsh_MMFile" ' as string (memmap file name)
'
Dim oPA ' as object (point array)
Dim m_bAutoArrange ' as boolean (flag indicating AutoArrange initially on)
'
'
Const LVM_FIRST = &H1000 ' listview messages...
Dim LVM_GETTITEMCOUNT : LVM_GETTITEMCOUNT = (LVM_FIRST + 4)
Dim LVM_SETITEMPOSITION : LVM_SETITEMPOSITION = (LVM_FIRST + 15)
Dim LVM_GETITEMPOSITION : LVM_GETITEMPOSITION = (LVM_FIRST + 16)
Dim LVM_GETITEMTEXT : LVM_GETITEMTEXT = (LVM_FIRST + 45)

'
Const GWL_STYLE = (-16)
Const LVS_AUTOARRANGE = &H100
Const WM_COMMAND = &H111
Const IDM_TOGGLEAUTOARRANGE = &H7041
' --- end of declarations and constants ----------


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

Dim oVBU : Call Instantiate (oVBU, "wshNonModalDialog.ucVBU", "") ' (no events)
'
' use the utility functions up front, then dismiss oVBU...
Dim vbScreen : Set vbScreen = oVBU.vbScreen
scTPPX = vbScreen.TwipsPerPixelX
scTPPY = vbScreen.TwipsPerPixelY
Set vbScreen = nothing

' Const SM_CYCAPTION = 4
m_htTitlebar = oVBU.GetSystemMetrics(SM_CYCAPTION)
Set oVBU = nothing


' Create the Form, and add the controls...
Call Create_Dialog_wStatusBar(m_sDlgCaption)
' Call Create_Dialog(m_sDlgCaption) ' no status bar
Set oForm = oNMD.frmDialog ' getref to form object
dbPrint sMe & "Form Created. (form hWnd is: " & CStr(oForm.hWnd) & ")"
Call DrawGridLines(oForm) ' used to "fine-tune" positioning controls...
' Call AddGraphicLogo(oForm)
oNMD.ShowDialog True ' show the form here...

Dim sThisYear, m_sYearExt ' as string
sThisYear = Year(Date)
m_sYearExt = "_" & Right(CStr(sThisYear), 2)
dbPrint sMe & "year ext: " & m_sYearExt
' MsgBox("ending now... ") : WScript.Quit

Call InitializeDictionary(oDic)

Call RepositionDesktopIcons()

dbPrint sMe & "Review results, and close this dialog... "




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

Const tDoEvents = 200
Dim tElapsed : tElapsed = 0
Dim tNow ' as time

Do
WScript.Sleep tDoEvents ' allow for processing events...
tElapsed = tElapsed + tDoEvents

' (if running statusbar w/clock), then update the clock...
if (m_bStatusBarPresent) then
if (tElapsed Mod 1000) then _
oForm.StatusBar.PanelText("CLOCK") = FormatDateTime(Now, vbLongTime)
End If

Loop until (bExitClick Or bCloseFlag)

WScript.Sleep 500 ' wait-a-bit

' Set oVBU = nothing
' vendor-approved wshNMD cleanup sequence...
oNMD.ShowDialog False ' hide the dialog
oNMD.UnloadDialog ' release memory held by form
Set oNMD = Nothing ' release memory held by object

WScript.Quit



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


' --- RE-POSITION DESKTOP ICONS (FROM STORED INFO) ---

Sub RepositionDesktopIcons()
Const sMe = "[ReposIcons], "
'
Dim GetWindowThreadProcessId ' as object
Set GetWindowThreadProcessId = oATO.DeclareAPI("USER32.DLL", "GetWindowThreadProcessId", "ByVal hWnd As Long", "ByVal lpdwProcessId As Long")
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 GetWindowLong : Set GetWindowLong = oATO.DeclareAPI("USER32.DLL", "GetWindowLongA", "ByVal hWnd As Long", "ByVal nIndex As Long")
Dim GetParent : Set GetParent = oATO.DeclareAPI("USER32.DLL", "GetParent", "ByVal hWnd As Long")
Dim CopyMemory : Set CopyMemory = oATO.DeclareAPI("KERNEL32.DLL", "RtlMoveMemory", "Destination As Any", "Source As Any", "ByVal Length As Long")
'
Dim dwProcessID, lpdwProcessID, tid, lStyle ' as long
Dim hProcess, lpSysShared ' as long
Dim cItems, lWritten, hFileMapping ' as long
Dim xScreen, yScreen ' as long
Dim hLVWnd, i ' as long
Dim sItemText ' as string
'
Const oneLong = 4 ' 4 bytes
Const twoLongs = 8 ' 2 * 4 (number of bytes in two longs)
Const x = 0 : Const y = 1 ' subscripts for (x,y) in ptCurrent array...
'
Dim sPos ' as string
Dim saPos ' as string array
Dim xPos, yPos ' as long

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



hLVWnd = GetSysLVHwnd()
BugAssert (hLVWnd <> 0), "Uh Oh. Could not locate Progman ListView"

' get window thread and process ID's (but apparently not used here)...
dwProcessID = CLng(0) ' allocate [out] buffer, type-cast as long...
lpdwProcessID = oATO.LongPtr(dwProcessID)
tid = GetWindowThreadProcessId(hLVWnd, lpdwProcessID)

cItems = SendMessage(hLVWnd, LVM_GETTITEMCOUNT, 0, 0) ' &)
BugAssert (cItems > 0), "Uh Oh. Your desktop HAS NO ICONS!"


' test if autoarrange is on, if so, then turn it OFF...
If (GetWindowLong(hLVWnd, GWL_STYLE) And LVS_AUTOARRANGE) = LVS_AUTOARRANGE Then
m_bAutoArrange = True
Call SendMessage(GetParent(hLVWnd), WM_COMMAND, IDM_TOGGLEAUTOARRANGE, 0) ' ByVal 0&)
End If


' create the lvitem typedef...
Dim tLVI ' as object (lvitem typedef)...
Set tLVI = New clsLVITEM

Const cbShMemSize = 4095 ' 4096 - 1
Dim aryLongs(1) : aryLongs(0) = CLng(0) : aryLongs(1) = CLng(0) ' that makes TWO longs

' ----------------------------------------------
' the original contains code for NT here,
' but, this code is only applicable to win9x...
' ----------------------------------------------

' note: the original author asks for enough shared memory
' to hold the entire array of x,y points, but only ONE pair
' is really needed (i.e., the size could be twoLongs)...
lpSysShared = GetMemShared95(cbShMemSize, hFileMapping)
' clear shared memory (note: the original author included this,
' but, it doesn't appear to be necessary, imho)...
' CopyMemory lpSysShared, CLng(oPA), CInt(oPA.Size) ' ByVal lpSysShared
' dbPrint sMe & "Address of Point_Array is: " & CStr(oPA)

' get the icon position for each desktop item...
For i = 0 To cItems - 1

' start with getting the item's text, but this gets tricky,
' as BOTH the typedef AND the string must be in shared memory...
With tLVI
.SubItem = 0 ' no subindex implies get the MAIN item label...
.TextMax = 255 ' cChar -- an arbitrary number (you've seen before)...
.pszText = lpSysShared + .dwSize
End With
CopyMemory lpSysShared, tLVI, tLVI.dwSize ' move typedef to shmem...

nRtn = SendMessage(hLVWnd, LVM_GETITEMTEXT, i, lpSysShared)

If (nRtn >= 0) Then sItemText = cbDeRefStr(lpSysShared + tLVI.dwSize)
dbPrint sMe & "item(" & CStr(i) & ") Text: [" & sItemText & "]"



' retrieve the item position (x,y) from the ListView control...
SendMessage hLVWnd, LVM_GETITEMPOSITION, i, lpSysShared ' ByVal lpSysShared
' copy the position (x,y) from shared memory, into the long array...
CopyMemory oATO.LongPtr(aryLongs(0)), lpSysShared, oneLong ' ByVal lpSysShared
CopyMemory oATO.LongPtr(aryLongs(1)), lpSysShared + 4, oneLong
' dbPrint sMe & "address of THIS item(" & CStr(i) & ") in pt_array is: " & CStr(oPA.AddressOf(i))
dbPrint sMe & "item(" & CStr(i) & ") position (x,y) is: " _
& CStr(aryLongs(0)) & "," & CStr(aryLongs(1))


' lookup this item in the dictionary...
If oDic.Exists(sItemText) Then
dbPrint sMe & "found [" & sItemText & "] in the listing.. "
sPos = oDic.Item(sItemText) ' get the positioning (as string)
saPos = Split(sPos, ",")
xPos = CLng(saPos(0)) : yPos = CLng(saPos(1))
dbPrint sMe & "item(" & CStr(i) & ") moving to (x,y): " & CStr(xPos) & "," & CStr(yPos)

Call SendMessage(hLVWnd, LVM_SETITEMPOSITION, i, CLng(xPos + yPos * &H10000))

Else
dbPrint sMe & "could NOT find [" & sItemText & "] in the listing.. "
End If

Next ' iItem
dbPrint sMe & " ..finished process desktop items"
dbPrint "" ' space

FreeMemShared95 hFileMapping, lpSysShared

End Sub ' repos desktop icons


' --- INITIALIZE THE DICTIONARY (OF X,Y POSITIONS) ---

Sub InitializeDictionary(oDic)

' include here the desktop icons you want positioned,
' along with the positioning info...
With oDic
.Add "My Computer", "730,500" ' key = icon text, item = position
.Add "Network Neighborhood", "40,430"
.Add "Recycle Bin", "40,500"
'
.Add "DeskStorage" & m_sYearExt, "130,500"
.Add "Apr07_Projects", "130,360"
.Add "Mar07_Projects", "130,430"
'
.Add "Work_In_Progress" & m_sYearExt, "220,500"
'
.Add "3½ Floppy (A)", "730,430"
.Add "Removable Disk (H)", "730,365" ' was 370

.Add "Working Scripts", "739,130"
.Add "wshScripts", "730,70"
'
.Add "CD-ROM (G)", "640,500"
.Add "wshDilbert Ripper", "640,270"

End With

End Sub

' --- DREFERENCE STRING POINTER ------------------
' This code "inspired" by similiar code published by "vbBox" (Klaus Probst),
' and adopted for scripting. However, in so doing it has been mangled up
' to a considerable extent (sorry Klaus), and so Klaus will most likely
' be more than willing to disown it...

Function cbDeRefStr(lpString)
Dim lstrlenA : Set lstrlenA = oATO.DeclareAPI("KERNEL32.DLL", "lstrlenA", "ByVal lpString As Long")
Dim CopyMemory : Set CopyMemory = oATO.DeclareAPI("KERNEL32.DLL", "RtlMoveMemory", "Destination As Any", "Source As Any", "ByVal Length As Long")
Dim MultiByteToWideChar : Set MultiByteToWideChar = oATO.DeclareAPI("KERNEL32.DLL", "MultiByteToWideChar", "ByVal CodePage As Long", "ByVal dwFlags As Long", "ByVal lpMultiByteStr As Long", "ByVal cchMultiByte As Long", "ByVal lpWideCharStr As Long", "ByVal cchWideChar As Long")
Const CP_ACP = 0 ' code page
'
Dim sOut ' as string
Dim cbLen ' as long

cbDeRefStr = "" ' initialize
If (lpString = 0) Then Exit Function ' should probably throw an error

cbLen = lstrlenA(lpString) ' in characters

' don't bother to warn if the string is empty - no point.
If (cbLen = 0) Then Exit Function

sOut = String(cbLen, 0)
' note: the "-1" tells MB2WC to calc len auto-magically...
Call MultiByteToWideChar(CP_ACP, 0, lpString, -1, oATO.vbStrPtr(sOut), cbLen)

cbDeRefStr = sOut ' return the string

End Function ' cbDeRefStr



' --- Get Program Manager ListView Window handle ---

Function GetSysLVHwnd()
Const sMe = "[GetSysLVHwnd], "
Dim FindWindow : Set FindWindow = oATO.DeclareAPI("USER32.DLL", "FindWindowA", "ByVal lpClassName As String", "ByVal lpWindowName As String")
Dim FindWindowEx : Set FindWindowEx = oATO.DeclareAPI("USER32.DLL", "FindWindowExA", "ByVal hWnd1 As Long", "ByVal hWnd2 As Long", "ByVal lpsz1 As String", "ByVal lpsz2 As String")

Dim hWnd ' as long
hWnd = FindWindow("Progman", 0) ' was vbNullString
dbPrint sMe & "Progman hWnd: " & CStr(hWnd)
hWnd = FindWindowEx(hWnd, 0, "SHELLDLL_defVIEW", 0) ' was vbNullString
dbPrint sMe & "SHELLDLL_defVIEW hWnd: " & CStr(hWnd)
GetSysLVHwnd = FindWindowEx(hWnd, 0, "SysListView32", 0) ' was vbNullString
dbPrint sMe & "returned: " & CStr(GetSysLVHwnd)
End Function




' ------------------------------------------------
' --- GET / FREE SHARED MEMORY -------------------
' ------------------------------------------------

Function GetMemShared95(memSize, hFile)
Const sMe = "[GetMemShared95], "
Dim CreateFileMapping : Set CreateFileMapping = oATO.DeclareAPI("KERNEL32.DLL", "CreateFileMappingA", "ByVal hFile As Long", "lpFileMappigAttributes As Typedef", "ByVal flProtect As Long", "ByVal dwMaximumSizeHigh As Long", "ByVal dwMaximumSizeLow As Long", "ByVal lpName As String")
Dim MapViewOfFile : Set MapViewOfFile = oATO.DeclareAPI("KERNEL32.DLL", "MapViewOfFile", "ByVal hFileMappingObject As Long", "ByVal dwDesiredAccess As Long", "ByVal dwFileOffsetHigh As Long", "ByVal dwFileOffsetLow As Long", "ByVal dwNumberOfBytesToMap As Long")
'
Const MEMORY_ONLY = &HFFFFFFFF ' otherwise memory AND disk...
Const PAGE_READWRITE = &H4
'
Const SECTION_QUERY = &H1
Const SECTION_MAP_WRITE = &H2
Const SECTION_MAP_READ = &H4
Const SECTION_MAP_EXECUTE = &H8
Const SECTION_EXTEND_SIZE = &H10
Const STANDARD_RIGHTS_REQUIRED = &HF0000
'
Dim SECTION_ALL_ACCESS : SECTION_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED _
Or SECTION_QUERY Or SECTION_MAP_WRITE Or SECTION_MAP_READ _
Or SECTION_MAP_EXECUTE Or SECTION_EXTEND_SIZE
Dim FILE_MAP_ALL_ACCESS : FILE_MAP_ALL_ACCESS = SECTION_ALL_ACCESS

hFile = CreateFileMapping(MEMORY_ONLY, 0, PAGE_READWRITE, 0, memSize, m_sMMFileName)
dbPrint sMe & "CreateFileMapping returned: " & CStr(hFile)
GetMemShared95 = MapViewOfFile(hFile, FILE_MAP_ALL_ACCESS, 0, 0, 0)
dbPrint sMe & "MapViewOfFile returned: " & CStr(GetMemShared95)
End Function

Sub FreeMemShared95(hFile, lpMem)
Dim UnmapViewOfFile : Set UnmapViewOfFile = oATO.DeclareAPI("KERNEL32.DLL", "UnmapViewOfFile", "lpBaseAddress As Any")
Dim CloseHandle : Set CloseHandle = oATO.DeclareAPI("KERNEL32.DLL", "CloseHandle", "ByVal hObject As Long")

UnmapViewOfFile lpMem
CloseHandle hFile
End Sub

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



' --- click event handlers ---
Sub oNMD_ButtonClick(btnID)
dbPrint "[oNMD_ButtonClick], Detected click, btnID is: " & CStr(btnID)

Select Case btnID
Case m_btnExitID : bExitClick = True
Case Else: m_bCloseDetected = True
End Select
End Sub

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


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

Sub dbPrint (sMsg)
' test(s) to insure debug dialog object is valid.
if (VarType(oNMD) = vbEmpty) then Exit Sub ' uninitialized...
if (oNMD Is Nothing) then Exit Sub ' object has been released...

' is valid, so post the message...
oNMD.AddLine sMsg
End Sub






' --- this code creates the dialog and adds the controls ---

Sub Create_Dialog_wStatusBar(sCaption)
Const wdForm = 450, htForm = 280, wdBtn = 100, htBtn = 25
Const bGraphicLogo = False
' geometry calculations. Also note: the htTitlebar takes up more screen
' real estate when going from win9x to winXP. To deal with this,
' we will be adjusting the (vertical) space allocated to the dbMsg window...
Dim htClientArea : htClientArea = htForm - m_htTitlebar - (2 * 3) ' (border)
Const htLogo = 17 ' estimated, (logo = 12, margin = 2, border/edge = 3)
Const htStatusBar = 30 ' estimated, (actually adjusted according to font)
Dim topDBWnd : topDBWnd = 20
' wd/ht of debug window, (width to fill wdForm)...
Dim wdDBWnd : wdDBWnd = wdForm - 46
Dim htDBWnd : htDBWnd = htClientArea - 20 - htLogo - htStatusBar - htBtn
if bGraphicLogo then htDBWnd = htDBWnd - 60 : topDBWnd = 20 + 60 + 5
Const cBtns = 1 ' count of buttons (across bottom of form)...
Dim wdBtnSp : wdBtnSp = Int((wdForm - wdBtn) / 2) - 3 ' button spacing
' --- end of declarations and constants ----------

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

' --- debugging window here ------------------
.AddLabel "debugging messages... ", 20+5,topDBWnd-15, wdDBWnd,15
' use Client Area, less space for: label, button, logo, statusbar, margin...
.AddListBox 20,topDBWnd, wdDBWnd,htDBWnd
' --- end of debugging window code -----------

' (note: allow for built-in logo, statusbar, and button)...
.AddButton "Exit", wdBtnSp,htClientArea -htLogo-htStatusBar-htBtn+5, wdBtn,htBtn

oNMD.AddStatusBar ' add the statusbar here (adjustments later)...

m_bStatusBarPresent = True

End With
' --- finished with creating the form ----------

' --- form reference section -------------------
' for "adjusting" any control properties, one must refer to their "proper names":
' Label, Button, TextBox, ListBox, ProgressBar, ImageBox, StaticCtrl.
' ----------------------------------------------

' in THIS script, lo-light the dbmsg label...
With oNMD.frmDialog.Label(1).Font
.Name = "MS Sans Serif": .Size = 8: .Bold = False: .Italic = False : End With

' About the statusbar font: unless specifically re-set, the statusbar font
' will take the same font as the frmDialog. Generally, you will want the
' statusbar font to NOT be bold, as you will normally be crowding info
' into the status bar. So, this will reset the statusbar's font:
With oNMD.frmDialog.StatusBar.Font
.Name = "MS Sans Serif": .Size = 8: .Bold = False: .Italic = False : End With

' this code to change the dialog's icon, from wscript ico to mrU ico...
Dim icoMrU ' as stdpicture
Const vbResIcon = 1 ' as vb resource type
Const mrUIcoID = "ICOMRU" ' resource icon ID
' code to use when loading the form icon from a separate icon file...
' Set icoMrU = LoadPicture(GetLocalDirectory() & "mrU.ico") ' "mrUnreliable.ico")
' use _THIS_ code when loading icon from among the built-in resource icons...
Set icoMrU = oNMD.vbLoadResPicture(mrUIcoID, vbResIcon) ' load icon, using ID
Set oNMD.frmDialog.Icon = icoMrU ' replace std form ico (the wsh ico) with mrU...

End Sub



' ------------------------------------------------
' --- DEBUG CLASS WRAPPER ------------------------
' ------------------------------------------------
' caApril03: initial attempt (with just print)...
' 02July05: revised to reflect "newer" dbPrint code...

Class clsDebug

Public Sub Print(sMsg) ' used with oNMD
' test(s) to insure debug dialog object is valid.
if (VarType(oNMD) = vbEmpty) then Exit Sub ' uninitialized...
if (oNMD Is Nothing) then Exit Sub ' object has been released...

' is valid, so post the message...
oNMD.AddLine sMsg
End Sub

Public Sub old_Print(sMsg) ' used with oNMD...
oNMD.AddLine sMsg
End Sub

Public Sub Assert(bTest, sErrMsg)
if bTest then Exit Sub ' normally (hopefully) test returns true...

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



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



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



' ================================================
' ================================================
' === DRAW GRIDLINES (for aligning controls) =====
' ================================================
' ================================================

Sub DrawGridLines(oForm)
Dim pxLeft, pxTop, pxWd, pxHt
Const vbPixel = 3 ' scalemode = pixel
Dim savScaleMode ' place to save (existing) ScaleMode...
Dim iLine ' as integer
Const pxLine = 1 ' normal drawwidth...
Const crLtGray = &HA0A0A0, crDkGray = &H808080
'
' --- end of declarations and constants ----------

' savScaleMode = oForm.ScaleMode ' save the (existing) ScaleMode...
' oForm.ScaleMode = vbPixel ' reset to vbPixel

oForm.AutoRedraw = True ' used to 'persist' the gridlines (graphics)...

pxWd = oForm.Width\scTPPX - (2 * 3) ' (- borders)
pxHt = oForm.Height\scTPPX - m_htTitlebar - (2 * 3)

' ----------------------------------------------
' Draw the gridlines here (horiz/vertical)...
' note: X2,Y2 are RELATIVE to start point (not absolute).
' Also note: the gridlines are drawn ON THE FORM. And as such they
' are UNDER (i.e., z-order: "back layer") all the "real" vb controls,
' but not under any other graphical drawing to be done...
' ----------------------------------------------
With oForm
iLine = 0 : pxLeft = 0
For pxTop = 10 to pxHt - 10 Step 10 ' draw horizontal lines
iLine = iLine + 1
if ((iLine mod 5) = 0) then
.DrawWidth = pxLine * 2 ' make every fifth line darker
.vbLine pxLeft,pxTop, pxWd,0, crLtGray
Else
.DrawWidth = pxLine
.vbLine pxLeft,pxTop, pxWd,0, crLtGray
End If
Next ' pxTop

iLine = 0 : pxTop = 0
For pxLeft = 10 to pxWd - 10 Step 10 ' draw vertical lines
iLine = iLine + 1
if ((iLine mod 5) = 0) then
.DrawWidth = pxLine * 2 ' make every fifth line darker
.vbLine pxLeft,pxTop, 0,pxHt, crLtGray
Else
.DrawWidth = pxLine
.vbLine pxLeft,pxTop, 0,pxHt, crLtGray
End If
Next ' pxLeft

.DrawWidth = pxLine ' reset (in case of any other drawing to be done)...
End With ' oForm

' clean up...
' oForm.ScaleMode = savScaleMode ' restore ScaleMode...
End Sub ' drawgridlines



' ================================================
' === LVITEM TYPEDEF CLASS WRAPPER ===============
' ================================================

Class clsLVITEM

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

' Type LVITEM ' field name (byte offset)
Private m_Mask ' Mask As Long (byte 0)
Private m_Index ' Index As Long (byte 4)
Private m_SubItem ' SubItem As Long (byte 8)
Private m_State ' State As Long (byte 12)
Private m_StateMask ' StateMask As Long (byte 16)
Private m_pszText ' Text As String (pointer) (byte 20)
Private m_TextMax ' TextMax As Long (byte 24)
Private m_Icon ' Icon As Long (byte 28)
Private m_Param ' Param As Long (byte 32)
Private m_Indent ' Indent As Long (byte 36)
'

Private cbLVITEM ' as long (byte count of this typedef)
Private adrLVITEM ' as long
Private tLVITEM ' as string (key) = 'tLVITEM'

Private c_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 oTD.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 Mask()
Mask = oTD.GetLong(tLVITEM, m_Mask)
End Property

Public Property Let Mask(vRHS)
oTD.PutLong(tLVITEM, m_Mask) = vRHS
End Property

Public Property Get Index()
Index = oTD.GetLong(tLVITEM, m_Index)
End Property

Public Property Let Index(vRHS)
oTD.PutLong(tLVITEM, m_Index) = vRHS
End Property

Public Property Get SubItem()
SubItem = oTD.GetLong(tLVITEM, m_SubItem)
End Property

Public Property Let SubItem(vRHS)
oTD.PutLong(tLVITEM, m_SubItem) = vRHS
End Property

Public Property Get State()
State = oTD.GetLong(tLVITEM, m_State)
End Property

Public Property Let State(vRHS)
oTD.PutLong(tLVITEM, m_State) = vRHS
End Property

Public Property Get StateMask()
StateMask = oTD.GetLong(tLVITEM, m_StateMask)
End Property

Public Property Let StateMask(vRHS)
oTD.PutLong(tLVITEM, m_StateMask) = vRHS
End Property

Public Property Get pszText()
pszText = oTD.GetLong(tLVITEM, m_pszText)
End Property

Public Property Let pszText(vRHS)
oTD.PutLong(tLVITEM, m_pszText) = vRHS
End Property

Public Property Get TextMax()
TextMax = oTD.GetLong(tLVITEM, m_TextMax)
End Property

Public Property Let TextMax(vRHS)
oTD.PutLong(tLVITEM, m_TextMax) = vRHS
End Property

Public Property Get Icon()
Icon = oTD.GetLong(tLVITEM, m_Icon)
End Property

Public Property Let Icon(vRHS)
oTD.PutLong(tLVITEM, m_Icon) = vRHS
End Property

Public Property Get Param()
Param = oTD.GetLong(tLVITEM, m_Param)
End Property

Public Property Let Param(vRHS)
oTD.PutLong(tLVITEM, m_Param) = vRHS
End Property

Public Property Get Indent()
Indent = oTD.GetLong(tLVITEM, m_Indent)
End Property

Public Property Let Indent(vRHS)
oTD.PutLong(tLVITEM, m_Indent) = vRHS
End Property

' a "convenience" property (not defined in the typedef)...
Public Property Get dwSize()
dwSize = cbLVITEM
End Property

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



Sub Class_Initialize()
c_sMe = "[clsLVITEM], "
' MsgBox(c_sMe & "Initializing")

' fill in the typdef field constants,
' (maybe SOMEDAY we can just use: Private Const dwLength = 0)...
m_Mask = 0 ' Mask As Long (byte 0)
m_Index = 4 ' Index As Long (byte 4)
m_SubItem = 8 ' SubItem As Long (byte 8)
m_State = 12 ' State As Long (byte 12)
m_StateMask = 16 ' StateMask As Long (byte 16)
m_pszText = 20 ' Text As String (byte 20)
m_TextMax = 24 ' TextMax As Long (byte 24)
m_Icon = 28 ' Icon As Long (byte 28)
m_Param = 32 ' Param As Long (byte 32)
m_Indent = 36 ' Indent As Long (byte 36)

cbLVITEM = 40 ' (byte count)
tLVITEM = "tLVITEM" ' (key)


On Error Resume Next ' turn on error checking
' create the typedef itself...
' (note: CreateTypeDef allocates memory and clears to zeros)
adrLVITEM = oTD.CreateTypDef(tLVITEM, cbLVITEM)
' no need to set bytecount for THIS typedef/structure...
' (or) set the bytecount for THIS typedef/structure with...
' oTD.PutLong(tLVITEM, m_dwSize) = cbLVITEM

' check to make sure that the typedef creation succeeded...
BugAssert (err.number = 0), c_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(c_sMe & "Terminating")
oTD.DestroyTypDef(tLVITEM) ' return typedef memory block(s)...
End Sub

End Class ' clsLVITEM



' ================================================
' === ARRAY OF "POINTS" (X,Y) CLASS WRAPPER ======
' ================================================

Class clsPOINT_ARRAY

' --- Discussion ---------------------------------
' An array of points would normally be handled in an ordinary array.
' However, since we want to pass the ADDRESS of the array to an
' api function, then we are using wsh API Toolkit's typedef
' capability, just to get an address of our homemade array...
' --- end of discussion --------------------------

' --- Module Level Variables ---------------------


' --- end of module level variables --------------
Private cbPA ' As Long (byte count for DI) = 12 (3*4)
'
Private adrPA ' as long
Private tPA ' as string (key) = "tPA"
'
Private sCls
'
Dim m_ConstFact
' --- end of declarations and constants ----------


Public Sub AllocateMem(cPoints) ' cPoints is expected point count...

' the space required is 4 bytes (a long) for each x and y.
' there are cPoints, so cPoints * 2 * 4
cbPA = cPoints * 2 * 4
' MsgBox("cPoints / bytes allocated: " & CStr(cPoints) & "/" & CStr(cbPA))

On Error Resume Next ' turn on error checking
' (note: CreateTypeDef allocates memory and clears to zeros)
adrPA = oTD.CreateTypDef(tPA, cbPA)
' check to make sure that the typedef creation succeeded...
BugAssert (err.number = 0), sCls & "Unable to create typedef, " & vbCrlf _
& " most likely because oATO is not instantiated properly... "
On Error goto 0 ' turn off error checking...

End Sub

' get an items coordinates (x or y) from array...
Public Property Get ptOriginal(iItem, xy)
' the address to be retrieved is the base address (adrPA),
' plus item nr * 8, plus 0 for x(=0), and 4 for y(=1)...
Dim iOffset : iOffset = (iItem * m_ConstFact) + (xy * 4)
ptOriginal = oTD.GetLong(tPA, iOffset)
End Property

Public Property Let Item(iOffset, vRHS)
oTD.PutLong(tPA, iOffset) = vRHS
End Property

Public Property Get Item(iOffset)
Item = oTD.GetLong(tPA, iOffset)
End Property

Public Property Get Size()
Size = cbPA
End Property

Public Property Get AddressOf(iItem)
' (note: address of item(i) is address of array plus i times 2 * 4)
AddressOf = adrPA + iItem * m_ConstFact
End Property


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

Sub Class_Initialize()
sCls = "[clsPOINT_ARRAY], "
' MsgBox(sCls & "Initializing") ' used for debugging

tPA = "tPA" ' (key)

m_ConstFact = 8
End Sub

Sub Class_Terminate()
' MsgBox(sCls & "Terminating") ' used for debugging purposes
oTD.DestroyTypDef(tPA) ' return typedef memory block(s)...
End Sub

End Class

' ------------------------------------------------
' --- end of POINT_ARRAY class -------------------
' ------------------------------------------------


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

Sub Old_Code()


End Sub

' --- script ends here ---