[VBScript] A CLI framework

Here's a simple framework for building your own CLI (Command Language Interface) Dim sLine Dim aLine Dim sKeyword Dim sArguments Do While True WScript.StdOut.Write ">> " sLine = WSCript.StdIn.ReadLine aLine = Split( sLine, " ", 2 ) If UBound( aLine ) > -1 Then sKeyword = aLine( 0 ) If UBound( aLine ) > 0 Then sArguments = aLine( 1 ) Else sArguments = "" End If Select Case LCase( sKeyword ) Case "quit", "exit", "bye" Exit Do Case "eval" Evaluate sArguments Case "echo" Evaluate "wscript.echo " & sArguments Case "set" Evaluate "Set " & sArguments Case "run" Evaluate "oShell.Run " & sArguments End Select End If Loop Sub Evaluate( sArg ) On Error Resume Next ExecuteGlobal sArg If Err.Number <> 0 Then WScript.Echo "Error:",Err.Number WScript.Echo vbTab, Err.Source WScript.Echo vbTab, Err.Description Err.Clear End If On Error GoTo 0 End Sub Keywords at this point are: quit, exit, bye, eval, echo, set and run. Below is a sample session. >> foo foo? >> my dog has fleas my? >> eval dim a >> eval a = 1000 >> echo a*a 1000000 >> echo b >> set Error: 1002 Microsoft VBScript compilation error Syntax error >> set x Error: 1011 Microsoft VBScript compilation error Expected '=' >> set x= Error: 1002 Microsoft VBScript compilation error Syntax error >> set x=1 Error: 424 Microsoft VBScript runtime error Object required >> set onotes = createobject("notes.notessession") >> echo onotes.username CN=Bruce Axtens/O=XXXX >> bye Now my own version adds a little to this framework by including a .vbs file full of extra symbols, procedures and classes. I've reproduced it below just so that you can see how to do a synthetic include in VBScript. Interestingly, the technique also works in HTAs. option explicit Function GetEnv( strEnvVar ) Dim oProcessEnvironment Dim sResult With CreateObject( "WScript.Shell" ) GetEnv = .Environment( "PROCESS" )( UCase( strEnvVar ) ) End With End Function Sub Include( scriptName ) Dim sScript Dim oStream 'on error resume next err.clear With CreateObject( "Scripting.FileSystemobject" ) Set oStream = .OpenTextFile( scriptName ) End With If Err.Number > 0 Then MsgBox "Could not open " & scriptName WScript.Quit End If Err.Clear sScript = oStream.ReadAll() oStream.Close ExecuteGlobal sScript If Err.Number <> 0 Then Die "Error in loaded script" End If On Error Goto 0 End Sub Include GetEnv( "USERPROFILE" ) & "\Desktop\Stuff\Dev\Lib.vbs" Dim oNotes Set oNotes = CreateObject( "Notes.NotesSession" ) Dim sLine Dim aLine Dim sKeyword Dim sArguments Do While True WScript.StdOut.Write ">> " sLine = WSCript.StdIn.ReadLine aLine = Split( sLine, " ", 2 ) If UBound( aLine ) > -1 Then sKeyword = aLine( 0 ) If UBound( aLine ) > 0 Then sArguments = aLine( 1 ) Else sArguments = "" End If Select Case LCase( sKeyword ) Case "quit", "exit", "bye" Exit Do Case "eval" Evaluate sArguments Case "echo" Evaluate "wscript.echo " & sArguments Case "set" Evaluate "Set " & sArguments Case "run" Evaluate "oShell.Run " & sArguments Case Else WScript.Echo sKeyword & "?" End Select End If Loop Sub Evaluate( sArg ) On Error Resume Next ExecuteGlobal sArg If Err.Number <> 0 Then WScript.Echo "Error:",Err.Number WScript.Echo vbTab, Err.Source WScript.Echo vbTab, Err.Description Err.Clear End If On Error GoTo 0 End Sub Enjoy.

[VBScript] CSV to variables using Execute

Nico wrote, on microsoft.public.scripting.vbscript:

I need ASP to read the CSV file to read lines 2 on-wards and display it back to the user for verification. Each line has aprx 8 "," that control user properties.

I am looking for each line to be displayed back to the user without the "," so they can verify and write to an access db.

All i am looking for is a simple way to read the text display to the user for acceptance before writing it back to the db.

I wrote a response but thought a fuller treatment was in order, thus the following:

