ASP 101 - Active Server Pages 101 - Web05
The Place ASP Developers Go!

Please visit our partners

Windows Technology Windows Technology
15 Seconds
4GuysFromRolla.com
ASP 101
ASP Wire
VB Forums
VB Wire
WinDrivers.com
internet.commerce internet.commerce
Partners & Affiliates














ASP 101 is an
internet.com site
ASP 101 is an internet.com site
IT
Developer
Internet News
Small Business
Personal Technology
International

Search internet.com
Advertise
Corporate Info
Newsletters
Tech Jobs
E-mail Offers

ASP 101 News Flash ASP 101 News Flash




ASP Source Code:
<%' Begin functions declarations
'**********
' GetNewWord()
'     Generates a random number from 1 to 83 which it uses to
'     select a line from a textfile with 83 lines of words in it.
'     It then retrieves the word, converts in to uppercase, and
'     returns it as its return value.
'**********
Function GetNewWord()
Dim objFSO, objFile
Dim I
Dim iRandom
Dim strTemp
	' Get a random number between 1 and 83 inclusive
	Randomize()
	iRandom = Int(83 * Rnd + 1)
	'iRandom = 42 ' A word with a space = 3, with a - = 42 
	' Open file and get the line equal to the number generated
	Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.OpenTextFile(Server.MapPath("hangman.txt"))
	' Loop till line before the one we want
	For I = 1 to iRandom - 1
		objFile.SkipLine
	Next
	strTemp = UCase(objFile.ReadLine)
	objFile.Close
	Set objFile = Nothing
	Set objFSO = Nothing
	GetNewWord = strTemp
End Function ' GetNewWord()
'**********
' CalculateGuess(strWord)
'     Takes the secret word as input.  It checks to see if the
'     word contains any spaces or dashes to include them in the
'     guess since you can't guess space or dash.  Returns a
'     properly adjusted guess based upon the secret word.
'**********
Function CalculateGuess(strWord)
Dim strGuess
Dim I
	strGuess = ""
	If InStr(1, strWord, Chr(32), 1) Or InStr(1, strWord, Chr(45), 1) Then
		For I = 1 to Len(strWord)
			Select Case Asc(Mid(strWord, I, 1))
				Case 32
					strGuess = strGuess & " "
				Case 45
					strGuess = strGuess & "-"
				Case Else
					strGuess = strGuess & "_"
			End Select
		Next
	Else
		strGuess = String(Len(strWord), "_")
	End If
	CalculateGuess = strGuess
End Function ' CalculateGuess()
'**********
' CalculateGuess(strWord, strGuess, strLetter)
'     Takes the secret word, the current state of the guess, and
'     the guessed letter as input.  It updates the guess to
'     include all occurances of the guessed letter.  It returns
'     the guess containing the new letter.  Only needs to be
'     called when the letter is in the secret word.
'**********
Function UpdateGuess(strWord, strGuess, strLetter)
Dim strTemp
	strTemp = ""
	For I = 1 to Len(strWord)
		If Mid(strWord, I, 1) = strLetter Then
			strTemp = strTemp & strLetter
		Else
			strTemp = strTemp & Mid(strGuess, I, 1)
		End If
	Next	
	UpdateGuess = strTemp
