[Batch File] Rediscovering CMD.EXE batch scripts

Insanity must be setting in; I’ve been trying to solve RosettaCode tasks with Windows CMD.EXE batch scripts. For example, their A+B task:

A+B - in programming contests, classic problem, which is given so contestants can gain familiarity with online judging system being used.

A+B is one of few problems on contests, which traditionally lacks fabula.

Problem statement Given 2 integer numbers, A and B. One needs to find their sum.

Input data

Two integer numbers are written in the input stream, separated by space.

Output data

The required output is one integer: the sum of A and B.

Example:

Input Output

2 2 4

3 2 5

These are what I posted as solutions:

Prompts version

::aplusb.cmd
@echo off
setlocal
set /p a="A: "
set /p b="B: "
set /a c=a+b
echo %c%
endlocal

All on the commandline version

::aplusb.cmd
@echo off
setlocal
set a=%1
set b=%2
set /a c=a+b
echo %c%
endlocal

Formula on the command line version

::aplusb.cmd
@echo off
setlocal
set /a c=%~1
echo %c%
endlocal

Example of 'Formula on the command line version'

>aplusb 123+456
579
>aplusb "1+999"
1000

Parse the input stream version (thanks to Tom Lavedas on alt.msdos.batch.nt)

::aplusb.cmd
@echo off
setlocal
set /p a="Input stream: "
call :add %a%
echo %res%
endlocal
goto :eof

:add
set /a res=res+%1
shift
if "%1" neq "" goto :add

Example of 'parse the input stream version'

>aplusb
Input stream: 1234 5678
6912
>aplusb
Input stream: 123 234 345 456 567 678 789 890
4082

Batch files are a bit arcane, it’s true, but the extensions added post Windows 2000 make it a lot more entertaining.

[Trivia] What file extension are you?

Which File Extension are You?

[VBScript] Small contributions to RosettaCode

I recently discovered RosettaCode. The initial blurb from the site is as follows:

Rosetta Code is a programming chrestomathy site. The idea is to present solutions to the same task in as many different languages as possible, to demonstrate how languages are similar and different, and to aid a person with a grounding in one approach to a problem in learning another. Rosetta Code currently has 370 tasks, and covers 195 languages, though we do not (and cannot) have solutions to every task in every language.

A variety of tasks are listed, and visitors to this site are invited to solve the tasks in the language of their choice. The tasks cover everything from the mundane Empty Program to the classic Towers of Hanoi, the practical User Input, the mathematically-inclined Lucas-Lehmer test, and the involved yet entertaining RCRPG.

I have made some small contributions to its collection of VBScript programs, as below:

99 Bottles of Beer Array concatenation Assertions Delete a file Execute a Markov algorithm Fibonacci sequence Flatten a list Function definition Generic swap Palindrome detection Pangram checker Program termination Sorting algorithms/Gnome sort Tokenize a string

Feel free to edit what I’ve done and add your own in whatever language takes your fancy.

© Copyright Bruce M. Axtens, 2010.

[Protium] PLEAC 1.0

<@ OMT>-----------------------------</@>
<@ LETVARLIT>string|\n</@>	<@ OMT>two characters, \ and n</@>
<@ LETVARLIT>string|Jon 'Maddog' Orwant</@>	<@ OMT>literal single quotes</@>
<@ OMT>-----------------------------</@>
<@ LETVARLIT>string| </@>	<@ OMT>a "newline" character</@>
<@ LETVARKEY>string|__Newline</@>	<@ OMT>a "newline" character</@>
<@ LETVARLIT>string|Jon "Maddog" Orwant</@>	<@ OMT>literal double quotes</@>
<@ LETVAREXPLIT>string|Jon &pipe;Maddog&pipe; Orwant</@> <@ LETVAREXPLIT>string|Jon <&prot;>Maddog</&prot;> Orwant</@>	<@ OMT>Because | and <@ and </@ are significant there are ways to quote them</@>
<@ LETVARLIT>Bruce Goose|布魯斯鵝</@>	<@ OMT>a variable name containing spaces. A variable containing Unicode. Programming code in Unicode.</@>
<@ OMT>-----------------------------</@>
<@ OMT>Multi-line strings. There is no equivalent to perl's "here" documents in Protium</@>
<@ LETVARLIT>a| This is a multiline string that spans 3 lines (it contains 3 newline characters). </@>
<@ LETVARLIT>string|This is a multiline string that spans 2 lines (it contains 1 newline character).</@>
<@ OMT>-----------------------------</@>

[Protium] PLEAC in Protium

PLEAC, for those unfamiliar with it, is the Programming Language Examples Alike Cookbook. This is a brilliant site which takes examples of Perl, given in Perl Cookbook by Christiansen and Torkington, and invites contributors to demonstrate how other languages implement the same functionality. Many languages are in the process of being compared and contrasted in this way, including Python, Ruby, Tcl and Haskell. All manner of functionality is covered, from Strings, Numbers, Dates and Times through to Internet Services, CGI Programming and Web Automation.

For the next few postings I am going to do a PLEAC for Protium. You won't find Protium on PLEAC's pages because PLEAC is limited to open-source languages. Protium is proprietary and closed-source (at present.)

The challenge with converting from Perl to Protium is similar to that faced by linguists translating from one human language to another: do you translate the sense of the utterance, or do you just translate word for word. For example, the Tok Pisin word rabisman literally means "rubbish man". However, it is almost never used that way. Instead it often carries the sense of "fool" or "good-for-nothing." So when converting the Perl to Protium, I've tried to give the sense of the Perl, rather than follow it line for line or word for word.

There will be the odd non-PLEAC posting, but I will try to work my way through the entire PLEAC, all 300K's worth.

[Jabaco] JaCOB and WScript.Network

I wonder about myself sometimes. Am I sane? For instance, I’ve taken recently to learning and developing with Jabaco. This would seem from one angle, good, and from another, daft. 

Jabaco is a simple programming language with a Visual Basic like syntax. Jabaco enables you to create powerful software for all Java supported operating systems.

So there you have it: a VB6-alike (more or less) syntax targeting the JVM. In my experience, people bagging VB syntax are in the majority. People bagging Java aren’t infrequent either. And I know Java about as well as I know Babylonia Cuneiform.

That said, it’s been a bit of fun figuring things out in Jabaco, and discovering just how effectively one can hook into the Java subsystem.

The code below demonstrates The JACOB Project: A JAva-COM Bridge talking to WScript.Network. Comments are a bit sparse, but VB folk should be able to figure it out quick enough.