Data, stored in DEMO.CSV 0084,DALTON,ANGELA,01-08-06,15:07:29,16:04:04,00:56:35 0085,CONNELLY,BILLY,01-08-06,15:07:29,16:04:04,00:56:35 0086,LE CHOCOLATE FACTORIE,CHARLEY,01-08-06,15:07:29,16:04:04,00:56:35 0087,INT LIONSDEN,DANIEL,01-08-06,15:07:29,16:04:04,00:56:35 0088,SMITH,EDWINA,01-08-06,15:07:29,16:04:04,00:56:35 0089,L'KING,FREDERICK,01-08-06,15:07:29,16:04:04,00:56:35 Then the code which does nothing other than read the file, store the data in variables for each line of data, and for effect, echoes the first and last names Dim OPID Dim LastName Dim FirstName Dim CallDate Dim LogonTime Dim LogoffTime Dim WorkHours Dim aVars aVars = Array( "OPID", "LastName", "FirstName", "CallDate", "LogonTime", "LogoffTime", "WorkHours" ) Dim oFSO Set oFSO = CreateObject( "Scripting.FileSystemobject" ) Const INPUT_FILE = "DEMO.CSV" Dim oStream Dim sData Dim aData Set oStream = oFSO.OpenTextFile( INPUT_FILE ) oStream.SkipLine Do While oStream.AtEndOfStream = False sData = oStream.ReadLine aData = Split( sData, "," ) For i = 0 To UBound( aData ) Execute aVars( i ) & " = " & Chr( 34 ) & aData( i ) & Chr( 34 ) Next 'At this point all the vars referred to in aVars have the values 'of the current record WSCript.Echo FirstName, LastName Loop oStream.Close And here's the results of the run, taken from SciTE's output window ANGELA DALTON BILLY CONNELLY CHARLEY LE CHOCOLATE FACTORIE DANIEL INT LIONSDEN EDWINA SMITH FREDERICK L'KING A possible extra step would be to read the header line, strips the spaces, build the "Dim" statements and execute them as well. Or maybe, create an instance of "Scripting.Dictionary" and use that. Or ... well, there must be more than two ways to do it, even in VBScript!

[VBScript] Threads ... thin ones

