[MetaCard and Tcl] Broggle's cousin at home on the iBook

MetaCard's great but I can't afford to buy it (not that you can anyway, now that it's been subsumed into Runtime Revolution). But using the demo version means I keep bumping up against an inbuilt limit for scripts. So I hit upon the idea of bypassing the issue by calling external scripts.

The tool I use to write blogs at home (as opposed to the HTA I use elsewhere) is written in MetaCard and does the render and preview passes using Tcl.

[Aside: Not that there's anything about Tcl that lends itself to the job. I could have used Perl, Lua, Python, sed (maybe), awk, or any number of other languages from Algol68 (there's an implementation for Mac OS X believe it or not) right through to Zen BASIC. It's just that Tcl is familiar ground.]

Right, where was I. Oh yes ...

First the script in my "Render" button ...

on mouseUp
  put "/tmp/blog_" & random(65535) into fname
  open file fname for write
  write field fSource to file fname
  close file fname
  put shell("/usr/bin/tclsh ~/MindWeb/Writing/render.tcl " & fname ) into field fGenerated
  delete file fname
end mouseUp

... which creates a file in the temporary folder (I'm on Mac OS X here ... might work on Linux ... have to do something drastic for Windows), and puts my marked-up text from field fSource into it. Then it shells out to render.tcl and captures its output into the fGenerated field. The temporary file is deleted.

Render.tcl looks like this (in its current incarnation):

#! /usr/bin/tclsh
set auto_path [lappend auto_path /usr/local/lib/tcllib1.7/]
package require textutil

set fname [lindex $argv 0]
set h [open $fname r]
set theLines [split [read $h] \n]
close $h

#puts stdout "<!-- [llength $theLines] -->"

set last ""
set inCode 0
set c 0
set ender 0

proc doOpen { aTag } {
        global inCode
        global ender
        switch -exact -- $aTag {
                code    { 
                        puts -nonewline stdout "<span style=\"font-family: courier new;\"><pre><textarea rows=\"10\" cols=\"60\" readonly>"
                        set inCode 1 
                        }
                text    { puts -nonewline stdout "<span style=\"font-family: georgia;\">" }
                quot    { puts -nonewline stdout "<blockquote>" }
                end     { set ender 1
                          puts -nonewline stdout "" }
        }
}

proc doClose { aTag } {
        global inCode
        switch -exact -- $aTag {
                code    { puts -nonewline stdout "</textarea></pre></span>"
                          set inCode 0 }
                text    { puts -nonewline stdout "</span>" }
                quot    { puts -nonewline stdout "</blockquote>" }
                end     { puts -nonewline stdout "" }
        }
}


foreach l $theLines {
        incr c
        if {[string index $l 0] == "@"} {
                doClose $last
                set last [string range $l 1 end]
                doOpen $last
                if { $ender == 1 } { break }
        } else {
                if {$l == "" } {
                        if {$inCode == 0} {
                                puts -nonewline stdout "<br><br>"
                        } else {
                                puts stdout ""
                        }
                } else {
                        if {$inCode == 1} {     
                                puts stdout [string map { {&} {&amp;} {<} {&lt;} {>} {&gt;} } [::::textutil::untabify2 $l 8]]
                        } else {
                                puts -nonewline stdout $l
                        }
                }
        }
}
if {$last != "end"} {
        doClose $last
}

#puts stdout "<!-- $c -->"

This script inhales the file specified on the command line, splits it on newline and works its way through the lines, outputting HTML according to the rules of the markup: @ in column 1 identifies markup and there are currently four types: text, code, quot and end. Very simple, but it does me fine ... for now.

So after this runs, there's HTML in the fGenerated field. If I want to see how it's going to turn out in a browser, then I click on the Preview button. Okay, so it won't have all the CSS definitions that blogspot/blogger would apply but I get a useful approximation.

The script for the Preview button ...

on mouseUp
  put "/tmp/blog_" & random(65535)  & ".html" into fname
  open file fname for write
  write field fGenerated to file fname
  close file fname
  put shell("/usr/bin/open -a Safari " & fname ) into tmp
  --delete file fname
end mouseUp

... is similar to that of the Render button except this time I create an .html file in /tmp and and write the contents of the fGenerated field to it. I ignore the output of the shell() command.

I haven't quite figured out how to delete the temporary file because, if I uncomment the "delete file", by the time Safari is ready to load the file it's gone. There might be some way of making the shell synchronous, the way that /WAIT does on Win2k's START command, but then that'd probably mean waiting until Safari quits before I can use my blog writer again ... definitely sub-optimal. Then again, it'd be waiting for "open" to close, which happens as soon as it's launched Safari. And it's 10:48 pm and ...

Well, that's it. I really enjoyed this short break away from the long run of VBScript posts. I've got more stuff cooking here at home including a short foray into Javascript (a language I should have learned ages ago). Till then ...

[VBScript] function parameters

Things just got very interesting ... function parameters. This is where late binding helps. The mind reels: Dictionaries of references to procedure and function objects? sub bar( varParameter ) wscript.echo varParameter end sub sub foo( objFunction, varParameter ) objFunction varParameter end sub foo getref( "bar" ), 1

[VBScript] allsorts (not licorice)

Assorted sorts. I figured out I didn't need them after all. The BubbleSort is the slowest on large datasets. Sub BubbleSort( arr ) dim arr_j, arr_j1, i, j, temp for i = UBound(arr) - 1 To 0 Step -1 for j = 0 to i arr_j = arr( j ) arr_j1 = arr( j + 1 ) if arr_j > arr_j1 then temp=arr_j1 arr(j+1)=arr_j arr(j)=temp end if next next End Sub Sub QuickSort(vec,loBound,hiBound) Dim pivot,loSwap,hiSwap,temp '== This procedure is adapted from the algorithm given in: '== Data Abstractions & Structures using C++ by '== Mark Headington and David Riley, pg. 586 '== Quicksort is the fastest array sorting routine for '== unordered arrays. Its big O is n log n '~ http://4guysfromrolla.com/webtech/012799-2.shtml '== Two items to sort if hiBound - loBound = 1 then if vec(loBound) > vec(hiBound) then temp=vec(loBound) vec(loBound) = vec(hiBound) vec(hiBound) = temp End If End If '== Three or more items to sort pivot = vec(int((loBound + hiBound) / 2)) vec(int((loBound + hiBound) / 2)) = vec(loBound) vec(loBound) = pivot loSwap = loBound + 1 hiSwap = hiBound do '== Find the right loSwap while loSwap < hiSwap and vec(loSwap) <= pivot loSwap = loSwap + 1 wend '== Find the right hiSwap while vec(hiSwap) > pivot hiSwap = hiSwap - 1 wend '== Swap values if loSwap is less then hiSwap if loSwap < hiSwap then temp = vec(loSwap) vec(loSwap) = vec(hiSwap) vec(hiSwap) = temp End If loop while loSwap < hiSwap vec(loBound) = vec(hiSwap) vec(hiSwap) = pivot '== Recursively call function .. the beauty of Quicksort '== 2 or more items in first section if loBound < (hiSwap - 1) then Call QuickSort(vec,loBound,hiSwap-1) '== 2 or more items in second section if hiSwap + 1 < hibound then Call QuickSort(vec,hiSwap+1,hiBound) End Sub 'QuickSort Function ShellSort( ArrayToSort ) '~ http://www.adit.co.uk/html/a_question_of_sorts.html Dim SortLoop, ShellPoint Dim HoldValue, SortPoint ShellPoint = Lbound(ArrayToSort) Do Until ShellPoint > Ubound(ArrayToSort) ShellPoint = (3 * ShellPoint) + 1 Loop Do Until ShellPoint = Lbound(ArrayToSort) ShellPoint = ShellPoint / 3 For SortLoop = (ShellPoint + LBound(ArrayToSort)) To Ubound(ArrayToSort) HoldValue = ArrayToSort(SortLoop) SortPoint = SortLoop Do While (ArrayToSort(SortPoint - ShellPoint) > HoldValue) ArrayToSort(SortPoint) = ArrayToSort(SortPoint - ShellPoint) SortPoint = SortPoint - ShellPoint If SortPoint < ShellPoint Then Exit Do End If Loop ArrayToSort(SortPoint) = HoldValue Next Loop ShellSort = True End Function

[VBScript] using Watcher

And I've discovered that my Zerofill routine, which can be given any number of leading zeroes, never gets called with anything other than 2 leading zeroes. I discovered that by changing 'watch "Zerofill"' to 'watch "Zerofill." & nWidth'. Zerofill gets called > 700,000 times in a session.

So I create a new version of Zerofill Function Zerofill( nNum, nWidth ) Zerofill = Right( String( nWidth, "0" ) & nNum, nWidth ) End Function which I call Zerofill2 Function Zerofill2( nNum ) Zerofill2 = Right( "00" & nNum, 2) End Function and get a slight speed-up

[VBScript] "Watcher" - on the way to code profiling ... sort of

I've just implemented a new class, Watcher, which is giving me an idea of what routines in my stdFunctions.vbs are actually being used, and how frequently.

At present the class depends on some of the routines it would otherwise be watching so those routines can't refer to Watcher until such time as I make the class self-contained.

The class gets instantiated in the usual way right at the start of my stdFunctions.vbs file dim watch set watch = new watcher and then at the beginning of each of the subs and functions in stdFunctions.vbs there is a reference to watch, e.g. Sub Die( theMsg ) watch "Die" Log theMsg WScript.Echo theMsg WScript.Quit End Sub Sub Log( theMsg ) watch "Log" Const theExt = ".log" ... When the class terminates the data is saved in Watcher.txt as lines of tab-delimited text, for example: me 6 you 6 Logging 3 EnforcePath 3 Die 3 Log 3 ForceExtension 3 and these are then read back in at the initialisation of class next runtime round.

If you find this useful please let me know. Code below. class Watcher private objHash private sub Class_Initialize() dim strData dim arrLines dim strLine dim arrKeyData dim i set objHash = CreateObject( "Scripting.Dictionary" ) ' wscript.echo "dictionary created" If IsFile2( "Watcher.txt" ) Then strData = GetFile( "Watcher.txt" ) arrLines = Split( strData, vbNewLine ) For i = 0 To UBound( arrLines ) strLine = arrLines( i ) If Len( strLine ) > 0 Then arrKeyData = Split( strLine, vbTab ) ' wscript.echo "adding", parray( arrKeyData ) objHash.Add arrKeyData( 0 ), arrKeyData( 1 ) End If Next End If end sub public default sub lambda( strName ) if objHash.Exists( strName ) then objHash( strName ) = objHash( strName ) + 1 ' wscript.echo "updating watched item " & strName else objHash.Add strName, 1 ' wscript.echo "new item " & strName end if end sub private sub Class_Terminate() dim arrItems dim arrKeys dim numCount dim i dim strResult arrItems = objHash.Items arrKeys = objHash.Keys numCount = objHash.Count for i = 0 to numCount - 1 strResult = strResult & arrKeys( i ) & vbTab & arrItems( i ) & vbNewLine next WriteFile2 "Watcher.txt", strResult, False ' wscript.echo "Terminated" end sub end class

[VBScript] Map. Is there a more useless function?

Map is great for other languages. I've implemented it for no good reason. And I really can't think of a good use for it. Anyone? function map( arrSource, strOp ) Dim i Dim varItem Dim strEval Dim max Dim arrCopy arrCopy = arrSource max = UBound( arrCopy ) For i = 0 To max varItem = arrCopy( i ) strEval = Replace( strOp, "${item}", varItem ) arrCopy( i ) = Eval( strEval ) Next map = arrCopy End Function dim arr arr = map ( array(1,2,3,4,5,6,7,8,9),"${item}*${item}" ) 'arr now equals array(1,4,9,16,25,36,49,64,81)

[VBScript] Timer class

A class to set multiple timers and get back program run time in seconds, or as a nicely formatted hours-minutes-seconds. class StopWatch private dThen, dNow private bTicking private sub Class_Initialize() bTicking = False end sub public sub Start IF bTicking = False Then bTicking = True dThen = Now Else MsgBox "StopWatch already ticking" End If end sub public sub Finish If bTicking = True Then bTicking = False dNow = Now Else MsgBox "StopWatch not ticking" End If end sub public function StartTime() If bTicking = True Then StartTime = dThen Else MsgBox "StopWatch not started" StartTime = Empty End If end function public function FinishTime() If bTicking = False Then FinishTime = dNow Else MsgBox "StopWatch still ticking" FinishTime = Empty End If end function public function Seconds() If bTicking = False Then Seconds = DateDiff( "s", dThen, dNow ) Else MsgBox "StopWatching still ticking" Seconds = Empty End If end function public function LapTime() Dim dTemp, iHour, iMin, iSec if bTicking = False Then dTemp = DateAdd( "s", DateDiff( "s", dThen, dNow ), Empty ) iHour = Hour( dTemp ) iMin = Minute( dTemp ) iSec = Second( dTemp ) LapTime = iHour & "h " & iMin & "m " & iSec & "s" Else MsgBox "StopWatch still ticking" LapTime = Empty End If end function end class An example: dim ticker set ticker = new stopwatch ticker.start WScript.Echo ticker.StartTime() 'Waste a lot of time uselessly For i = 1 to 100000 str = Join( Split( Join( Split( "1.2.3.4.5.6.7.8.9.0.1.2.3.4.5.6.7.8.9.0...........","."),"."),"."),".") next ticker.Finish WScript.Echo ticker.FinishTime() WScript.Echo ticker.Laptime() ... which gave (at time of testing) ... 19/09/2005 4:04:11 PM 19/09/2005 4:04:18 PM 0h 0m 7s

[VBScript] Classes, classes, classes

Over at Win32Scripting where I've been hanging out of late, some bright spark, Tony Hinkle by name, put up code to

"Use IE as an output device! This script is an example of how to make a DIV element an object and then change the innerHTML property. This is a vbs file, not an .asp file. ..."

Being adventurous, I turned it into a class and added a bit of WMI to get the screen dimensions. class IEDisplay '~ Based on original work by Tony Hinkle, tonyhinkle@yahoo.com private TEMPORARY_FOLDER private objShell private objIE private objFSO private objFolder private strName private streamOut private objDIV private numHeight private numWidth private numTop private numLeft private sub Class_Initialize() Dim strComputer Dim objWMIService Dim colItems Dim objItem Dim arrMonitors( 10, 1 ) Dim numMonitorCount Set objShell = WScript.CreateObject("WScript.Shell") Set objIE = CreateObject("InternetExplorer.Application") strComputer = "." Set objWMIService = GetObject( "winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery( "Select * from Win32_DesktopMonitor") numMonitorCount = 0 For Each objItem in colItems arrMonitors( numMonitorCount, 0 ) = objItem.ScreenHeight arrMonitors( numMonitorCount, 1 ) = objItem.ScreenWidth numMonitorCount = numMonitorCount + 1 Next numHeight = arrMonitors( 0, 0 ) numWidth = arrMonitors( 0, 1 ) '~ MsgBox numHeight & " " & numWidth Set objFSO = CreateObject("Scripting.FileSystemObject") TEMPORARY_FOLDER = 2 set objFolder = objFSO.GetSpecialFolder( TEMPORARY_FOLDER ) '~ strName = objFolder.Path & "\" & objFSO.GetTempName & ".html" strName = objFSO.GetTempName '~ WScript.Echo strName set streamOut = objFolder.CreateTextFile( strName, True ) streamOut.WriteLine("<HTML><HEAD><TITLE>Information</TITLE></HEAD>") streamOut.WriteLine("<BODY SCROLL='NO'><CENTER><FONT FACE='arial black'> <HR COLOR='BLACK'>") streamOut.WriteLine("<DIV id='MakeMeAnObject'></DIV>") streamOut.WriteLine("<HR COLOR='BLACK'></FONT></CENTER></BODY></HTML>") streamOut.Close numTop = 0 numLeft = 0 end sub Sub Init( strPosition ) 'NW, N, NE, W, CENTRE, E, SW, S, SE Select Case strPosition Case "NW" numTop = 0 numLeft = 0 Case "N" numTop = 0 numLeft = ( numWidth / 2 ) - 250 Case "NE" numTop = 0 numLeft = numWidth - 500 Case "W" numTop = ( numHeight / 2 ) - 55 numLeft = 0 Case "CENTRE" numTop = ( numHeight / 2 ) - 55 numLeft = ( numWidth / 2 ) - 250 Case "E" numTop = ( numHeight / 2 ) - 55 numLeft = numWidth - 500 Case "SW" numTop = numHeight - 110 numLeft = 0 Case "S" numTop = numHeight - 110 numLeft = ( numWidth / 2 ) - 250 Case "SE" numTop = numHeight - 110 numLeft = numWidth - 500 Case Else numTop = 0 numLeft = 0 End Select SetupIE( objFolder.Path & "\" & strName ) Set objDIV = objIE.Document.All("MakeMeAnObject") '~ wscript.echo typename(objdiv) end sub private sub Class_Terminate() 'Close IE and delete the file objIE.Quit '~ optionally you may want to get rid of the temp file end sub public sub Display( strMsg, numMillisec ) '~ wscript.echo typename(objdiv) '~ MsgBox TypeName( numMillisec ) objDIV.InnerHTML = strMsg WScript.Sleep numMillisec end sub Private Sub SetupIE(File2Load) objIE.Navigate File2Load objIE.ToolBar = False objIE.StatusBar = False objIE.Resizable = False Do Loop While objIE.Busy objIE.Width = 500 objIE.Height = 110 objIE.Left = numLeft objIE.Top = numTop objIE.Visible = True objShell.AppActivate("Microsoft Internet Explorer") End Sub end class And some test code which puts boxes at 9 different points on the screen: set x = new iedisplay dim a a = split("NE,N,NW,SE,S,SW,E,CENTRE,W",",") for i = 0 to ubound(a) x.Init a(i) x.Display "Woof",10 next

[VBScript] Helping out with wildcarded directory searches

At Emulate The Dir Command Via Vbscript... ( Vbscript ) Christian D'heureuse had written a ListDir Function to list files using wildcards. Someone else wanted filtration and another suggested regular expressions. The following works a little faster than the latter and gives fine control over what is acceptable and what is not.

The following collects all the files to a comma delimited list (you may want to put it in an array). Function CollectFiles( theDirectory ) Dim oFSO, oDir, oFiles, aFile Dim theResult Dim a(), i theResult = "" Set oFSO = CreateObject("Scripting.FileSystemObject") On Error Resume Next Set oDir = oFSO.GetFolder( theDirectory ) Set oFiles = oDir.Files If Err.Number = 0 Then ReDim a( oFiles.Count - 1) i = 0 For Each aFile in oFiles a( i ) = aFile.Path '& "\" & aFile.Name i = i + 1 Next theResult = Join( a, "," ) End If CollectFiles = theResult End Function I then used this function to do the filtration Function PassedThroughFilters( strString, ByRef arrInclude, ByRef arrExclude ) Dim bResult Dim bDone Dim arrFilter Dim i bResult = False bDone = False For i = 0 To UBound( arrExclude ) arrFilter = arrExclude( i ) If BeginsWith( strString, arrFilter( 0 ), True ) And EndsWith( strString, arrFilter( 1 ), True ) Then bResult = False bDone = True Exit For End If Next If bDone = False Then 'not excluded, will it be included? For i = 0 To UBound( arrInclude ) arrFilter = arrInclude( i ) If BeginsWith( strString, arrFilter( 0 ), True ) And EndsWith( strString, arrFilter( 1 ), True ) Then bResult = True bDone = True Exit For End If Next End If PassedThroughFilters = bResult End Function and tied it all together as below (this is cut from a project file and the ellipses indicate code removed.) strDir = ParseEnvVar( strDir ) WScript.Echo "Collecting files in " & strDir strFiles = CollectFiles( ParseEnvVar( strDir ) ) arrFiles = Split( strFiles, "," ) arrFilesCount = UBound( arrFiles ) ... iFileCount = 0 For i = 0 To arrFilesCount If iFileCount = 0 Then strOutput = strAllExtras End If strFilename = arrFiles( i ) If PassedThroughFilters( BaseName( strFilename ), arrInclude, arrExclude ) = True Then WScript.Echo "Accepted: " & strFilename Log "Accepted: " & strFilename iFileCount = iFileCount + 1 ... Else Log "Rejected: " & strFilename End If Next The inclusions and exclusions are handled through arrays, and in my project these were drawn from .ini files, a part of which is recorded below [Filters] ExcludeCount=7 Exclude1=car_*0103.xls Exclude2=car_*0203.xls Exclude3=car_*0303.xls Exclude4=car_*0403.xls Exclude5=car_*0503.xls Exclude6=car_*0603.xls Exclude7=*.rar IncludeCount=16 Include1=car_210703.xls Include2=car_220703.xls Include3=car_230703.xls Include4=car_240703.xls Include5=car_250703.xls Include6=car_260703.xls Include7=car_270703.xls Include8=car_280703.xls Include9=car_290703.xls Include10=car_300703.xls Include11=car_310703.xls Include12=car_*0803.xls Include13=car_*0903.xls Include14=car_*1003.xls Include15=car_*1103.xls Include16=car_*1203.xls This all ran fairly fast and is better for speed than a regular expression mechanism, albeit at the cost of code size.

[VBScript] Helping out with DateDiff

Another from helping out at Automate Excel In Vbscript... ( Vbscript )

Please tell me how to subtract to time values. eg: 10.15 AM - (minus)8.30 Am Using example explain me

The DateDiff function is the one to use in this case. Using your data

a = "10:15 AM" b = "8:30 Am" c = datediff( "s", b, a ) ' the seconds between the two times c = datediff( "n", b, a ) 'the minutes between the two times (because "m" stands for months) c = datediff( "h", b, a ) ' the hours between the two times

[Neko] Check it out!

For another take on the Virtual Machine idea, see "Neko" via the weblog of it's creator Nicolas Cannasse

[VBScript] Evaluator

A quick scripting environment so that I could bash out a few lines, get the results easily and put them on the clipboard.

Have been using the Vrode Editor 1.1 for HTA development.

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> <HTML><HEAD><TITLE>Evaluator</TITLE> <META http-equiv=Content-Type content="text/html; charset=windows-1252"><HTA:APPLICATION id=oHTA selection="yes" windowState="normal" singleInstance="yes" showInTaskBar="yes" scrollFlat="no" scroll="no" navigable="yes" minimizeButton="yes" maximizeButton="no" innerBorder="yes" caption="yes" borderStyle="sunken" border="thick" applicationName="Evaluator" SYSMENU="yes" CONTEXTMENU="yes"> <SCRIPT language=VBScript> ReSizeTo 615, 520 Sub Window_Onload theScript.focus End Sub Sub bEvaluate_Click Dim aScript aScript = theScript.value aScript = Replace( aScript, "$RET$", "tResult.value" ) ExecuteGlobal aScript End Sub Sub bCopy_Click() if tResult.Value = "" Then MsgBox "Can't copy nothing.",,"Evaluator2" Else document.parentwindow.clipboardData.SetData "text", tResult.Value End If End Sub </SCRIPT> <META content="MSHTML 6.00.2800.1480" name=GENERATOR></HEAD> <BODY><TEXTAREA id=theScript rows=13 cols=70></TEXTAREA> <P>Put "$RET$ into the script as the destination of any calculations. For example<BR>&nbsp;&nbsp;&nbsp;&nbsp;dim pi: pi = 4 * atn(1):$RET$=pi</P> <P align=center><INPUT id=bEvaluate onclick=bEvaluate_Click type=button value=Evaluate></P><TEXTAREA id=tResult style="WIDTH: 580px; HEIGHT: 90px" name=tResult rows=4 cols=62></TEXTAREA> <P align=center><INPUT id=bCopy onclick=bCopy_Click type=button value="Copy to Clipboard"></P></BODY></HTML>

[VBScript and Excel] Relative/Absolute references

Again at Automate Excel In Vbscript... ( Vbscript ), Pentium10 wrote

I have a script which fills cells with exce.range.value function, but I have columns more than A-Z, how can I handle AA,AB, AC... columns???

Here is the script what I have:
excel.Range(chr(65+i) + str(excelrow), chr(65+i) + _
 str(excelrow)).value = lstOrder.cell(i,1)

And I wrote:

Re: I have a script which fills cells with ...

Function RelativeToAbsolute( aRow, aCol ) Dim alpha alpha = Split( "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z", "," ) RelativeToAbsolute = alpha( aCol - 1 ) & aRow End Function That does me, but for you I'd suggest adding a few more items to the Split(). After Z put in ",AA,AB,AC," etc until you have what you need. Then code your references in terms of numeric column and a row and let the function generate a meaningful address.

For example: strRange = RelativeToAbsolute( 1, 1 ) & ":" & RelativeToAbsolute( 1 + iCount - 1, 1 ) oSheet.Range( strRange ).NumberFormat = "d/m/yyyy h:mm:ss" (iCount in this case is the number of rows in an array I was committing to the spreadsheet.)

[VBScript and Excel] Moving a sheet to the end of the list

Here's how to put the first sheet in a new spreadsheet at the end. This is a copy of a recent submission of mine at Automate Excel In Vbscript... ( Vbscript ) Set oExcel = CreateObject("Excel.Application") Set oWorkBook = oExcel.Workbooks.Add oWorkbook.Sheets("Sheet1").Move ,oWorkbook.Sheets( oWorkbook.Sheets.Count ) Note the comma after the space that is after the .Move. I'm specfying the "after" clause rather than the "before" and saying to move the sheet to after the last.

BTW, one of the best ways of finding out syntax is to record a macro and adapt the resulting code.

[VBScript] Sorting agonies

After hours spent trying this algorithm and that algorithm, trying Bubble sort (too slow for my massive datasets), QuickSort (which dies from lack of stack space), and ShellSort (which runs at least), I finally stumble over something completely different: Sorting Data by Using a Disconnected Recordset.

After you read the Microsoft blurb, check out what DevGuru has to say about .Sort: PROPERTY: Recordset::Sort.

It's good, but sometimes it seems I spend ages looking for something on the 'net, implementing what I find and then stumble over what I needed in the first place when looking for something else. Aarrrgghh!

To cap the whole episode off, I find I don't need a sort at all! Access will actually protect its indexes whether I "SELECT * FROM" or whether I "SELECT TOP 1 * FROM".

"I'm a teapot, I'm a teapot ..."

[VBScript/HTA] More Broggle

The next version of Broggle with the readonly textarea for the code.

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> <HTML><HEAD> <HTA:APPLICATION id=oHTA scroll="yes" showInTaskBar="yes" caption="yes" applicationName="Broggle" CONTEXTMENU="yes" SYSMENU="yes" singleInstance="yes" maximizeButton="no"> <SCRIPT language=VBScript> ResizeTo 631,500 Dim lastMark Dim inCode Function stopMarkup( mark ) Dim res Select Case mark Case "code" res = "</textarea>" inCode = False Case "quot" res = "</blockquote>" Case "text" res = "</span>" case "end" res = "" End Select stopMarkup = res End Function Function startMarkup( mark ) Dim res res = stopMarkup( lastMark ) Select Case mark Case "code" res = res & "<textarea cols=""60"" rows=""20"" style=""width: 100%; height: 500px;"" wrap=""off"" readonly>" inCode = True Case "quot" res = res & "<blockquote>" Case "text" res = res & "<span style=""font-family: georgia;"">" case "end" res = res & "" End Select startMarkup = res End Function Sub Evaluate( theText ) Dim theList, theMax, i, theLine Dim theResult Dim theTemp Dim markup theResult = "" theList = Split( theText, vbCRLF ) theMax = UBound( theList ) lastMark = "" inCode = False For i = 0 to theMax theLine = theList( i ) If Left( theLine, 1 ) = "#" Then markup = Mid( theLine, 2 ) TheResult = theResult & startMarkup( markup ) lastMark = markup Else If theLine = "" And InCode = False Then theResult = theResult & "<BR><BR>" Else If inCode = True Then theTemp = theLine If theTemp = "" Then ' theTemp = "<BR><BR>" theTemp = vbCrLf Else theTemp = Replace( theTemp, "&", "&amp;" ) theTemp = Replace( theTemp, "<", "&lt;" ) theTemp = Replace( theTemp, ">", "&gt;" ) End If theResult = theResult & theTemp & vbCRLF Else theResult = theResult & theLine & vbCRLF End If End If End If 'MsgBox theResult Next if lastMark <> "end" Then theResult = theResult & stopMarkup( lastMark ) tSlave.value = theResult End Sub Sub bEvaluate_Click() if tMaster.value = "" Then MsgBox "Can't evaluate nothing",,"Broggle" Else Evaluate tMaster.value End If End Sub Sub bCopy_Click() if tSlave.Value = "" Then MsgBox "Can't copy nothing.",,"Broggle" Else document.parentwindow.clipboardData.SetData "text", tSlave.Value End If End Sub Sub bPreview_Click If tSlave.Value <> "" Then preview.innerHTML = tSlave.Value End If End Sub Sub bScreen_Click v3.Value = document.body.clientHeight v4.Value = document.body.clientWidth End Sub </SCRIPT> </HEAD> <BODY> <P><TEXTAREA id=tMaster style="WIDTH: 578px; HEIGHT: 130px" name=tMaster rows=6 cols=61></TEXTAREA>&nbsp;</P> <P><TEXTAREA id=tSlave style="WIDTH: 579px; HEIGHT: 166px" name=tSlave rows=8 cols=62></TEXTAREA>&nbsp;</P> <P><INPUT id=bEvaluate onclick=bEvaluate_Click type=button value=Convert name=bEvaluate>&nbsp; <INPUT id="bPreview" onclick="bPreview_Click" type=button value="Preview">&nbsp; <INPUT id=bCopy onclick=bCopy_Click type=button value="Copy to Clipboard"></P> <HR> <DIV id="preview"></DIV> </BODY></HTML>

[SNOBOL4] Parsing text: OnLine Bible to text markup

As a SNOBOL4 script, this gets about as far as I got before getting sidetracked again into other languages. This is a filter converting the NOTES file out of my pre-OSX version of OnLine Bible into docScript, a markup language for my own version (written in REALbasic 3) of Will Duquette's brilliant Notebook.

* notes.sno * parse NOTES file, creating a docScript index page and a list of dependant * docScript pages * * NOTES contains an FF followed by a bible ref followed by a LF followed by * free text until the next FF &amp;TRIM = 1 &amp;ANCHOR = 0 C_FF = CHAR( 12 ) C_CR = CHAR( 13 ) C_LF = CHAR( 10 ) CNT = 0 OFFSET1 = 0 OFFSET2 = 0 PATH = '/Users/bruceaxt/Documents/BrainBucket/docScript/' KEYFILE = PATH "olbstuff.rbt" HDR = '^MClearEdit()^MSetSize(10)^MSetBold(false)^MSetCondense(false)^M' + 'SetExtend(false)^MSetItalic(false)^MSetOutline(false)^MSetShadow(false)^M' + 'SetUnderline(false)^MSetFont("Monaco")^MSetRed(0)^MSetGreen(0)^MSetBlue(0)^M' CVTHDR HDR '^M' = C_CR :S(CVTHDR) BUFFER = INPUT(.NOTES,IO_FINDUNIT(),'B,4096','NOTES') OUTPUT(.KEYFILE,IO_FINDUNIT(),'B',KEYFILE) DEFINE('WRITEFILE(CHUNK)OFFSET') DEFINE('SETTEXT(TEXT)') DEFINE('BLUEON()') DEFINE('BLUEOFF()') KEYFILE = "'olbstuff" C_CR HDR MAIN LINE = NOTES :F(BUFFLD) BUFFER = BUFFER LINE :(MAIN) * At this point we have BUFFER containing the entire text of the file. * Now break at every after the first FF and put that into a file. BUFFLD BUFFER C_FF @OFFSET2 :F(ENDDATA) BUFFER TAB(OFFSET2 - 1) . CHUNK LEN(1) REM . BUFFER WRITEFILE(CHUNK) NOLF CNT = CNT + 1 :(BUFFLD) <br><br>* At this point we have a chunk. Let's see whether the first line contains * anything useful ENDDATA WRITEFILE(BUFFER) * WRITECHUNK(CNT,CHUNK) ENDMAIN :(END) SETTEXT TEXT '"' = '&amp;quot;' :S(SETTEXT) SETTXT2 TEXT '&lt;' = '&amp;lt;' :S(SETTXT2) SETTXT3 TEXT '&gt;' = '&amp;gt;' :S(SETTXT3) SETTXT4 TEXT CHAR(0) = :S(SETTXT4) SETTXT5 TEXT C_LF = '&amp;return;' :S(SETTXT5) SETTEXT = 'settext("' TEXT '")' C_CR :(RETURN) BLUEON BLUEON = 'setblue(255)' C_CR :(RETURN) BLUEOFF BLUEOFF = 'setblue(0)' C_CR :(RETURN) WRITEFILE CHUNK C_LF @OFFSET :F(WF_NOLF) CHUNK TAB(OFFSET - 1) . HEADER LEN(1) REM . CHUNK CLEAN HEADER ':' = '.' :S(CLEAN) CLEAN2 HEADER ' ' = '' :S(CLEAN2) KEYFILE = SETTEXT('[') BLUEON() SETTEXT(HEADER) + BLUEOFF() SETTEXT(']&amp;return;') C_CR WF_NOLF OUTPUT(.OUTFILE,IO_FINDUNIT(),'B',PATH HEADER ".rbt") CLEAN3 TEXT C_LF = '&amp;return;' :S(CLEAN3) OUTFILE = "'" HEADER C_CR HDR SETTEXT(CHUNK) :(RETURN) END