Public Sub main(ByJava args() As String)
   Dim myArgs() As String
   myArgs = args
   Dim oShell As ActiveXComponent
   'ActiveXComponent is exported by JACOB and referenced in the IDE
   '(yes, there’s an IDE, and it’s pretty good too) 
   Set oShell = New ActiveXComponent("WScript.Network")
   Dim a As String
   Dim b As String
   Dim c As String
   Dim dShell As Dispatch
   'Dispatch also part of JACOB. Nice that it uses the standard jargon
   Set dShell = oShell.getObject()
   a = Dispatch.call(dShell,"UserDomain")
   b = Dispatch.call(dShell,"ComputerName")
   c = Dispatch.call(dShell,"UserName")
   MsgBox (a & ", " & b & ", " & c)
   comthread.Release()
End Sub

The IDE makes possible ‘compiling’ to an EXE. The code above compiles to about 400K. Of course, the presence of a JRE is implied. And it runs, nicely.

I think I’ll be spending more time with Jabaco. It’s got a lot of promise, especially for the VB-deranged like me.

© Copyright Bruce M. Axtens, 2009.

[VB6] Using VBScript's Escape and UnEscape

Something again from an answer I gave on StackOverflow. This one demonstrates how to use MSScriptControl.ScriptControl to make VBScript's Escape and Unescape functions available to the VB6 programmer.

The best thing would be add MSSCRIPT.OCX to the project, but for the sake of demonstration, I'll use CreateObject instead.

