real language

Bookmarking Digg Diigo DZone Earthlink Google
Windows Live LookLater Ma.gnolia Reddit Rojo StumbleUpon Technorati

Language VBScript

(WSH using recursion and Microsoft Agent)

Author:Bob Stammers
Score: (2.90 in 10 votes)
<?xml version="1.0" ?>
99 bottles of beer - VBScript / WSH - recursion / translateable / Agent

This script generates the full lyrics of "99 bottles of beer" using recursion
with spelt-out numbers, easily translated owing to the use of WSH resources.

Activates Microsoft Agent to sing for and amuse us (if available)

Languages: EN - native; FR and DE courtesy of BabelFish

Bob Stammers - - March 2006

<named name="NUMERIC" 
	helpstring="Show numeric literals (99-2) rather than words" 
	type="simple" required="false" />
<named name="FROM" 
	helpstring="Set the initial number of bottles (0-99)" 
	type="string" required="false" />
<named name="AGENT"
	helpstring="Activate the named (Merlin) Microsoft Agent, if installed"
	type="string" required="false" />
<named name="LANG"
	helpstring="Choose which language strings to use [en]"
	type="string" required="false" />
<named name="NOAGENT"
	helpstring="Suppress the agent, just show the lyrics"
	type="simple" required="false" />
<named name="NOSOUND"
	helpstring="Suppress any agent sounds"
	type="simple" required="false" />

<resource id="en:First20">
<resource id="en:Decades">
<resource id="en:Line1">%1 of beer on the wall, %2 of beer.</resource>
<resource id="en:Line2Last">Go to the store and buy some more, </resource>
<resource id="en:Line2Many">Take one down and pass it around, </resource>
<resource id="en:Line2End">%1 of beer on the wall.</resource>
<resource id="en:NoMore">No more bottles</resource>
<resource id="en:OneMore">One bottle</resource>
<resource id="en:ManyMore">%1 bottles</resource>

<resource id="fr:First20">
<resource id="fr:Decades">
<resource id="fr:Line1">%1 de biere sur le mur, %2 de biere.</resource>
<resource id="fr:Line2Last">Allez au magasin et achetez encore plus, </resource>
<resource id="fr:Line2Many">Prenez un vers le bas et passez-l'autour, </resource>
<resource id="fr:Line2End">%1 de biere sur le mur.</resource>
<resource id="fr:NoMore">Plus de bouteilles</resource>
<resource id="fr:OneMore">Une bouteille</resource>
<resource id="fr:ManyMore">%1 bouteilles</resource>

<resource id="de:First20">
<resource id="de:Decades">
<resource id="de:Line1">%1 von Bier auf der Wand, %2 von Bier.</resource>
<resource id="de:Line2Last">Gehen Sie zum Speicher und kaufen Sie mehr, </resource>
<resource id="de:Line2Many">Nehmen Sie ein herunter und fuhren Sie es herum, </resource>
<resource id="de:Line2End">%1 von Bier auf der Wand.</resource>
<resource id="de:NoMore">Keine mehr Flaschen</resource>
<resource id="de:OneMore">Eine Flasche</resource>
<resource id="de:ManyMore">%1 Flaschen</resource>

<resource id="DefaultLang">en</resource>
<resource id="SilentRunning">0</resource>

<resource id="DefaultAgent">merlin</resource>
<resource id="InterverseAction">GestureUp</resource>
<resource id="WordsPerMinute">250</resource>
<resource id="JumpAboutInterval">4</resource>

<script language="VBScript">


Const ShowTiming = False

Dim First20, Decades, InitialBottles, ShowNumerics
Dim objAgent, objMerlin, strAgentName, useAgent
Dim strLang
Dim SongLyrics, DontEcho
Dim SilentRunning, startTime

	On Error Resume Next
	startTime = Now()
	If useAgent Then
		objMerlin.Play "Wave"
		Do While objMerlin.Visible = TRUE
			Wscript.Sleep 250
		If ShowTiming Then WScript.Echo "That took " & FormatDateTime((Now() - startTime),3)
	ElseIf DontEcho Then
	End If

Sub SingVerse(numBottles)