End Function ' UpdateGuess()
' End functions declarations
%>
<%' Begin run-time code
Dim iDeath
Dim strWord, strGuess
Dim aLetters
Dim strLetter
Dim strTemp
Dim I
'Get all values from Session and QueryString for processing speed
iDeath = Session("Death")
strWord = Session("Word")
strGuess = Session("Guess")
aLetters = Session("LettersArray")
strLetter = Request.QueryString("letter")
' Get a new word and init variables if no guess or dead
' otherwise check letter submitted against array and secret word
If strLetter = "" or iDeath > 6 Then
	strWord = GetNewWord()
	strGuess = CalculateGuess(strWord)
	iDeath = 0
	aLetters = Array(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
Else
	' Set Letter in array to checked
	If 65 <= Asc(strLetter) AND Asc(strLetter) <= 90 Then
		aLetters(Asc(strLetter) - 65) = 1
	End If
	' If letter guessed is in the secret word then update guess
	' otherwise increase death amount by 1
	If InStr(1, strWord, strLetter, 1) Then
		strGuess = UpdateGuess(strWord, strGuess, strLetter)
	Else
		iDeath = iDeath + 1
	End If
End If
' Display Gallows Image based on death amount
Response.Write "<IMG SRC=""images/hang_" & iDeath + 1 & ".gif"" BORDER=0 WIDTH=100 HEIGHT=100><BR><BR>" & vbCrLf
' Debugging Outputs
'Response.Write "Word:" & strWord & vbCrLf & "<BR><BR>"
'Response.Write "Guess:" & strGuess & vbCrLf & "<BR><BR>"
'Output Guess using black letter images
For I = 1 to Len(strGuess)
	If LCase(Mid(strGuess, I, 1)) = " " Then
		Response.Write "<IMG SRC=""./images/lb_" & "~" & ".gif"" BORDER=0 WIDTH=20 HEIGHT=20> "
	Else
		Response.Write "<IMG SRC=""./images/lb_" & LCase(Mid(strGuess, I, 1)) & ".gif"" BORDER=0 WIDTH=20 HEIGHT=20> "
	End If		
Next
Response.Write "<BR><BR>" & vbCrLf
' Check to see if Dead. If so output sorry and display word.
' If not then check to see if the word is right. If so then
' output congrats.  In both of these cases, set to dead so
' nothing weird happens if the come back or try and continue
' guessing manually.
' If neither of the above then output the alphabet letters
' so the player can continue guessing, but only letters they
' haven't yet clicked should be clickable, others are red.
If iDeath >= 6 Then
	Response.Write "Sorry, you have been hung!  The word was: <B>" & LCase(strWord) & "</B><BR>"
	Response.Write "Play Again? <A HREF=""./hangman.asp"">Yes</A> <A HREF=""./index.asp"">No</A><BR>"
	iDeath = 7
Else
	If strGuess = strWord Then
		Response.Write "Congratulations you have correctly guessed the word: <B>" & LCase(strWord) & "</B><BR>"
		Response.Write "Play Again? <A HREF=""./hangman.asp"">Yes</A> <A HREF=""./index.asp"">No</A><BR>"
		iDeath = 7
	Else
		' Loop through alphabet Chr(65) = A and Chr(90)=Z
		For I = 65 to 77
			If aLetters(I - 65) = 0 Then
				Response.Write "<A HREF=""./hangman.asp?letter=" & Chr(I) & """><IMG SRC=""./images/lb_" & LCase(Chr(I)) & ".gif"" BORDER=0 WIDTH=20 HEIGHT=20></A>"
			Else
				Response.Write "<IMG SRC=""./images/lr_" & LCase(Chr(I)) & ".gif"" BORDER=0 WIDTH=20 HEIGHT=20>"
			End If
		Next
		Response.Write "<BR>" & vbCrLf
		For I = 78 to 90
			If aLetters(I - 65) = 0 Then
				Response.Write "<A HREF=""./hangman.asp?letter=" & Chr(I) & """><IMG SRC=""./images/lb_" & LCase(Chr(I)) & ".gif"" BORDER=0 WIDTH=20 HEIGHT=20></A>"
			Else
				Response.Write "<IMG SRC=""./images/lr_" & LCase(Chr(I)) & ".gif"" BORDER=0 WIDTH=20 HEIGHT=20>"
			End If
		Next
		Response.Write "<BR>" & vbCrLf
	End If
End If
' Put all values back into Session for storage
Session("Death") = iDeath
Session("Word") = strWord
Session("Guess") = strGuess
Session("LettersArray") = aLetters
%>

Back the the Sample Output

Back to the Sample Index


Home |  News |  Samples |  Articles |  Lessons |  Resources |  Forum |  Links |  Search |  Feedback



JupiterOnlineMedia

internet.comearthweb.comDevx.commediabistro.comGraphics.com

Search:

Jupitermedia Corporation has two divisions: Jupiterimages and JupiterOnlineMedia

Jupitermedia Corporate Info


Legal Notices, Licensing, Reprints, & Permissions, Privacy Policy.

Advertise | Newsletters | Tech Jobs | Shopping | E-mail Offers

Solutions
Whitepapers and eBooks
Intel Go Parallel Portal: Interview with C++ Guru Herb Sutter
IBM Article: How Cool Is Your Data Center?
Microsoft Article: Managing Virtual Machines with Microsoft System Center
Avaya Article: How to Begin Developing with Avaya's Event Processing Language
Avaya Article: Deep Dive--Event Processor Offers Familiar Tools for Creating Event-Driven SOA Apps
Intel Whitepaper: A Methodology for Threading Serial Applications (PDF)
HP eBook: Storage Networking , Part 1
ServerWatch.com Article: Tip of the Trade--IP Address Management
ITChannelPlanet.com Article: Enterprise Fixed-Mobile Convergence Can Be Lucrative
Intel Article: Transitioning Software to Future Generations of Multi-Core
Hoovers Article: Boost Employee Morale without Breaking the Bank
Microsoft Article: Solving Data Center Complexity with Microsoft System Center Configuration Manager 2007
Internet.com eBook: All About Botnets
Intel Article: 8 Simple Rules for Designing Threaded Applications
Intel Whitepaper: Best Practices for Developing and Optimizing Threaded Applications
Intel Article: The Challenges of Developing Multithreaded Processing Pipelines
MORE WHITEPAPERS, EBOOKS, AND ARTICLES
Webcasts
Intel Video: Foundations of Parallel Programming, Part One
HP Video: Page Cost Calculator
HP Webcast: Storage Is Changing Fast - Be Ready or Be Left Behind
Intel Video: Three Must-Knows for Parallelism
Microsoft Partner Program Video: The Secrets to Partner Success
Microsoft Silverlight Video: Creating Fading Controls with Expression Design and Expression Blend 2
MORE WEBCASTS, PODCASTS, AND VIDEOS
Downloads and eKits
Sybase Download: SQL Anywhere Developer Edition
Red Gate Download: SQL Backup Pro and free DBA Best Practices eBook
Red Gate Download: SQL Compare Pro 6
Iron Speed Designer Application Generator
MORE DOWNLOADS, EKITS, AND FREE TRIALS
Tutorials and Demos
eTouch PDF: Conquering the Tyranny of E-Mail and Word Processors
How-to-Article: How to Market Your Technology Solutions
IBM Article: Collaborating in the High-Performance Workplace
HP Demo: StorageWorks EVA4400
Microsoft How-to Article: Get Going with Silverlight and Windows Live
MORE TUTORIALS, DEMOS AND STEP-BY-STEP GUIDES