<%' 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 205 inclusive
Randomize()
iRandom = Int(205 * Rnd + 1)
'iRandom = 5 ' 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 > 5 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,0,0,0)
Else
' Set Letter in array to checked
If 65 <= Asc(strLetter) AND Asc(strLetter) <= 90 Then
aLetters(Asc(strLetter) - 65) = 1
elseif Asc(strLetter) = 198 Then
aLetters(Asc(strLetter) - 172) = 1
elseif Asc(strLetter) = 216 Then
aLetters(Asc(strLetter) - 189) = 1
elseif Asc(strLetter) = 197 Then
aLetters(Asc(strLetter) - 169) = 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
%>
" & vbCrLf ' Debugging Outputs 'Response.Write "Word:" & strWord & vbCrLf & " " 'Response.Write "Guess:" & strGuess & vbCrLf & " " 'Output Guess using black letter images For I = 1 to Len(strGuess) If LCase(Mid(strGuess, I, 1)) = " " Then Response.Write " " & 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 >= 5 Then Response.Write "Den frivillige er druknet! Ordet var: " & LCase(strWord) & " " Response.Write "Vil du prøve igen?  " iDeath = 6 Else If strGuess = strWord Then Response.Write "Tillykke du gættede rigtigt: " & LCase(strWord) & " " Response.Write "Vil du prøve igen? " iDeath = 6 Else ' Loop through alphabet Chr(65) = A and Chr(90)=Z For I = 65 to 77 If aLetters(I - 65) = 0 Then Response.Write " " & vbCrLf For I = 78 to 90 If aLetters(I - 65) = 0 Then Response.Write " " & 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 %> |
|||
 |