Dim numNext, strNext

	If useAgent Then
		If (numBottles > 0) and (numBottles Mod GetResource("JumpAboutInterval") = 0) Then
		End If
	End If
	If numBottles = 0 Then
		strNext = strCleanResource("Line2Last")
		numNext = InitialBottles
		If useAgent Then
			objMerlin.Play "Search"
		End If
		strNext = strCleanResource("Line2Many")
		numNext = numBottles - 1
	End If

	Sing strSubst(strCleanResource("Line1"),strBottles(numBottles),strBottles(numBottles))
	Sing strNext & strSubst(strCleanResource("Line2End"),strBottles(numNext),"")
	Sing ""
	if numBottles > 0 Then
	End If
End Sub

Sub Sing(strLyrics)

	If useAgent Then
		Do While Not objMerlin.Visible
			Wscript.Sleep 250
		If strLyrics = "" Then
			objMerlin.Play GetResource("InterverseAction")
			Exit Sub
		End If
		If SilentRunning Then
			Call objMerlin.Think (strLyrics)
			Call objMerlin.Speak ("\Spd=" & GetResource("WordsPerMinute") & "\" & strLyrics)
		End If
	Elseif DontEcho Then
		SongLyrics = SongLyrics & strLyrics & vbCrLf
		WScript.Echo strLyrics
	End If
End Sub

Sub ShowUsage()

End Sub

Sub DoJumpAround
' This causes the agent to jump around and generally waste time.
Dim intLeft, intTop, intHeight, intWidth

	GetScreenSize intHeight, intWidth
	With objMerlin
		intHeight = intHeight - .Height
		intWidth = intWidth - .Width

		Call .MoveTo(CInt(Rnd * intWidth),CInt(Rnd * intHeight))

	End With

End Sub

Sub GetScreenSize(intHeight,intWidth)

Dim strComputer, objWMIService, colItems, objItem

	strComputer = "."
	Set objWMIService = GetObject("winmgmts:" _
		& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

	Set colItems = objWMIService.ExecQuery ("Select * from Win32_DisplayConfiguration")

	For Each objItem in colItems ' Only one item in collection!
		intHeight = objItem.PelsHeight
		intWidth = objItem.PelsWidth

End Sub

Sub WriteShowLyrics

' This writes the lyrics, built up into SongLyrics, to a temporary file
' Fires up Notepad to show them, then kills the file before terminating


Dim WshShell, F, fs, txtfile

	Set fs = CreateObject("Scripting.FileSystemObject")
	txtfile = fs.BuildPath(fs.GetSpecialFolder(TEMP_FOLDER),fs.GetTempName())
	Set F = fs.CreateTextFile(txtfile, True)
	F.WriteLine SongLyrics
	Set WshShell = WScript.CreateObject( "WScript.Shell" )
	WshShell.Run "notepad " & txtfile,1,True
	Set WshShell = Nothing
	fs.DeleteFile txtfile
	Set fs = Nothing

End Sub

Function isConsole

Dim x

	On Error Resume Next
	WScript.StdOut.WriteBlankLines 1
	isConsole = (err.number = 0)
End Function
Sub EstablishParams

Dim arg, txt, WshShell

	' Load the various string resources
	strAgentName = GetResource("DefaultAgent")
	strLang = GetResource("DefaultLang")
	' Suppress the noise during testing
	SilentRunning = (GetResource("SilentRunning") = "1")
	InitialBottles = 99
	ShowNumerics = False
	useAgent = True
	SongLyrics = ""
	DontEcho = Not isConsole()

	For Each arg in WScript.Arguments.Named
		Select Case UCase(arg)
			Case "NUMERIC"
				ShowNumerics = True
			Case "FROM"
				InitialBottles = CInt(WScript.Arguments.Named("FROM"))
				If (Err.Number <> 0) Or (InitialBottles < 0) Or (InitialBottles > 99) Then
					' Use of recursion makes it unsafe to start much higher than 99
				End If
			Case "LANG"
				strLang = WScript.Arguments.Named("LANG")
			Case "NOAGENT"
				useAgent = False
			Case "AGENT"
				txt = WScript.Arguments.Named("AGENT")
				If txt <> "" Then
					strAgentName = txt
					strAgentName = GetResource("DefaultAgent")
				End If
				useAgent = True
			Case "NOSOUND"
				SilentRunning = True
			Case Else
		End Select

	First20 = arrExtractResource("First20")
	Decades = arrExtractResource("Decades")
	If useAgent Then 
		StartupAgent strAgentName
	End If

End Sub

Function strCleanResource(strResID)
' This returns the language string held in strResID but with all CRs and LFs removed 
' (enables pretty formatting in the source)
' This attempts to get the string for the specified language but if not found then 'en'
		strCleanResource = Replace(Replace(GetResource(strLang & ":" & strResID),vbCr,""),vbLf,"")
		If Err.Number = 0 Then Exit Do
		If strLang = "en" Then Exit Do
		strLang = "en"
End Function

Function arrExtractResource(strResID)
' This returns the clean contents of strResID as an array of elements separated by ","
		arrExtractResource = Split(strCleanResource(strResID),",")
End Function
Function strNumber(intNumber)

Dim intTens, intUnits

	If ShowNumerics Then
		strNumber = CStr(intNumber)
		Exit Function
	End If
	intTens = intNumber \ 10
	intUnits = intNumber - (intTens * 10)
	if intTens < 2 Then
	  strNumber = First20(intNumber-1)
	elseif intUnits > 0 Then
		strNumber = Decades(intTens-1) & " " & First20(intUnits-1)
		strNumber = Decades(intTens-1)
	end if
End Function

Function strSubst(strMask,strArg1,strArg2)

	strSubst = Replace(Replace(strMask,"%1",strArg1),"%2",strArg2)
End Function
Function strBottles(intNumber)

	If intNumber = 0 Then
		strBottles = strCleanResource("NoMore")
	Elseif intNumber = 1 Then
		strBottles = strCleanResource("OneMore")
		strBottles = strSubst(strCleanResource("ManyMore"),strNumber(intNumber),"")
	End If
End Function
Sub StartupAgent(strAgentName)

Dim WshShell, strAgentPath, objRequest

	Set objAgent = CreateObject("Agent.Control.2")
	If Not IsObject(objAgent) Then
		useAgent = False
		Exit Sub
	End If
	Set WshShell = WScript.CreateObject( "WScript.Shell" )
	strAgentPath = WshShell.ExpandEnvironmentStrings("%WinDir%") & "\Msagent\Chars\" & strAgentName &
	Set WshShell = Nothing

	objAgent.Connected = TRUE
	objAgent.RaiseRequestErrors = False
	Set objRequest = objAgent.Characters.Load (strAgentName, strAgentPath)
	If (Err.Number <> 0) Or (objRequest.Status <> 0) Then
		WScript.Echo "Agent " & strAgentname & " is not available" & vbCrLf
		useAgent = False
		Exit Sub
	End If
	Set objMerlin = objAgent.Characters.Character(strAgentName)
	If IsObject(objMerlin) Then
		If SilentRunning Then
			objMerlin.SoundEffectsOn = False
		End If
		Call objMerlin.Play ("Announce")
		useAgent = False
	End If
End Sub


Download Source | Write Comment

Alternative Versions

correct lyrics versionexec07/19/058
Demonstrates use of "class"Bruce M. Axtens09/29/050
WSF, Microsoft Agent, EN/FR/DEBob Stammers06/02/061
long versionJonathan Harrison05/17/053
short versionPhilipp Winterberg04/20/050


>>  Jim de Graff said on 04/13/09 19:14:08

Jim de Graff This is clearly an outstanding example of "every trick in the book" programming. It shows off the expertise of the programmer. It displays his technical knowledge and his awareness of the need (in theory) to provide resources for other (human) languages. Very impressive.

However, as someone who has written and evaluated production code for over thirty years I have to give this code a failing grade. It is clearly too complex for the stated specification. It is virtually unmaintainable except possibly by the author. If the spec were to change, even slightly, it would be far easier to rewrite the code from scratch than to modify and test it.

Again, I applaud the author's expertise, but if I were to see this code in a job interview I would send the author packing. Hopefully, in an interview situation the author would scale back just a tad.

Download Source | Write Comment

Add Comment

Please provide a value for the fields Name, Comment and Security Code.
This is a gravatar-friendly website.
E-mail addresses will never be shown.
Enter your e-mail address to use your gravatar.

Please don't post large portions of code here! Use the form to submit new examples or updates instead!




Security Code: