[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