Function Escape(s As String) As String Dim scr As Object Set scr = CreateObject("MSScriptControl.ScriptControl") scr.Language = "VBScript" scr.Reset Escape = scr.Eval("escape(""" & s & """)") End Function Function Unescape(s As String) As String Dim scr As Object Set scr = CreateObject("MSScriptControl.ScriptControl") scr.Language = "VBScript" scr.Reset Unescape = scr.Eval("unescape(""" & s & """)") End Function

Using the code is easy.

'assuming sData contains "よろてそ" sEsc = Escape(sData) 'which gives %u3088%u308D%u3066%u305D sUnEsc = Unescape(sEsc)

It's that simple. And the technique can be used to get at other VBScript functionality. In fact, .Language can have values other than "VBScript", making it possible to interface to any language with a Windows Scripting Host presence.

© Copyright Bruce M. Axtens, 2009

[VB6] MAXDOUBLE, MINDOUBLE, +INFINITY, -INFINITY and NaN

VB6 doesn't seem to be able to specify that a Double contains MAXDOUBLE, MINDOUBLE, +INFINITY, -INFINITY or NaN. (I could be wrong on that as there may be some undocumented feature hiding in there somewhere.)

Anyway, I came up with a way of storing these values into Doubles so that they could be used in a Complex Numbers library I've been writing.

Essentially, I create an 8 byte array, load it up with the relevant values, and then, using API calls and the VarPtr function, store the contents of the array into the storage used by the Double.

Here's the code. First the declarations.

Public MaxDouble As Double Public MinDouble As Double Public NegInfinity As Double Public PosInfinity As Double Public QuietNAN As Double Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (Destination As Any, _ source As Any, ByVal Length As Long) Private Declare Function GetProcessHeap Lib "kernel32" () As Long Private Declare Function HeapAlloc Lib "kernel32" _ (ByVal hHeap As Long, ByVal dwFlags As Long, _ ByVal dwBytes As Long) As Long Private Declare Function HeapFree Lib "kernel32" _ (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long Private Declare Sub CopyMemoryWrite Lib "kernel32" Alias _ "RtlMoveMemory" (ByVal Destination As Long, _ source As Any, ByVal Length As Long) Private Declare Sub CopyMemoryRead Lib "kernel32" Alias _ "RtlMoveMemory" (Destination As Any, _ ByVal source As Long, ByVal Length As Long)

Then the routine that does the work.

Public Sub Init() Dim ptrToDouble As Long Dim byteArray(7) As Byte Dim i As Integer byteArray(7) = &H7F 'maxdbl byteArray(6) = &HEF For i = 0 To 5 byteArray(i) = &HFF Next ptrToDouble = VarPtr(MaxDouble) CopyMemoryWrite ptrToDouble, byteArray(0), 8 byteArray(7) = &HFF 'mindbl byteArray(6) = &HEF For i = 0 To 5 byteArray(i) = &HFF Next ptrToDouble = VarPtr(MinDouble) CopyMemoryWrite ptrToDouble, byteArray(0), 8 byteArray(7) = &H7F '+inf byteArray(6) = &HF0 For i = 0 To 5 byteArray(i) = 0 Next ptrToDouble = VarPtr(PosInfinity) CopyMemoryWrite ptrToDouble, byteArray(0), 8 byteArray(7) = &HFF '-inf byteArray(6) = &HF0 For i = 0 To 5 byteArray(i) = 0 Next ptrToDouble = VarPtr(NegInfinity) CopyMemoryWrite ptrToDouble, byteArray(0), 8 byteArray(7) = &H7F 'quiet NAN byteArray(6) = &HF0 For i = 0 To 5 byteArray(i) = &HFF Next ptrToDouble = VarPtr(QuietNAN) CopyMemoryWrite ptrToDouble, byteArray(0), 8 End Sub

Finally, a slice out of the Complex Numbers project demonstrating the use of some of these declarations.

Public Function IsInfinity(c As Variant) As Boolean Dim bRes As Boolean bRes = False If TypeName(c) = "ComplexNumber" Then If c.Real = PosInfinity And c.Imag = PosInfinity Then bRes = True If c.Real = NegInfinity And c.Imag = NegInfinity Then bRes = True Else If c = PosInfinity Then bRes = True If c = NegInfinity Then bRes = True End If IsInfinity = bRes End Function

Enjoy!

© Copyright Bruce M. Axtens, 2009

[VB6]Searching an ActiveX/COM object for a method

This article was first posted by me on StackOverflow in response to my own question, "How do I search an ActiveX/COM object for a method?". This article is an edited version of the original.

"After Googling around not quite finding what I wanted, I remembered the Edanmo site which got me thinking about TLBINF32.DLL, downloading Microsoft's TLBINF32.CHM and reading up on GetMembersWithSubStringEx.

Below is the implementation of it (done in VB6 with a reference to TLBINF32.DLL), some demo VBScript and output, and the wrapping of that functionality in some VBA.

Public Function SearchTLIMethodsAndProperties(sTypelib As Variant, sSymbol As Variant) As Variant Dim SI As SearchItem Dim aResults As Variant Dim bFound as boolean Dim Groups(1) As InvokeKinds Groups(0) = INVOKE_FUNC Or INVOKE_PROPERTYGET Or _ INVOKE_PROPERTYPUT Or INVOKE_PROPERTYPUTREF ReDim aResults(0) bFound = False With TypeLibInfoFromFile(sTypelib) .SearchDefault = tliStClasses Or tliStEvents For Each SI In .GetMembersWithSubStringEx(sSymbol, Groups) bFound = True arr.AAdd_PostIncrement aResults, SI.Name Next End With if bFound then ReDim Preserve aResults(UBound(aResults) - 1) end if SearchTLIMethodsAndProperties = aResults End Function

VBScript demo. The above code was included in my StdLib DLL in the Registry coclass.

Dim O, R Set O = CreateObject("Std.Registry") Set R = CreateObject("Std.Arrays") WScript.Echo R.ShowStructure( O.SearchTLIMethodsAndProperties( "MSSCRIPT.OCX",""))

Output from the demo (script was run in SciTE).

>cscript "C:\foo\foo.vbs" {Add,AddCode,AddObject,AllowUI,Clear,CodeObject,Column,Count,Description,Error,Eval,ExecuteStatement,HasReturnValue,HelpContext,HelpFile,Item,Language,Line,Modules,Name,NumArgs,Number,Procedures,Reset,Run,SitehWnd,Source,State,Text,Timeout,UseSafeSubset} >Exit code: 0

Finally, the VBA code. A cell has a symbol in it and this routine finds it or returns an error string. (reg. in this case refers to the Registry coclass in the StdLib.DLL)

Public Function LookupSymbol(sLib As String, sSym As String) As String Dim aRes As Variant aRes = reg.SearchTLIMethodsAndProperties(sLib, sSym) Dim i As Integer LookupSymbol = "!!NotFound!!" For i = 0 To UBound(aRes) If LCase$(aRes(i)) = LCase$(sSym) Then LookupSymbol = sSym Exit For End If Next End Function

Hmm ... no error checking. Should fix that.

© Copyright Bruce M. Axtens, 2009

[newLISP] restart-router

The boss said I'd find Lisp addictive, and he was right.

The following is a newLISP implementation of a project attempted in VB6. The VB6 one failed to work consistently. The newLISP one hasn't failed yet.

The situation is that our ADSL connection goes down at random times, necessitating a walk down the hall to the comms room, wherein one turns off the power to the router so that it resets. I found out during the week that if I telnet into the router, give the appropriate password and the enter 'restart', that'll restart the router. Will it reduce the need to walk to the comms room? I really don't know as, all of a sudden, the router is working fine.

Here's the code:

(define (restart-router site , socket str telnetSite) (setq telnetSite (string site)) (setq socket (net-connect telnetSite 23)) (if socket (begin (net-receive socket str 512 "password:") (net-send socket "private\r\n") (net-receive socket str 512 "192.168.0.1>") (net-send socket "restart\r\n") (net-close socket) "Router restarted." ) "No connection. Could not restart router." ) ) (import "user32.dll" "MessageBoxA") (MessageBoxA 0 (restart-router "192.168.0.1") "restart-router" 0) (exit)

I really like the fourth parameter on the net-receive call; not only do I receive but I can look for something in what is received. I suppose testing for not receiving it would be good, but I'll leave that for another time.

Once the restart command is sent, there's no need to attempt a net-receive. Just close the connection. Note also the easy way of referring to and using a function in a DLL.

Using the link.lsp script (which comes in the standard newLISP install) I've been able to turn this code into a standalone EXE, and once I've established that it really does do the job, I'll install it on a couple of other machines in the office.

I suppose we actually need the exercise, but maybe we don't need the aggravation.

By the way, my last newLISP posting has generated an interesting conversation on comp.lang.misc (also mirrored on comp.lang.lisp).

© Copyright Bruce M. Axtens, 2009

[newLISP] reverse-find

I've always thought learning Lisp would be a good thing to do. The purists may argue that newLISP is not the best place to start. Oh well, too bad.

Below is my first (ever) lambda expression, a port of the VBScript RevInstr() function.

(set 'reverse-find (lambda (findThis inThis) (- (length inThis) (find (reverse findThis) (reverse inThis)) (length findThis))))

I must say I'm impressed with newLISP. Note that the minus (-) function above can receive more than one argument. A lot of the functions are like that.

Using the reverse-find is very like the (find) function, as below

(set 'toFind "dog") (set 'sentence "My first dog's fleas are on my second dog's blanket") (println (slice sentence (reverse-find toFind sentence) (length toFind))) ; "dog" (println (slice sentence (reverse-find toFind sentence))) ; "dog's blanket" (println (slice sentence (find toFind sentence))) ; "dog's fleas are on my second dog's blanket"

One thing that differentiates my lambda expression from the in-built find, is in the manner in which an error is flagged.

(catch (find "a" "b") 'result) (println result) ; nil (catch (reverse-find "a" "b") 'result) (println result) ; "ERR: value expected : (find (reverse findThis) (reverse inThis))\r\ncalled from user defined function reverse-find"

I'm not sure at this point why the difference and what to do about it. In my use of (find) I check for a result equal to nil, but with (reverse-find) I have to check to see if the result is a string. For example,

(catch (find "a" "b") 'result) (when (nil? result) (println "not found")) (catch (reverse-find "a" "b") 'result) (when (string? result) (println "not found"))

Doubtless, someone in the newLISP Fan Club will set me straight soon.

© Copyright Bruce M. Axtens, 2009

[Shameless Plug] Resistance Is Useless (an iPhone / iPod Touch app)

A good friend of mine has recently developed an iPhone / iPod Touch app for decoding the colour bands of 4, 5 and 6 band resistors. Check it out!



© Copyright Bruce M. Axtens, 2008

[Networks] How to calculate a netmask

To say that I've been busy of late is somewhat of an understatement. Mind you, I've had time to create a presence over on StackOverflow, and to start "playing" MouseHunt on FaceBook.

I was responding to something over on StackOverflow: "What’s the best way to convert from network bitcount to netmask?" and added my two-bob to the mix with the following bit of VBScript.

option explicit If WScript.Arguments.Unnamed.Count < 1 Then WScript.Echo "WhatMask xxx.xxx.xxx.xxx/xx" Wscript.Quit End If Dim sToFind Dim aParts Dim nSubnet sToFind = WScript.Arguments(0) aParts = Split( sToFind, "/", 2 ) nSubnet = aParts(1) if nSubnet < 1 or nSubnet > 32 then WScript.echo "Subnet out of range [1..32]" Wscript.quit end if Dim sBinary sBinary = String( nSubnet, "1") sBinary = sBinary & String( 32 - nSubnet, "0" ) wscript.echo "0x" & lcase( binary2hexadecimal( sBinary ) ) function binary2hexadecimal( sBin ) dim sSlice dim sResult dim i for i = 1 to len( sBin ) step 4 sSlice = mid( sBin, i, 4 ) sResult = sResult & hex( binary2decimal( sSlice ) ) next binary2hexadecimal = sResult end function function binary2decimal( sFourbits ) dim i dim bit dim nResult nResult = 0 for i = 4 to 1 step -1 bit = mid(sFourbits, i, 1 ) nResult = nResult * 2 + bit next binary2decimal = nResult end function

A few examples runs are as follows:

>whatmask 72.20.10.0/24 0xffffff00 >whatmask 191.33.12.0/17 0xffff1000 >whatmask 10.0.0.1/4 0xf0000000 >whatmask 10.0.0.1/3 0x70000000@text

It's been ages since I did the Cisco coursework (never did sit the exam) so I'm not sure if it's totally correct.

The binary2hexadecimal and binary2decimal functions were interesting to write as I was trying to find simpler, more lateral ways of doing things.

function binary2hexadecimal( sBin ) dim sSlice dim sResult dim i for i = 1 to len( sBin ) step 4 sSlice = mid( sBin, i, 4 ) sResult = sResult & hex( binary2decimal( sSlice ) ) next binary2hexadecimal = sResult end function function binary2decimal( sFourbits ) dim i dim bit dim nResult nResult = 0 for i = 4 to 1 step -1 bit = mid(sFourbits, i, 1 ) nResult = nResult * 2 + bit next binary2decimal = nResult end function

© Copyright Bruce M. Axtens, 2008

[Trivia] Showing off

[Delphi] Updating SysTray

I'd been lurking at ITtoolbox for a while and saw this request for help with updating the system tray.

I've had similar problems myself. For instance, if you use boost or some similar process-control tool to kill the Skype.exe and SkypePM.exe programs, the processes disappear from memory but the system tray still shows the Skype icon until you move the mouse over the icon. Then the tray refreshes, the Skype icon disappears and the remaining icons rearrange.

On Experts Exchange I found a bit of Delphi code which moves the mouse over the systray (using system messages rather than moving the mouse pointer itself.) This convinces Windows to update the systray. Because not everyone has an Experts Exchange membership, I've turned the code into a COM DLL, which you can download. Source is included (Artistic2 license.) A copy of the original Experts Exchange code can be found here.

Once you've registered the DLL (regsvr32 UpdateSysTray.DLL) you can use it in anything that supports ActiveX/COM objects. For example, in VBScript:

set o = createobject("UpdateSysTray.UST") o.UpdateSysTray()

© Copyright Bruce M. Axtens, 2008

[Misc] Trouble is, I don't know how to program in PHP

Which Programming Language are You?

[VBScript] StandardLibrary.zip

For those interested, who haven't been able to download it recently, here's the latest iteration of StandardLibrary.vbs. Now it's called stdlib.vbs and can be obtained from my boost account at the Perth Linux Users Group.

There have been a few changes, mostly additional functions and the odd tweak in favour of better functionality.

Significant in the additions are a few functions for sending emails: Blat, BlatAttachment, ErrorEmail, ErrorEmailApp, RedemptionSend and ThunderbirdSend. If I remember correctly, ErrorEmail has been around for a while, but is included here for completeness sake.

Function Blat( sTo, sSubj, sText ) Const TIMEOUT_LIMIT = 60000 Const TIMEOUT_SLICE = 500 Const BLAT_CMD = "c:\bin\Blat.exe [1] -to [2] -subject [3] -server mail.quux.foo.com -f bar@baz.quux -u foo@bar.baz -pw xxxx -unicode" Dim nTimeout Dim bTimedOut Dim oExec Dim sCmd Dim sFolder Dim sName Dim sPath Dim sSave Dim sResult Dim aResult Dim bResult Dim bDontCare sFolder = oFSO.GetSpecialFolder( TEMPORARY_FOLDER ) sName = oFSO.GetTempName sPath = oFSO.BuildPath( sFolder, sName) WriteFileU sPath, sText, WF_CREATE sCmd = Subst( BLAT_CMD, Array( DQ( sPath ), sTo, DQ( sSubj ) )) bTimedOut = False nTimeout = TIMEOUT_LIMIT Set oExec = oShell.Exec( sCmd ) bDontCare = SetPriority( "blat.exe", REALTIME_PRIORITY ) Do While oExec.Status = 0 Doze TIMEOUT_SLICE nTimeout = nTimeout - TIMEOUT_SLICE If nTimeout < 1 Then bTimedOut = True Exit Do End If Loop sResult = oExec.StdOut.ReadAll aResult = Split( sResult, vbCRLF ) If bTimedOut Or Left( aResult( 2 ), 6 ) = "Error:" Then bResult = False Else bResult = True End If Blat = Array( bResult, sResult ) End Function

Function BlatAttachment( sTo, sSubj, sText, aAttachments ) Const TIMEOUT_LIMIT = 30000 Const TIMEOUT_SLICE = 500 Const BLAT_CMD = "c:\bin\Blat.exe [1] -to [2] -subject [3] -server mail.quux.foo.com -f bar@baz.quux -u foo@bar.baz -pw xxxx -unicode" Dim nTimeout Dim bTimedOut Dim oExec Dim sCmd Dim sFolder Dim sName Dim sPath Dim sSave Dim sResult Dim aResult Dim bResult Dim bDontCare sFolder = oFSO.GetSpecialFolder( TEMPORARY_FOLDER ) sName = oFSO.GetTempName sPath = oFSO.BuildPath( sFolder, sName) WriteFileU sPath, sText, WF_CREATE sCmd = Subst( BLAT_CMD, Array( DQ( sPath ), sTo, DQ( sSubj ) )) bTimedOut = False nTimeout = TIMEOUT_LIMIT Set oExec = oShell.Exec( sCmd ) bDontCare = SetPriority( "blat.exe", REALTIME_PRIORITY ) Do While oExec.Status = 0 Doze TIMEOUT_SLICE nTimeout = nTimeout - TIMEOUT_SLICE If nTimeout < 1 Then bTimedOut = True Exit Do End If Loop sResult = oExec.StdOut.ReadAll aResult = Split( sResult, vbCRLF ) If bTimedOut Or Left( aResult( 2 ), 6 ) = "Error:" Then bResult = False Else bResult = True End If Blat = Array( bResult, sResult ) End Function

Const SLICE = 1024 Sub ErrorEmail( vTo, sSubj, sText ) Dim sCC Dim sTo If IsArray( vTo ) Then sTo = Escape( vTo( 0 ) ) sCC = Escape( vTo( 1 ) ) Else sTo = Escape( vTo ) End If sSubj= Escape( sSubj ) sText = Escape( sText ) If IsArray( vTo ) Then sCmd = Subst( "mailto:[1]?subject=[3]&cc=[2]&body=[4]", Array( sTo, sCC, sSubj, sText ) ) Else sCmd = Subst( "mailto:[1]?subject=[2]&body=[3]", Array( sTo, sSubj, sText ) ) End If '~ MsgBox sCmd On Error Resume Next oShell.Run sCmd ', 0, True If Err.Number <> 0 Then document.parentwindow.clipboardData.SetData "text", UnEscape( sText ) MsgBox "Windows didn't like the size of message. I've put it on the clipboard" sCmd = Subst( "mailto:[1]?subject=[2]", Array( sTo, sSubj ) ) oShell.Run sCmd, 0, True HTASleep 5000 End If End Sub

Sub ErrorEmailApp( cApp, vTo, sSubj, sText ) Dim sCC Dim sTo If IsArray( vTo ) Then sTo = Escape( vTo( 0 ) ) sCC = Escape( vTo( 1 ) ) Else sTo = Escape( vTo ) End If IF cApp <> "" Then cApp = DQ( cApp ) & " " sSubj= Escape( sSubj ) sText = Escape( sText ) If IsArray( vTo ) Then sCmd = Subst( "mailto:[1]?subject=[3]&cc=[2]&body=[4]", Array( sTo, sCC, sSubj, sText ) ) Else sCmd = Subst( "mailto:[1]?subject=[2]&body=[3]", Array( sTo, sSubj, sText ) ) End If On Error Resume Next oShell.Run cApp & sCmd ', 0, True If Err.Number <> 0 Then document.parentwindow.clipboardData.SetData "text", UnEscape( sText ) MsgBox "Windows didn't like the size of message. I've put it on the clipboard" sCmd = Subst( "mailto:[1]?subject=[2]", Array( sTo, sSubj ) ) oShell.Run cApp & sCmd, 0, True HTASleep 5000 End If End Sub

Function RedemptionSend( aRecipients, sSubject, sBody ) dim oSafeItem Dim oItem Dim oApplication Dim oNameSpace Dim sRecip set oSafeItem = CreateObject("Redemption.SafeMailItem") 'Create an instance of Redemption.SafeMailItem set oApplication = CreateObject("Outlook.Application") set oItem = oApplication.CreateItem(0) 'Create a new message oSafeItem.Item = oItem 'set Item property For Each sRecip In aRecipients If sRecip <> "" Then oSafeItem.Recipients.Add sRecip oSafeItem.Recipients.ResolveAll End If Next oSafeItem.Subject = sSubject oSafeItem.Body = sBody oSafeItem.Send End Function

Function ThunderbirdSend( aRecipients, sSubject, sBody, aAttachments ) 'thunderbird.exe -compose "to='foo@nowhere.net,foo@foo.de',subject=cool page,attachment=file:///c:/temp/foode.txt" Dim sRecip Dim sApp Dim sCmd sRecip = "'" & Join( aRecipients, "," ) & "'" Dim sAttItem Dim sAttach For Each sAttItem in aAttachments If sAttItem <> "" Then sAttItem = Replace(sAttItem, "\", "/" ) sAttach = sAttach & "attachment='file:///" & sAttItem & "'," End If Next If Right( sAttach, 1 ) = "," Then sAttach = Left( sAttach, Len( sAttach ) - 1 ) End If sApp = "C:\Program Files\Mozilla Thunderbird\thunderbird.exe" sCmd = Subst( " -compose ""to=[1],subject=[2],body=[3],[4]""", Array( sRecip, sSubject, sBody, sAttach )) oShell.Run DQ( sApp ) & sCmd, 0, False HTASleep 5000 End Function