The following is an attempt at threads in VBScript. The code owes a lot to Greg Chapman of MouseTrax Computing Solutions. There are two scripts, the first calling the second (in many instances). The means for communicating between the two is via the Volatile environment. When the script runs, Outlook flickers (don't know why).

There are comments, but the basic idea is to keep a watch over how many instances of cscript.exe there are running and while there's only so many, add more. Use the Volatile environment for semaphores and make sure there's enough delay in there to get stuff to and from Volatile (which is actually in Registry and not blazingly fast).

First the controller. '~ get list of pcs '~ for each pc in list '~ while threadcount <= max '~ launch thread with i, <pc> '~ for i = 0 to max '~ if var thread.i.status in volatile = "completed" then '~ load up text in thread.i.name.txt to database '~ 'remove thread.i.status and thread.i.name from volatile env '~ remove thread.i.name.txt '~ end if '~ wend '~ next '~ for i = 0 to max '~ remove thread.i.name from volatile '~ remove thread.i.status from volatile '~ next '~ threadcode: '~ get thread number from arguments (i) '~ get pc from arguments '~ put "running" into thread.i.status in volatile env '~ get owner of explorer.exe '~ store in <pc>.txt file '~ put path of <pc>.txt file into thread.i.name of volative env '~ put "completed" into thread.i.status '~ exit Option Explicit Dim oFSO Set oFSO = CreateObject( "Scripting.FileSystemobject" ) Dim oShell Set oShell = CreateObject( "WScript.Shell" ) Dim oVolatile Set oVolatile = oShell.Environment("VOLATILE") Const THREADS_MAX = 7 Dim i For i = 0 To THREADS_MAX oVolatile( "Thread." & i & ".status" ) = "" Next Dim aReport Dim nAvailable Dim aComputers Dim j Dim sFile Dim sData Dim nMaxComp Dim sStatus Dim sName ReDim aReport( 0 ) aComputers = GetDomainComputers( "THEDOMAIN" ) nMaxComp = UBound( aComputers ) i = 0 Do While True If ThreadCount() <= THREADS_MAX Then nAvailable = AvailableThread( THREADS_MAX ) '~ WScript.Echo "next available slot " & nAvailable IF nAvailable = -1 Then 'Error Condition. Crash out. '~ WScript.Echo "nAvailable = -1 but ThreadCount says " & ThreadCount() & " against a max of " & THREADS_MAX ProcessCompletions Else '~ WSCript.Echo "Launching " & nAvailable & " on " & aComputers( i ) WScript.Echo aComputers( i ) & " @ " & nAvailable LaunchThread nAvailable, aComputers( i ) WScript.Sleep 1000 i = i + 1 End If Else ProcessCompletions End If If i > nMaxComp Then Exit Do End If Loop WriteFile2 oFSO.GetParentFolderName( WScript.ScriptFullName ) & "\Report.txt", Join( aReport, vbNewLine ), WF_CREATE Sub ProcessCompletions Dim j Dim sName Dim sStatus Dim sFile Dim sData For j = 0 To THREADS_MAX sName = "Thread." & j & ".name" sStatus = "Thread." & j & ".status" If oVolatile( sStatus ) = "completed" Then '~ WScript.Echo "Thread " & j & " completed." sFile = oVolatile( sName ) '~ WScript.Echo "Trying to read " & sFile On Error Resume Next sData = ReadFile( sFile ) If Err.Number <> 0 Then sData = "Could not open " & sFile End If Err.Clear On Error Goto 0 AAdd aReport, sData ' put into database later On Error Resume Next oFSO.DeleteFile( sFile ) Err.Clear On Error GoTo 0 oVolatile( "Thread." & j & ".status" ) = "" End If Next End Sub 'http://www.windowsitpro.com/WindowsScripting/Article/ArticleID/4734/4734.html '---------------------------------------------------------------- ' Function: GetDomainComputers ' Description: Returns a listing of NT Computer Accounts for a ' given domain ' Parameters: ByVal strDomain - Name of an NT Domain to retrieve ' the list of Computer from. ' Returns: Variant array of NT Computer names for the ' specified domain. '---------------------------------------------------------------- Public Function GetDomainComputers(ByVal strDomain) Dim objIADsContainer ' ActiveDs.IADsDomain - ' Container object Dim objIADsComputer ' ActiveDs.IADsComputer Dim vReturn ' Variant ' connect to the computer. Set objIADsContainer = GetObject("WinNT://" & strDomain) ' set the filter to retrieve only objects of class Computer objIADsContainer.Filter = Array("Computer") ReDim vReturn(0) For Each objIADsComputer In objIADsContainer If Trim(vReturn(0)) <> "" Then ReDim Preserve vReturn(UBound(vReturn) + 1) End If vReturn(UBound(vReturn)) = objIADsComputer.Name Next GetDomainComputers = vReturn Set objIADsComputer = Nothing Set objIADsContainer = Nothing End Function Function ThreadCount() Dim cProcs, oProc Dim nCount Set cProcs = GetObject( "winmgmts:{ImpersonationLevel = Impersonate}\\.").InstancesOf( "Win32_Process" ) nCount = 0 For Each oProc in cProcs If LCase( oProc.Caption ) = "cscript.exe" Then nCount = nCount + 1 End If Next '~ WScript.Echo "ThreadCount is " & nCount Set cProcs = Nothing ThreadCount = nCount End Function Function AvailableThread( nMax ) Dim i Dim sThread Dim nAvailable Dim sValue nAvailable = -1 For i = 0 To nMax sThread = "Thread." & i & ".status" sValue = oVolatile( sThread ) If sValue = vbNullString Then nAvailable = i Exit For End If Next AvailableThread = nAvailable End Function Sub LaunchThread( nThread, sPC ) Dim sCmd sCmd = "cscript.exe " & dq( oFSO.GetParentFolderName( WScript.ScriptFullName ) ) & "\db_build_thread.vbs" & " " & nThread & " " & sPC oShell.Run sCmd,0,False End Sub Function DQ( sText ) DQ = Chr( 34 ) & sText & Chr( 34 ) End Function Function ReadFile( FileName) Dim oStream Dim sData sData = VBNullString Set oStream = oFSO.OpenTextFile(FileName) sData = oStream.ReadAll oStream.Close ReadFile = sData End Function Function AAdd( ByRef aToThis, ByVal xAddThis ) Dim nPos nPos = UBound( aToThis ) + 1 '~ WScript.Echo nPos ReDim Preserve aToThis( nPos ) aToThis( nPos ) = xAddThis AAdd = nPos End Function Const WF_APPEND = 1 Const WF_CREATE = 2 Const WF_FOR_APPENDING = 8 Const WF_FOR_WRITING = 2 Const WF_CREATE_NONEXISTING = True Sub WriteFile2( sFilename, sContents, nMode ) Dim oStream If nMode = WF_APPEND Then Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_APPENDING, WF_CREATE_NONEXISTING ) ElseIf nMode = WF_CREATE Then Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_WRITING, WF_CREATE_NONEXISTING ) Else Die "Mode incorrectly set for WriteFile2" End If oStream.Write sContents oStream.Close End Sub Then the controlled. '~ threadcode: '~ get thread number from arguments (i) '~ get pc from arguments '~ put "running" into thread.i.status in volatile env '~ get owner of explorer.exe '~ store in <pc>.txt file '~ put path of <pc>.txt file into thread.i.name of volative env '~ put "completed" into thread.i.status '~ exit 'objects and vars Dim oFSO Set oFSO = CreateObject( "Scripting.FileSystemobject" ) Dim oShell Set oShell = CreateObject( "WScript.Shell" ) Dim oNetwork Set oNetwork = CreateObject("WScript.Network") Dim oVolatile Set oVolatile = oShell.Environment("VOLATILE") Const WF_APPEND = 1 Const WF_CREATE = 2 Const WF_FOR_APPENDING = 8 Const WF_FOR_WRITING = 2 Const WF_CREATE_NONEXISTING = True Sub WriteFile2( sFilename, sContents, nMode ) Dim oStream If nMode = WF_APPEND Then Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_APPENDING, WF_CREATE_NONEXISTING ) ElseIf nMode = WF_CREATE Then Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_WRITING, WF_CREATE_NONEXISTING ) Else Die "Mode incorrectly set for WriteFile2" End If oStream.Write sContents oStream.Close End Sub Function GetDomainUser( sComputer ) Dim cProc Dim oProcess Dim sUser, sDomain Dim sResult Dim oWMI sResult = "<not switched on>" If ResolveIP( sComputer ) <> Empty Then On Error Resume Next Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2") If Err.Number = 0 Then 'Get currently logged on user and update CurrentUser element. 'This bit of code is "cheating" slightly in that all it's doing is getting the owner of the explorer.exe process. Seeing as explorer.exe 'only runs if a user is logged on it is a reliable (but sneaky) way of getting the logged-on user. It does, however, mean that even if a 'user is logged on locally or the account is a generic account, it will retrieve the correct values (WMI cannot do this). Set cProc = oWMI.ExecQuery("Select Name from Win32_Process Where Name='explorer.exe' and SessionID=0") If cProc.Count > 0 Then For Each oProcess In cProc oProcess.GetOwner sUser, sDomain sResult = sDomain & "\" & sUser Next Else sResult = "<not logged on>" End If Err.Clear On Error Goto 0 End If End If GetDomainUser = sResult End Function Function ResolveIP( sName ) Dim sHost Dim sTarget Dim cPingResults Dim oPingResult Dim sResult sResult = "" sHost = oNetwork.ComputerName sTarget = sName Set cPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//" & _ sHost & "/root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus " & _ "WHERE Address = '" + sTarget + "'") For Each oPingResult In cPingResults If oPingResult.StatusCode = 0 Then sResult = oPingResult.ProtocolAddress End If Next ResolveIP = sResult End Function Dim oArgs Set oArgs = WScript.Arguments.Unnamed Dim nThreadNumber Dim sPC If oArgs.Count < 1 Then WScript.Echo WScript.ScriptName & " <threadnumber> <pc>" WScript.Quit End If nThreadNumber = oArgs( 0 ) sPC = oArgs( 1 ) 'WScript.Echo nThreadNumber, sPC Dim sOutput oVolatile( "Thread." & nThreadNumber & ".status" ) = "running" sOutput = oFSO.GetParentFolderName( WScript.ScriptFullName ) & "\" & sPC & ".txt" '~ WScript.Echo sOutput oVolatile( "Thread." & nThreadNumber & ".name" ) = sOutput Dim sDomUser sDomUser = GetDomainUser( sPC ) WriteFile2 sOutput, sPC & vbTab & sDomUser, WF_CREATE oVolatile( "Thread." & nThreadNumber & ".status" ) = "completed" There are quite a few extra useful routines in all that code, including an AADD(), and assorted WMI related routines.

I'm in the process of putting the thread functionality inside a Class so that I can change how things are done without causing drastic rewrites of the original VBScripts. I'm not entirely pleased with the Volatile environment and may end up playing with something else that can be used as a shared storage area between many programs ... like subdirectory structures.

[VBScript] Deriving user name from computer name

I found a brilliant bit of code for deriving the username from the computer name. It's found inside Matt Williams's "ManagePC v1.31" HTA. His description of the routine is as follows

This bit of code is "cheating" slightly in that all it's doing is getting the owner of the explorer.exe process. Seeing as explorer.exe only runs if a user is logged on it is a reliable (but sneaky) way of getting the logged-on user. It does, however, mean that even if a user is logged on locally or the account is a generic account, it will retrieve the correct values (WMI cannot do this).
-- Matthew Williams, ManagePC

Below is my routine, combining his code with some extra housekeeping. Function GetDomainUser( sComputer ) Dim cProc Dim oProcess Dim sUser, sDomain Dim sResult Dim oWMI sResult = "<not switched on>" If ResolveIP( sComputer ) <> Empty Then On Error Resume Next Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2") If Err.Number = 0 Then Set cProc = oWMI.ExecQuery("Select Name from Win32_Process Where Name='explorer.exe' and SessionID=0") If cProc.Count > 0 Then For Each oProcess In cProc oProcess.GetOwner sUser, sDomain sResult = sDomain & "\" & sUser Next Else sResult = "<not logged on>" End If Err.Clear On Error Goto 0 End If End If GetDomainUser = sResult End Function Of course, if no one is logged in, you get nothing. My own take on Matt's routine adds in a check to see if the computer is actually running, using ResolveIP() below: Function ResolveIP( sName ) Dim sHost Dim sTarget Dim cPingResults Dim oPingResult Dim sResult sResult = "" sHost = oNetwork.ComputerName sTarget = sName Set cPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//" & _ sHost & "/root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus " & _ "WHERE Address = '" + sTarget + "'") For Each oPingResult In cPingResults If oPingResult.StatusCode = 0 Then sResult = oPingResult.ProtocolAddress End If Next ResolveIP = sResult End Function

