[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