A while back Derek Parnell wrote a replacement for Euphoria's print function which would show the structure of arrays. ShowStructure and a support routine AsString make this available to the VBScript programmer. By the way, in case you haven't heard, Euphoria is now open-source!

function ShowStructure( vToShow ) dim nCounter dim sResult dim nArraySize sResult = "" if isarray( vToShow ) then nArraySize = ubound( vToShow ) If nArraySize >= 0 Then for nCounter = 0 to nArraySize - 1 sResult = sResult & ShowStructure( vToShow( nCounter ) ) & "," next sResult = "{" & sResult & ShowStructure( vToShow( nArraySize ) ) & "}" Else sResult = "{}" End If else sResult = AsString( vToShow ) end if ShowStructure = sResult end function Function AsString( x ) Dim sResult If TypeName( x ) = "Null" Then sResult = "Null" Else sResult = CStr( x ) End If AsString = sResult End Function

The output, then, from code such as this:

a = Array(1,Array(2,3,Array("moo"))) wscript.echo showstructure(a)

would be

{1,{2,3,{moo}}}

which maybe leads on toward data serialisation ...

There've been some additions to the file handling space, with the addition of routines to read and write unicode files (ReadFileU, WriteFileU, ReadFirstLineU and its ANSI equivalent, ReadFirstLine.)