[VBScript] Plugins

I had written a plugin architecture for one of my HTA applications. Now I discover that I can have plugins using almost any scripting language available. I found this bit of brilliance in a google search: "Hartmut Callies" <Spam_callies@web.de> wrote in message news:%23$FV8t07FHA.3044@TK2MSFTNGP10.phx.gbl... > > Hello, > I have two vbScripts. In a.vbs I will create a global variable glVariable as > String, so that > I can read this variable in a other script (b.vbs) - msgBox glVariable. > How can I do that? Considering using the volatile environment. Set the variable in a.vbs like this: oWSH.Environment("VOLATILE")("glVariable") = "Information from script a.vbs" Read it from b.vbs using something like this: sVar = oWSH.Environment("VOLATILE")("glVariable") I can now pass whatever information I like to and fro from application to plugin and back again. And if another scripting languages does something better than VBScript I can use it (provided it gives access to the volatile store).

[Working Again]

After a short stint on the support queue at iiNet (part-time), I'm now on contract at Department of Land Information. L1 and L2 support with a bit of scripting on the side. VBScript again, sadly.

[Pharmacy Software]

One of my clients has suggested I write pharmacy software. He has a home-grown Clipper app that does everything from Dispensing to Cash Register. I give him a hand with it from time to time. He reckons there's a market for a low-cost package which would fit the Western Australian situation better than the off-the-shelf ones now available.