Logging has been worked on. It's something I'm unlikely to be totally happy with, but there's now a SetLog and a ClearLog as well as the standard Log (and, given the possibility of confusion with the logarithm system, maybe I should change it to Trace (oh man, how many scripts that would break!))

What else? Well, BuildTree builds a directory tree. FirstLineOf returns the first vbNewLine-delimited line from a string (useful where you've used ReadFile or ReadFileU to inhale an entire file.) LastLineOf does what FirstLineOf does but for the end of the file, and NthLineOf gets you the ... nth ... line.

I've actually forgotten what I wrote UpToAndAfter for, but it's included anyway.

IsOnLine uses the ResolveIP function with the IP address 198.182.196.48 (which points somewhere on linux.org) to see if you are still on line.

SetPriority uses the same code as used in BOOST to set process priority.

StrInArray finds a string in an array of strings, with optional case sensitivity.

StringMap scans a string for the presence of items in one array and swaps them for the equivalently indexed elements in the second array. If the second array is a string, they get swapped for that string.

Doze wraps WSCript.Sleep and HTASleep, so that it can be used in .VBS files and .HTA files.

ModalThing2 shows a modal dialog (only works in .HTA files)

And, finally, SoundMessage:

Sub SoundMessage( sSoundFile, sMessage ) Dim sCommand Dim sFullname sCommand = "sndrec32 /play /close " & DQ( sSoundFile ) oShell.Run sCommand, 0, False Doze 1000 Msgbox sMessage End Sub

Obviously, if you see something that needs to be fixed, fix it. And tell me to fix it so that it can be fixed in the distribution and your name can be added to the list of contributors.

© Copyright Bruce M. Axtens, 2008

[Visual BASIC 6] BOOST (v3)

BOOST got another look-in recently. I had been using it exclusively to do "realtime" and "kill". This particular time I tried to do an "abovenormal" -- instead it did a "kill".

In the process of finding and fixing that bug, I replaced the Collection mechanism with the augmented Collection supplied by the "Class Builder" add-in.

The source code is essentially the same as before but with a few changes. First the SysVars and Var classes. (The comments are predominantly those supplied by the add-in.)

First, SysVars.cls:

'local variable to hold collection Private mCol As Collection Public Function Add(key As String, Optional sKey As String) As Var Dim objNewMember As Var 'create a new object Set objNewMember = New Var 'set the properties passed into the method objNewMember.Value = key objNewMember.key = sKey If Len(sKey) = 0 Then mCol.Add objNewMember Else mCol.Add objNewMember, sKey End If 'return the object created Set Define = objNewMember Set objNewMember = Nothing End Function Public Property Get Item(vntIndexKey As Variant) As Var 'used when referencing an element in the collection 'vntIndexKey contains either the Index or Key to the collection, 'this is why it is declared as a Variant 'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5) Set Item = mCol(vntIndexKey) End Property Public Function Exists(vntIndexKey As Variant) As Boolean Dim V As Var On Error Resume Next Set V = mCol(vntIndexKey) Exists = (Err.Number = 0) End Function Public Function Count() As Long 'used when retrieving the number of elements in the 'collection. Syntax: Debug.Print x.Count Count = mCol.Count End Function Public Sub Remove(vntIndexKey As Variant) 'used when removing an element from the collection 'vntIndexKey contains either the Index or Key, which is why 'it is declared as a Variant 'Syntax: x.Remove(xyz) mCol.Remove vntIndexKey End Sub Public Sub Modify(sValue As String, sKey As String) Dim V As Var 'Set V = New Var Set V = mCol.Item(sKey) V.Value = sValue 'mCol.Remove sKey 'Add sValue, sKey End Sub Public Property Get NewEnum() As IUnknown 'this property allows you to enumerate 'this collection with the For...Each syntax Set NewEnum = mCol.[_NewEnum] End Property Private Sub Class_Initialize() 'creates the collection when this class is created Set mCol = New Collection End Sub Private Sub Class_Terminate() 'destroys collection when this class is terminated Set mCol = Nothing End Sub

Next, Vars.cls (it's tiny but it could hold so much more):

Public key As Variant Public Value As Variant

Now the main module. The first thing that is different here, is that nLevel is now a Long. Integer doesn't handle the ABOVENORMAL_PRIORITY value without complaint.

Next change is removing the reference to Collection, changing it to SysVars and setting up the values.

The benefit of using SysVars and that approach to the Collection object is that we now have an .Exists method, so we now have a tidier way of setting nLevel and trapping invalid settings thereof.

Sub Main() Dim sLevel As String Dim nLevel As Long Dim sProcess As String Dim sCommand As String Dim nInstances As Integer Dim cPrio As New SysVars cPrio.Add KILL_PROCESS, "kill" cPrio.Add LOW_PRIORITY, "low" cPrio.Add BELOWNORMAL_PRIORITY, "belownormal" cPrio.Add NORMAL_PRIORITY, "normal" cPrio.Add ABOVENORMAL_PRIORITY, "abovenormal" cPrio.Add HIGH_PRIORITY, "high" cPrio.Add REALTIME_PRIORITY, "realtime" cPrio.Add KILL_PROCESS, "0" cPrio.Add LOW_PRIORITY, "1" cPrio.Add BELOWNORMAL_PRIORITY, "2" cPrio.Add NORMAL_PRIORITY, "3" cPrio.Add ABOVENORMAL_PRIORITY, "4" cPrio.Add HIGH_PRIORITY, "5" cPrio.Add REALTIME_PRIORITY, "6" Dim aArgs As Variant If Command() = "" Then Syntax End End If aArgs = GetCommandLine(2) sProcess = aArgs(0) sLevel = aArgs(1) If sProcess = "" Or sLevel = "" Then Syntax End End If If cPrio.Exists(sLevel) Then nLevel = Val(cPrio.Item(sLevel).Value) Else ConsoleWrite "Invalid selection of runlevel." & vbNewLine Syntax End End If If nLevel = 0 Then nInstances = KillProcess(sProcess) If nInstances = 0 Then ConsoleWrite "No instances of " & sProcess & " found to kill" & vbNewLine Else ConsoleWrite nInstances & " " & IIf(nInstances > 1, "instances", "instance") & " of " & sProcess & " killed." & vbNewLine End If Else ConsoleWrite sProcess & IIf(SetPriority(sProcess, nLevel), _ " boosted", " NOT boosted") & _ " to priority " & sLevel & " (" & nLevel & ")." & vbNewLine End If End Sub

All the other routines are as before.

I haven't gotten around to extending this tool to do stuff to remote computers. It's not hard; killing a process on another machine means another value for sComputer in KillProcess, and, of course, the relevant privilege level.

© Copyright Bruce M. Axtens, 2008

[Perl] How to do it better

There are some really helpful people in the Perl community. I advertised the original posting on comp.lang.perl.misc and received some very useful responses from John W. Krahn and Michele Dondi, as below.

With respect to the rules, John wrote:

# Rule 1. Remove all 's' sub rule1 { ( my $arg = shift ) =~ tr/s//d; return $arg; } # Rule 2. Sort the characters of the word into alphabetic order sub rule2 { return join '', sort split //, shift; }

John> Why [were] you converting the '|' character and the 'e' character to 'e'?

# Rule 3. Convert all vowels to 'e sub rule3 { ( my $arg = shift ) =~ tr/aiou/e/; return $arg; }

John> The . character class matches a lot more than just letters, or did you really mean "replace any first character except newline with 'n'".

# Rule 4. Replace the first letter with 'n' sub rule4 { ( my $arg = shift ) =~ s/\A[[:alpha:]]/n/; return $arg; }

John> The . character class matches a lot more than just letters.

# Rule 5. Drop the last letter sub rule5 { ( my $arg = shift ) =~ s/[[:alpha:]]\z//; return $arg; } # Rule 6. Replace letter pairs with 'ow' sub rule6 { ( my $arg = shift ) =~ s/([[:lower:]])\1/ow/g; return $arg; }

Then, with respect to the string eval() of each rule, John said, "Ouch! Use a dispatch table instead of string eval()."

my %rule = ( 1 => sub { ( my $arg = shift ) =~ tr/s//d; return $arg; }, 2 => sub { return join '', sort split //, shift; }, 3 => sub { ( my $arg = shift ) =~ tr/aiou/e/; return $arg; }, # more rules here ); # and later on, use rules $res = $rule{ $j }( $arg );

At this point Michele Dondi chipped in with, ">my %rule = (
>  1 => sub {
>    ( my $arg = shift ) =~ tr/s//d;
>    return $arg;
>    },
>  2 => sub {
>    return join '', sort split //, shift;
>    },

Since the keys are numbers, an array may be appropriate."

So there you have it, better rules, anonymous subroutines, and hashes. Powerful stuff.

I wonder how Tcl and the other languages would have done it. Or Protium, for that matter. Any takers?

© Copyright Bruce M. Axtens, 2008

[Perl] How not to do it?

The header for this website says, "Some useful stuff and some examples of how not to do it." This may fall into the latter category.

One of my kids had been playing a computer-based game which used a variety of word puzzles. The question he posed to me was to take a word, apply a small set of rules to it, as many times as necessary, and come up with another word. He would supply the rules and both words, and I would supply the sequence of rule applications which would effect the conversion.

(I'm no guru when it comes to Perl, so if you see something that could be expressed in a more efficient manner, please let me know.)

These are the rules:

1. Remove all 's'

sub rule1 { my $arg = shift; $arg =~ s/s//g; return $arg; }

2. Sort the characters of the word into alphabetic order

sub rule2 { my $arg = shift; my @arr = split( //, $arg ); @arr = sort @arr ; $arg = join( '', @arr ); return $arg; }

3. Convert all vowels to 'e'

sub rule3 { my $arg = shift; $arg =~ s/[a|e|i|o|u]/e/g; return $arg; }

4. Replace the first letter with 'n'

sub rule4 { my $arg = shift; $arg =~ s/^./n/; return $arg; }

5. Drop the last letter

sub rule5 { $arg = shift; $arg =~ s/.$//; return $arg; }

6. Replace letter pairs with 'ow'

sub rule6 { $arg = shift; @arr = split( //, "abcdefghijklmnopqrstuvwxyz" ); for $letter ( @arr ) { $arg =~ s/$letter$letter/"ow"/eg; } return $arg; }

My son then said that the start word was 'first' (or 'ant') and the stop word was 'now'. After some fiddling, resulting in the code below, I said, "With these rules you can't get from 'first' to 'now'. Not even from 'ant' to 'now'. But from 'gnat', yes."

So here's the code, for what it's worth. It was assumed that this would be run as a command line tool, so I load up the start word (stored in $root) and a recursion management flag (stored in $managed). Recursion management is defaulted to true. The recursion level is marked with $level and there's a hash, called %deadends, to keep track of "solutions" that shouldn't be pushed any further as they have already been proved not to get any closer to the solution.

my $root = shift; my $managed = shift; $managed = 1 unless defined($managed); my $level = 0; my %deadends;

Everything else happens in the apply function which looks at every possible combination of rules in pursuit of the target word. After getting the word to check from @_ with shift, a couple of variables are declared and a for loop initiated, stepping through the rules.

sub apply { my $arg = shift; my $res; my $reason; for ( my $j = 1; $j <=6; $j++ ) {

Each rule is evaluated against the passed in value in $arg, and stored in $res. $reason is cleared and each test applied to $res.

$res = eval( "rule$j(\"$arg\")" ); $reason = "";

If $res is the same as $arg, $reason is "equal". If the length of $res is less than 3, $reason is set to "too short". If $managed is 1, and $res is already in the %deadends hash, $reason is set to "deadend", and if $res is equal to "now" (the goal, as it happens) then $reason is set to "found".

if ($res eq $arg) { $reason = "equal"; } elsif ( length( $res ) < 3) { $reason = "too short"; } elsif ($deadends{$res}) { $reason = "deadend" unless $managed eq 0; } elsif ( $res eq "now" ) { $reason = "found"; }

If $reason is not empty and not "equal" then print a newline, as many spaces as there are levels of recursion, the rule that got us here, the incoming word and the result of the rule application. If $reason is "deadend" then print an exclamation mark to show that a deadend has been reached, otherwise print a full stop.

if ( $reason ne "" ) { if ( $reason ne "equal" ) { print "\n"; print " " x $level; print "(R$j) $arg => $res"; if ( $reason eq "deadend" ) { print "!"; } else { print "."; } }

If we've actually reached "now", indicate that with an asterisk. (We could exit the script at this point, but I left it to show all the possible paths to the stop word.)

if ( $res eq "now" ) { print "*"; }

If managing recursion, store the value of $res in the deadends hash.

$deadends{$res}=1 unless $managed eq 0;

Now, if $reason is, for some reason, empty, print a newline, as many spaces as there are recursion levels, the rule, and the $arg and the $res. Then increase the value of $level and recursively call apply with the contents of $res. When it returns, decrease the value of $level.

} else { print "\n"; print " " x $level; print "(R$j) $arg => $res,"; $level++; apply( $res ); $level--; } } }

Here's the first call to apply, with a newline displayed once processing returns from the call.

apply( $root ); print "\n";

Keeping track of dead-ends proved useful. Without it, the 'first' to 'now' attempt generated at 406K file (redirecting the output). With it, I got a 5K file. Similarly, 'ant' to 'now' was 1.8K without, and 457 bytes with. When it came to starting with 'gnat', a managed conversion generated an 8K file. Without management the laptop slowed to a crawl. After about five minutes I got an "Out of memory!" on stderr, so I killed the perl processing resulting in a 902 Megabyte file.

This is the result of a managed attempt with 'ant' as the start word:

(R3) ant => ent, (R4) ent => nnt, (R5) nnt => nn. (R6) nnt => owt, (R2) owt => otw, (R3) otw => etw, (R4) etw => ntw, (R5) ntw => nt. (R5) etw => et. (R4) otw => ntw! (R5) otw => ot. (R3) owt => ewt, (R2) ewt => etw! (R4) ewt => nwt, (R2) nwt => ntw! (R5) nwt => nw. (R5) ewt => ew. (R4) owt => nwt! (R5) owt => ow. (R5) ent => en. (R4) ant => nnt! (R5) ant => an.

Sadly, no asterisks. Next, the log of a managed run starting with 'gnat'. Success came quite quickly: start with 'gnat' and apply rules 2, 3, 4, 2, 4, 5, 6 and 2. An even shorter path appears further down: 3, 4, 2, 5, 6, and 4. The shortest appears to be 4, 2, 5, 6, 4 -- nnat, annt, ann, aow, now.

(R2) gnat => agnt, (R3) agnt => egnt, (R4) egnt => ngnt, (R2) ngnt => gnnt, (R4) gnnt => nnnt, (R5) nnnt => nnn, (R5) nnn => nn. (R6) nnn => own, (R2) own => now.* (R3) own => ewn, (R2) ewn => enw, (R4) enw => nnw, (R5) nnw => nn. (R6) nnw => oow, (R3) oow => eew, (R4) eew => new, (R2) new => enw! (R5) new => ne. (R5) eew => ee. (R6) eew => oow! (R4) oow => now!* (R5) oow => oo. (R5) enw => en. (R4) ewn => nwn, (R2) nwn => nnw! (R5) nwn => nw. (R5) ewn => ew. (R4) own => nwn! (R5) own => ow. (R6) nnnt => ownt, (R2) ownt => notw, (R3) notw => netw, (R2) netw => entw, (R4) entw => nntw, (R5) nntw => nnt, (R5) nnt => nn. (R6) nnt => owt, (R2) owt => otw, (R3) otw => etw, (R4) etw => ntw, (R5) ntw => nt. (R5) etw => et. (R4) otw => ntw! (R5) otw => ot. (R3) owt => ewt, (R2) ewt => etw! (R4) ewt => nwt, (R2) nwt => ntw! (R5) nwt => nw. (R5) ewt => ew. (R4) owt => nwt! (R5) owt => ow. (R6) nntw => owtw, (R2) owtw => otww, (R3) otww => etww, (R4) etww => ntww, (R5) ntww => ntw! (R6) ntww => ntow, (R2) ntow => notw! (R3) ntow => ntew, (R2) ntew => entw! (R5) ntew => nte, (R2) nte => ent, (R4) ent => nnt! (R5) ent => en. (R5) nte => nt. (R5) ntow => nto, (R2) nto => not, (R3) not => net, (R2) net => ent! (R5) net => ne. (R5) not => no. (R3) nto => nte! (R5) nto => nt. (R5) etww => etw! (R6) etww => etow, (R2) etow => eotw, (R3) eotw => eetw, (R4) eetw => netw! (R5) eetw => eet, (R4) eet => net! (R5) eet => ee. (R6) eet => owt! (R6) eetw => owtw! (R4) eotw => notw! (R5) eotw => eot, (R3) eot => eet! (R4) eot => not! (R5) eot => eo. (R3) etow => etew, (R2) etew => eetw! (R4) etew => ntew! (R5) etew => ete, (R2) ete => eet! (R4) ete => nte! (R5) ete => et. (R4) etow => ntow! (R5) etow => eto, (R2) eto => eot! (R3) eto => ete! (R4) eto => nto! (R5) eto => et. (R4) otww => ntww! (R5) otww => otw! (R6) otww => otow, (R2) otow => ootw, (R3) ootw => eetw! (R4) ootw => notw! (R5) ootw => oot, (R3) oot => eet! (R4) oot => not! (R5) oot => oo. (R6) oot => owt! (R6) ootw => owtw! (R3) otow => etew! (R4) otow => ntow! (R5) otow => oto, (R2) oto => oot! (R3) oto => ete! (R4) oto => nto! (R5) oto => ot. (R3) owtw => ewtw, (R2) ewtw => etww! (R4) ewtw => nwtw, (R2) nwtw => ntww! (R5) nwtw => nwt! (R5) ewtw => ewt! (R4) owtw => nwtw! (R5) owtw => owt! (R5) entw => ent! (R5) netw => net! (R5) notw => not! (R3) ownt => ewnt, (R2) ewnt => entw! (R4) ewnt => nwnt, (R2) nwnt => nntw! (R5) nwnt => nwn! (R5) ewnt => ewn! (R4) ownt => nwnt! (R5) ownt => own! (R5) gnnt => gnn, (R4) gnn => nnn! (R5) gnn => gn. (R6) gnn => gow, (R3) gow => gew, (R2) gew => egw, (R4) egw => ngw, (R2) ngw => gnw, (R4) gnw => nnw! (R5) gnw => gn. (R5) ngw => ng. (R5) egw => eg. (R4) gew => new! (R5) gew => ge. (R4) gow => now!* (R5) gow => go. (R6) gnnt => gowt, (R2) gowt => gotw, (R3) gotw => getw, (R2) getw => egtw, (R4) egtw => ngtw, (R2) ngtw => gntw, (R4) gntw => nntw! (R5) gntw => gnt, (R4) gnt => nnt! (R5) gnt => gn. (R5) ngtw => ngt, (R2) ngt => gnt! (R5) ngt => ng. (R5) egtw => egt, (R4) egt => ngt! (R5) egt => eg. (R4) getw => netw! (R5) getw => get, (R2) get => egt! (R4) get => net! (R5) get => ge. (R4) gotw => notw! (R5) gotw => got, (R3) got => get! (R4) got => not! (R5) got => go. (R3) gowt => gewt, (R2) gewt => egtw! (R4) gewt => newt, (R2) newt => entw! (R5) newt => new! (R5) gewt => gew! (R4) gowt => nowt, (R2) nowt => notw! (R3) nowt => newt! (R5) nowt => now!* (R5) gowt => gow! (R5) ngnt => ngn, (R2) ngn => gnn! (R5) ngn => ng. (R5) egnt => egn, (R4) egn => ngn! (R5) egn => eg. (R4) agnt => ngnt! (R5) agnt => agn, (R3) agn => egn! (R4) agn => ngn! (R5) agn => ag. (R3) gnat => gnet, (R2) gnet => egnt! (R4) gnet => nnet, (R2) nnet => ennt, (R4) ennt => nnnt! (R5) ennt => enn, (R4) enn => nnn! (R5) enn => en. (R6) enn => eow, (R3) eow => eew! (R4) eow => now!* (R5) eow => eo. (R6) ennt => eowt, (R2) eowt => eotw! (R3) eowt => eewt, (R2) eewt => eetw! (R4) eewt => newt! (R5) eewt => eew! (R6) eewt => oowt, (R2) oowt => ootw! (R3) oowt => eewt! (R4) oowt => nowt! (R5) oowt => oow! (R4) eowt => nowt! (R5) eowt => eow! (R5) nnet => nne, (R2) nne => enn! (R5) nne => nn. (R6) nne => owe, (R2) owe => eow! (R3) owe => ewe, (R2) ewe => eew! (R4) ewe => nwe, (R2) nwe => enw! (R5) nwe => nw. (R5) ewe => ew. (R4) owe => nwe! (R5) owe => ow. (R6) nnet => owet, (R2) owet => eotw! (R3) owet => ewet, (R2) ewet => eetw! (R4) ewet => nwet, (R2) nwet => entw! (R5) nwet => nwe! (R5) ewet => ewe! (R4) owet => nwet! (R5) owet => owe! (R5) gnet => gne, (R2) gne => egn! (R4) gne => nne! (R5) gne => gn. (R4) gnat => nnat, (R2) nnat => annt, (R3) annt => ennt! (R4) annt => nnnt! (R5) annt => ann, (R3) ann => enn! (R4) ann => nnn! (R5) ann => an. (R6) ann => aow, (R3) aow => eew! (R4) aow => now!* (R5) aow => ao. (R6) annt => aowt, (R2) aowt => aotw, (R3) aotw => eetw! (R4) aotw => notw! (R5) aotw => aot, (R3) aot => eet! (R4) aot => not! (R5) aot => ao. (R3) aowt => eewt! (R4) aowt => nowt! (R5) aowt => aow! (R3) nnat => nnet! (R5) nnat => nna, (R2) nna => ann! (R3) nna => nne! (R5) nna => nn. (R6) nna => owa, (R2) owa => aow! (R3) owa => ewe! (R4) owa => nwa, (R2) nwa => anw, (R3) anw => enw! (R4) anw => nnw! (R5) anw => an. (R3) nwa => nwe! (R5) nwa => nw. (R5) owa => ow. (R6) nnat => owat, (R2) owat => aotw! (R3) owat => ewet! (R4) owat => nwat, (R2) nwat => antw, (R3) antw => entw! (R4) antw => nntw! (R5) antw => ant, (R3) ant => ent! (R4) ant => nnt! (R5) ant => an. (R3) nwat => nwet! (R5) nwat => nwa! (R5) owat => owa! (R5) gnat => gna, (R2) gna => agn! (R3) gna => gne! (R4) gna => nna! (R5) gna => gn.

Writing this makes me wonder if I should have found some way to jump from a successful traversal back to 'gnat' rather than applying the rules to instances of 'now' in search of an extended path to 'now'. I leave that as an exercise to the reader, and if you work out how to do it, please let me know.

© Copyright Bruce M. Axtens, 2008