So comes then the ever-present question: Closed Source, or Open Source.

No knowing a lot about how Open Source works as an income generator, I fear that there is the risk that my non-Open Source competitors may steal my ideas and woo my customers away because they have the resources to bring them (the ideas, not the customers) to the market faster than I can. Is that a valid concern?

Closed Source isn't without its problems either.

And then comes the other questions: programming language / IDE / RAD. I wonder if anyone's come up with a template for software projects in the style of Word / Excel / PowerPoint templates.

[Visual Studio 2005 Team System Beta 2]

I went to a Microsoft do yesterday and that's what they gave me (amongst other things.) Now to find a machine to install it on (only Linux, MacOSX and Win98 at home).

Eventually I want to start bidding on jobs at Get A Coder and Get a Freelancer.

Until then ... Khuda janta he.

[VBScript] Shell and Heap Sorts

The final versions of the Shell sort and Heap sort classes. First the ShellSorter:

class ShellSorter 
'~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/shell/shell.htm
    private a
    private n

    public sub sort(a0)
        a = a0
        n = UBound( a ) + 1
        shellsort
    end sub

    public function sorted()
        sorted = a
    end function

    private sub shellsort()
        dim i, j, k, h, t
        dim cols
        cols = array( 1391376, 463792, 198768, 86961, 33936, _
                    13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1 )
        
        for k = 0 to UBound( cols )
            h = cols( k )
            for i = h to n - 1
                j = i
                t = a( i )
                do while j >= h
                    if a( j - h ) <= t then exit do
                    a( j ) = a( j - h )
                    j = j - h
                loop
                a( j ) = t
            next
        next
    end sub
end class

and then the HeapSorter

class HeapSorter 
    '~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/heap/heapen.htm
    private aVector
    private n

    public sub sort( aVec )
        aVector = aVec
        n = UBound( aVector ) + 1
        heapsort
    end sub

    public function sorted()
        sorted = aVector
    end function

    private sub heapsort()
        buildheap
        do while n > 1
            n = n - 1
            exchange 0, n
            downheap 0
        loop
    end sub

    private sub buildheap()
        dim v
        for v = int( n / 2 ) - 1 to 0 step -1
            downheap v
        next
    end sub

    private sub downheap(v)
        dim w
        w = 2 * v + 1   '// first descendant of v
        do while w < n
            if w + 1 < n then   '// is there a second descendant?
                if aVector( w + 1 ) > aVector( w ) then
                    w = w + 1
                end if
            end if

            '// w is the descendant of v with maximum label
            if aVector( v ) >= aVector( w ) then
                exit sub  '// v has heap property
            end if

            '// otherwise
            exchange v, w  '// exchange labels of v and w
            v = w          '// continue
            w = 2 * v + 1
        loop
    end sub

    private sub exchange(i, j)
        dim t
        t = aVector( i )
        aVector( i ) = aVector( j )
        aVector( j ) = t
    end sub

end class

By the way, I'm unemployed again. Things might be a bit quiet around here for a while.

[VBScript] sorting algorithms

Thanks to Dr Hans Werner Lang for his helpful comments on the sorting routines, as below:

Hi,
but there is no need to rewrite the outer loop, is it?
    for i=h to n-1
    ...

The inner loop, with the problem of the conditional And, could be written as
    do while j>=h
        if a(j-h)<=t then exit do
        ...
    loop

In my opinion, exit do should be avoided (when possible).

Regards
H.W. Lang

I've made the changes to the class as suggested but haven't posted them as yet.

[MetaCard] Starter Kit script size limit, Part 2

And if anyone was curious what happened to the MetaCard script size issue, Ken Ray said,

>I've been told, via the MetaCard list, that you have a technique for
>getting around the script size limit in MetaCard. If that's so, please
>can you tell me whence I can download the whitepaper about it.

Sorry to disappoint you, Bruce, but I don't. In fact, given that DreamCard is only $99, it seems counterproductive to attempt to get around the script size limits when you can pick up a full development environment very inexpensively.

and Geoff Canyon said

I don't recall that I wrote anything in particular. I did write an exporter for the documentation for earlier versions of Revolution, and they had a small section on dealing with the script limits in the starter kit. The basic point is to understand how to write tight code. You can insert scripts in front and back, and "start using" stacks, and use nested groups to your advantage. You can also store scripts in custom properties and use the "do" command on them.

If you ask on the mailing list, there are several people there who spent significant time working within the script limits who can probably help you with any specific issues. I bought a license early on so I don't have much practical experience.

Finally, if you're concerned about whether Rev is a good fit for what you want to do, ask on the list. People will tell you the truth. There are (many) things Rev is very good for, and (almost as many) things it isn't well suited for.
>I'm told that, sometime late last century, you wrote
>something about side-stepping the script size limit in
>the MetaCard unregistered version.

So the upshot of all this is: spend some money and stop complaining.

[xbScript] Hooley Dooley! Move over VBScript, here comes xbScript

This is just amazing! "xbScript.dll enables xBase scripting (exactly like MS vbScript and JScript) in any MS ActiveScript compliant Host." Now I can help a friend, who has a large legacy Clipper app running in DOS under Windows, to integrate his software into the Windows environment. And he won't have to learn another language when he wants to tweak things. Hallelujah!!

[EOC] T minus 2 and counting

It's Thurday. I'm busily updating the documentation.

Friday 14 October is "The Last Day". (I wish it was THE last day, that is, the day Jesus returns.)

Of the 19 agencies I've written to, 4 have replied to say they're working on it. Looks like it's back to getting suited up and walking from agency to agency in the Perth CBD saying, "G'day, remember me? Yeah, I'm actually 3D and have feelings."

There's this disease one can get -- I get it often -- called PLOM disease: Poor Little Old Me.

[VBScript] Please, please, no more sorting!!

After so many tries, I had thought I was done with it. Well the virtual memory limit on my machine still stands so when the shellSort encountered an array of 1.5 million records, it failed. I could have gone ahead with getting the VM size increased but decided it was better to deal with the limitation as it stood. Who knows, the next bloke may not have much virtual memory either (though, I suppose, he's more likely to have lots more.)

I handed the job over to SORT.EXE and used the Exec method to call it. Like this: Dim sSamplesFilename, sSamplesData, aSamplesData, sSampleItem sSamplesFilename = Join( Array( sReportPath, sTableName & "_DataStream.txt" ), "\" ) If isFile2( sSamplesFilename ) Then oSamples.ReadFile sSamplesFilename End If WScript.Echo "Sorting " & FormatNumber( oSamples.ByteLength / 2, 0,,,-1) & " Unicode bytes to " & BaseName( sSamplesFilename ) oSamples.WriteFile "TemporaryFile.$$$", adSaveCreateOverWrite SortFile "TemporaryFile.$$$", sSamplesFilename The actual call to SortFile is what were talking about but the oSamples stuff needs some explaining. Dim oSamples Set oSamples = New SuperContainer SuperContainer is a class based on the ADODB.Streams object. Class SuperContainer private oStream Private Sub Class_Initialize() Set oStream = CreateObject( "ADODB.Stream" ) oStream.Open End Sub Public Sub Store( sText ) oStream.WriteText sText End Sub Public Function Recall() Dim sResult oStream.Position = 0 sResult = oStream.Read( adReadAll ) Recall = sResult End Function Public Sub ReadFile( sFilename ) Dim sText Dim aText Dim sItem Dim nStart Dim nFinish If IsFile2( sFilename ) = True Then sText = Chomp( GetFile( sFilename ) ) aText = Split( sText, VbNewLine ) nStart = oStream.Position For Each sItem in aText oStream.WriteText sItem & VbNewLine Next nFinish = oStream.Position WScript.Echo FormatNumber( nFinish - nStart / 2, 0,,,-1) & " ubytes read from " & sFilename Else WScript.Echo "Cannot find " & sFilename End If End Sub Public Sub WriteFile( sFilename, nMode ) oStream.SaveToFile sFilename, nMode End Sub Private Sub Class_Terminate() oStream.Close Set oStream = Nothing End Sub Public Function ByteLength() ByteLength = oStream.Size End Function End Class Interestingly I had a lot of trouble with the ReadFromFile method in ADODB.Stream. I think this had to do with it expecting Unicode but getting ASCII. When you hand a Unicode file over to SORT.EXE, it sorts it okay but changes it into ASCII. ReadFromFile tries to interpret the file as Unicode and you end up with a mess. Thus the GetFile()/Split/For Each thing in my ReadFile method.

The code for the sorting routine is: Sub SortFile( sInputFilename, sOutputFilename ) Const sCommandline = "SORT ""%IN%"" /O ""%OUT%""" Dim oExec Dim sCommand sCommand = Subst3( sCommandline, Array( Array( "IN", sInputFilename ), Array( "OUT", sOutputFilename ) ) ) If bDebugging = True Then Info "SortFile: Exec> " & sCommand End If Set oExec = oShell.Exec( sCommand ) Do While oExec.Status <> 1 WScript.Sleep 100 Loop If bDebugging = True Then If Not oExec.StdOut.AtEndOfStream Then Info "SortFile: StdOut> " & oExec.StdOut.ReadAll End If End If End Sub I have a global in my stdFunctions.vbs called bDebugging. It's normally False but I can change it and get some useful feedback thereby.

The upshot of all this is that the sorting seems to be working ... but still not perfectly -- when I gave SORT.EXE a 63 Gigabyte file it didn't like it. But the likelihood of generating datasets that large is low.

[VBScript] read and write local and remote files

Check out a wonderful write up by Antonin Foller of PSTRUH Software on reading and writing files in VBScript. Note the very helpful stuff on Binary Files.

[General] Mergesort

This is a great site for algorithms, like Mergesort. A round of applause for the author, Prof. Dr. H. W. Lang.

It's mostly German language, but there are some English translations and the Java code is fairly human-language-neutral.

[VScript] At last, a working shell sort

Finally found a shell sort that works. The problems I had previously might have been had because of this: while (j>=h && a[j-h]>t) I converted that straight to VBScript and kept crashing because a[j-h] with a negative index would get evaluated. By using a do/loop and breaking the test up into two parts do if j < h then exit do end if if a( j - h ) <= t then exit do end if ... I got stuff to work. Here's the code. Usage is similar to that for heap sort. class ShellSorter '~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/shell/shell.htm private a private n public sub sort(a0) a = a0 n = UBound( a ) + 1 shellsort end sub public function sorted() sorted = a end function private sub shellsort() dim i, j, k, h, t dim cols cols = array( 1391376, 463792, 198768, 86961, 33936, _ 13776, 4592, 1968, 861, 336, 112, 48, 21, 7, 3, 1 ) for k = 0 to UBound( cols ) h = cols( k ) i = h do if i >= n then exit do end if j = i t = a( i ) do if j < h then exit do end if if a( j - h ) <= t then exit do end if a( j ) = a( j - h ) j = j - h loop a( j ) = t i = i + 1 loop next end sub end class

[VBScript] Arrrghh!! Sorting out sorting ...

Just when I thought my problems were all over ... or at least the sorting ones ... I found that my machine didn't have enough virtual memory to handle the sort using ADODB (and I don't have the privilege level to do anything about it).

So I ported a heap sort to VBScript and ... so far ... everything look like it's going to work.

Here's the code class HeapSorter '~ http://www.iti.fh-flensburg.de/lang/algorithmen/sortieren/heap/heapen.htm private aVector private n public sub sort( aVec ) aVector = aVec n = UBound( aVector ) + 1 heapsort end sub public function sorted() sorted = aVector end function private sub heapsort() buildheap while n > 1 n = n - 1 exchange 0, n downheap 0 wend end sub private sub buildheap() dim v for v = int( n / 2 ) - 1 to 0 step -1 downheap v next '~ for (int v=n/2-1; v>=0; v--) '~ downheap (v); end sub private sub downheap(v) dim w w = 2 * v + 1 '// first descendant of v while w < n if w + 1 < n then '// is there a second descendant? if aVector( w + 1 ) > aVector( w ) then w = w + 1 end if end if '// w is the descendant of v with maximum label if aVector( v ) >= aVector( w ) then exit sub '// v has heap property end if '// otherwise exchange v, w '// exchange labels of v and w v = w '// continue w = 2 * v + 1 wend end sub private sub exchange(i, j) dim t t = aVector( i ) aVector( i ) = aVector( j ) aVector( j ) = t end sub end class ... and to use it, something like this ... Set oHeap = New HeapSorter oHeap.sort aVector aSortedVector = oHeap.sorted()

[VBScript] Sorting ... another way

I have tried and tried to get Shell sorts working but every algorithm I've tried ends up crashing out with negative indexes into the array.

So below is another way around the whole issue: create a RecordSet, populate it with fields, add data to it and use the RecordSet's own internal sorting routines. class Container2 private oRecordSet Private Sub Class_Initialize() Const adVarWChar = 202 Dim oFields Set oRecordSet = CreateObject( "ADODB.RecordSet" ) Set oFields = oRecordSet.Fields oFields.Append "Data", adVarWChar, 255 oRecordSet.Open End Sub Public Sub Add( sText ) oRecordSet.AddNew "Data", sText End Sub Public Function Extract() Const adClipString = 2 Dim sResult sResult = oRecordSet.GetString( adClipString, oRecordSet.RecordCount, , , "") Extract = sResult End Function Public Sub Sort( sDirection ) Dim sSort sDirection = UCase( Left( sDirection, 1 ) ) Select Case sDirection Case "A" sSort = "Data ASC" Case "D" sSort = "Data DESC" Case Else sSort = "" ' no sort, natural order End Select WScript.Echo "Sorting " & oRecordSet.RecordCount & " items" oRecordSet.Sort = sSort End Sub Private Sub Class_Terminate() oRecordSet.Close Set oRecordSet = Nothing End Sub Public Sub SaveData( sFilename ) Const adPersistADTG = 0 oRecordSet.Save sFilename, adPersistADTG End Sub Public Sub SaveXML( sFilename ) Const adPersistXML = 1 oRecordSet.Save sFilename, adPersistXML End Sub end class And a trivial example of its use function rangedRandom( nLoBound, nHighBound ) rangedRandom = Int((nHighBound - nLoBound + 1) * Rnd + nLoBound) end function dim c set c = new container2 randomize dim x(100) for i = 100 to 0 step -1 c.add rangedRandom(1,1000) & vbtab & "my dog has " & i & " fleas" next c.sort "Ascending" wscript.echo c.extract filedelete("dim.dat") c.savedata "dim.dat" filedelete("dim.xml") c.savexml "dim.xml"

[VBScript] Synthetic Includes in Traditional VBScript Files

Most of us are aware of the entry "Synthetic Includes in Traditional VBScript Files" in the Rube Goldberg Memorial Scripting Page.

Today I stumbled across how to embed test routines in the include file without causing these routines to be activated when the file is included.

My include file is called "StdFunctions.vbs". At the bottom of the file I've put If BaseName( WScript.ScriptFullName ) = "StdFunctions.vbs" Then WScript.Echo "Testing StdFunctions.vbs" 'tests go here End If When StdFunctions.vbs is included by a script, ScriptFullName evaluates to the name of that script. It's only when StdFunctions.vbs is run by itself that ScriptFullName ends with "StdFunctions.vbs".

BaseName is one of my routines and look a bit like this: Function BaseName( aFile ) Dim oFSO Set oFSO = CreateObject( "Scripting.FileSystemObject" ) BaseName = oFSO.GetFileName( aFile End Function [later that same day]

Read the manual, Bruce, read the manual: why use Basename with .ScriptFullName when you can just use .ScriptName?