Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

xanburzum

Poker

Por , em ASP Clássico

Recommended Posts

xanburzum    169

xanburzum
Postado

Pra quem gosta de Poker

 

poker.asp

<%@ Language=VBScript %>
<!-- #include file="functions.asp" -->
<HTML>
<HEAD>
</HEAD>
<BODY>
<CENTER>
<H3>ASPoker</H3>

<%

randomize

dim Hand, score, bet
dim newcard, t, doubles
dim card1, card2, card3, card4, card5
dim keep1, keep2, keep3, keep4, keep5


Hand = Request.form("hand")
Score = Request.Form("score")
Bet = Request.Form("bet")

if hand = "" then hand = 0
Hand = Hand + 1

if score="" then score = 100
if bet = "" then bet = 10

if hand <> 1 then
	score = score - bet
end if


card1 = Request.Form("card1")
card2 = Request.Form("card2")
card3 = Request.Form("card3")
card4 = Request.Form("card4")
card5 = Request.Form("card5")


keep1 = Request.Form("keep1")
keep2 = Request.Form("keep2")
keep3 = Request.Form("keep3")
keep4 = Request.Form("keep4")
keep5 = Request.Form("keep5")


if hand < 21 then
	%>
	<br>
	<FORM METHOD=POST>
	<table width=50% style="border: solid thin black">
	<tr><td colspan=5>Current hand: <% = hand %> of 20</td></tr>
	<tr>
	<%

	redim newcard(4)
	doubles = True
	do until doubles = false

		for t=0 to 4
			newcard(t) = getcard
		next


		SortArray newcard
		doubles = false
		for t=0 to 3
			if newcard(t) = newcard(t+1) then doubles = true
		next
	loop


	for t=0 to 4
	%>
		<TD>
		<IMG SRC="./cards/<% = newcard(t) %>.gif">
		<input type=hidden name=card<% = t + 1 %> value="<% = newcard(t) %>">
		</TD>
	<%
	next
	%>
	</TR><TR>
	<%

	for t=1 to 5
	%>
		<TD ALIGN=CENTER>
		<INPUT TYPE=CHECKBOX NAME=keep<% = t %>>Hold
		</TD>
	<%
	next

	%>
	</TR><TR>
	<TD ALIGN=CENTER COLSPAN=5><INPUT TYPE=SUBMIT VALUE="OK"></TD>
	</TR></TABLE>
	<%
end if

dim result, numericresult
if hand <> 1 then

	newcard = Array(card1,card2,card3,card4,card5)

	doubles = true
	do until doubles = false
		if keep1 <> "on" then newcard(0) = getcard
		if keep2 <> "on" then newcard(1) = getcard
		if keep3 <> "on" then newcard(2) = getcard
		if keep4 <> "on" then newcard(3) = getcard
		if keep5 <> "on" then newcard(4) = getcard

		doubles = false
		for t=0 to 3
			if newcard(t) = newcard(t+1) then doubles = true
		next

	loop


	result = GetHandValue(newcard)
	numericresult = left(result,2)
	result = mid(result,3)


	result = replace(result,"11","jack")
	result = replace(result,"12","queen")
	result = replace(result,"13","king")
	result = replace(result,"14","ace")

	dim inc

	select case numericresult
	case "00", "01"
		inc = 0
	case "02" ' high pair
		inc = (bet * 2)
	case "03" ' two pair
		inc = (bet * 4)
	case "04" ' three of a kind
		inc = (bet * 6)
	case "05" ' straight
		inc = (bet * 8)
	case "06" ' flush
		inc = (bet * 10)
	case "07" ' full house
		inc = (bet * 12)
	case "08" ' four of a kind
		inc = (bet * 20)
	case "09" ' straight flush
		inc = (bet * 50)
	case "10" ' royal flush
		inc = (bet * 100)
	case "11" ' poker
		inc = (bet * 200)
	end select

%>
<BR>
<TABLE width=50% style="border: solid thin black">
<TR><TD COLSPAN=5>Previous hand: <B><% = result %></B></TD></TR>
<TR>
<%

	for t=0 to 4
%>
	<TD><IMG SRC=".\cards\<% = newcard(t) %>.gif"></TD>
<%
	next
%>
</TR>
<TR>
	<TD ALIGN=CENTER><% = IIf(Keep1="on","held","") %></TD>
	<TD ALIGN=CENTER><% = IIf(Keep2="on","held","") %></TD>
	<TD ALIGN=CENTER><% = IIf(Keep3="on","held","") %></TD>
	<TD ALIGN=CENTER><% = IIf(Keep4="on","held","") %></TD>
	<TD ALIGN=CENTER><% = IIf(Keep5="on","held","") %></TD>
</TR>
</TABLE>
<%	
end if


if inc = 0 then 

	inc = (-1 * bet)
	if hand = 1 then inc = "initial score"
else

	score = score + bet + inc
	inc = "+" & inc
end if

if hand > 20 then

	Response.Write "<BR>Final score: <B>" & score & " (" & inc & ")"
%>
	<FORM ACTION="highscore.asp" METHOD=POST>
	<INPUT TYPE=HIDDEN NAME=SCORE VALUE=<% = score %>>
	<INPUT TYPE=HIDDEN NAME=ACTION VALUE="SUBMITSCORE">
	<INPUT NAME="NAME" VALUE="Your name here">
	<INPUT TYPE=SUBMIT VALUE="Submit score" id=SUBMIT1 name=SUBMIT1>
	</FORM>
	<BR>
	<FORM METHOD=POST>
	<INPUT TYPE=HIDDEN NAME=HAND VALUE=0>
	<INPUT TYPE=SUBMIT VALUE="New game" id=SUBMIT2 name=SUBMIT2>
	</FORM>
<%
else
	' just dislay score
	Response.Write "<BR><table width=50% style=""border: solid thin black""><TR><TD>Pontuação atual: <B>" & score & " (" & inc & ")</TD></TR></TABLE>"
end if

%>
<INPUT TYPE=HIDDEN NAME=HAND VALUE=<% = hand %>>
<INPUT TYPE=HIDDEN NAME=SCORE VALUE=<% = score %>>
</FORM>
</CENTER>
</BODY>
</HTML>

functions.asp

<%



Function GetHandValue(Cards)

	

    Dim tmpHand, High, Suits, R, PairString
    Dim Pairs, TwoPairs, Tripple, Flush, Straight
    

    Pairs = 0
    TwoPair = False
    Tripple = False
    Straight = False
    Flush = False

	redim Suits(4)
	redim High(4)
    

	for r = 0 to 4
		suits(r) = Left(Cards(r), 1)
		high(r) = Mid(Cards(r), 2)
		if high(r) = 1 then high(r) = 14
	next
    
	SortArray High
	SortArray Suits

    tmpHand = "00Nothing"
    

	For R=0 To 3
		If High(R) = High(R+1) Then

			If Instr(pairstring,"#" & High(r) & "#") = 0 Then
				tmpHand = IIf((High(r) > 10), "02", "01") & "Pair of " & High(R) & "s " & IIf((High(r) > 10), "(high)", "(low)")
				pairs = pairs + 1
				pairstring = pairstring & "#" & High(r) & "#"
			end if
		End If
	next

	If Pairs > 1 Then

        tmpHand = "03" & Pairs & " pair"
        TwoPairs = True
    End If


	For R=0 To 2
		If High(R) = High(R+1) And High(R) = High(R+2) Then

			tmpHand = "043 of a kind: " & High(r) & "s"
			tripple = true
		End If
	next

    If TwoPairs And Tripple Then
        tmpHand = "06Full House: "

		If High(0) = High(2) Then
            tmpHand = tmpHand & High(0) & "s over " & High(4) & "s"
		Else
            tmpHand = tmpHand & High(4) & "s over " & High(0) & "s"
		End If
    End If


    If High(0) = High(3) Then tmpHand = "084 of a kind: " & High(0)
    If High(1) = High(4) Then tmpHand = "084 of a kind: " & High(1)

    ' check for flush
    If Suits(0) = Suits(4) Then
        Flush = True
        tmpHand = "07Flush: " & GetSuitName(Suits(0))
    End If

    ' check for straight
	Straight = True
	For R = 0 To 3

		If cint(High(r)) <> cint(High(r + 1) - 1) Then Straight = False 
	Next

    If Straight Then

	    tmpHand = "05Straight: " & High(4) & " High"
    End If

    If Straight And Flush Then

        If High(4) = 14 Then

            tmpHand = "10Royal Flush in " & GetSuitName(Suits(0))
        Else
		
            tmpHand = "09Straight Flush: " & High(4) & " High in " & GetSuitName(Suits(0))
        End If
    End If

    If High(0) = High(4) Then

        tmpHand = "11Poker: " & High(0) & "s"
    End If


    GetHandValue = tmpHand 

End Function

Function IIf(Condition,TruePart,FalsePart)

	If Condition Then
		IIf = Truepart
	else
		IIf = FalsePart
	End if
End Function


Function GetCard()

	Dim Card
	Card = int(4 * rnd) + 1
	Card = Card & (int(13 * rnd) + 1)
	GetCard = Card
End Function

Function GetSuitName(suit)

	select case suit
	case "1"
		GetSuitName = "hearts"
	case "2"
		GetSuitName = "diamonds"
	case "3"
		GetSuitName = "spades"
	case "4"
		GetSuitName = "clubs"
	end select
End Function

Function SortArray(arr)

	Dim Swapped, T, Tmp
	Swapped = True
	Do until Swapped = False
		Swapped = False
		For t=0 to Ubound(arr) - 1
			If cint(arr(t)) > cint(arr(t+1)) then
				Tmp = arr(t)
				arr(t) = arr(t+1)
				arr(t+1) = tmp
				Swapped = True
			end if
		next
	Loop

End Function
%>

highscore.asp

<%@ language=VBScript %>
<%


	dim cnn, rst, name, score

	' get values passed
	name = replace(Request.Form("name"),"'","''")
	score = Request.Form("score")
	
	Const adOpenKeySet = 1
	Const adLockOptimistic = 3

	' open connection
	set cnn = server.CreateObject("ADODB.Connection")
	cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
	cnn.Open Server.MapPath("highscore.mdb")


	dim MustComeFrom
	MustComeFrom = "http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("SCRIPT_NAME")
	MustComeFrom = left(mustcomefrom,instrrev(mustcomefrom,"/")) & "poker.asp"


	if Request.Form("action") = "SUBMITSCORE" Then
		
		if Request.ServerVariables("HTTP_REFERER") <> MustComeFrom Then
			Response.Write "You appear to be cheating...your score is not recorded, CHEAT!"
			Response.Write "<BR>" & MustComeFrom
			Response.Write "<BR>" & Request.ServerVariables("HTTP_REFERER")
		else
			cnn.Execute "INSERT INTO Scores ([Name],Score) VALUES('" & Name & "', " & score & ")"
		end if
	end if
	

	set rst = cnn.Execute("SELECT TOP 10 * FROM Scores ORDER BY SCORE DESC, [Date] Desc")

%>
<CENTER><H3>Highscores</H3>
<TABLE  style="border: solid thin black">
<TR style="border: solid thin black"><TD>Position</TD><TD WIDTH=200>Name</TD><TD WIDTH=50>Score</TD><TD>Date</TD></TR>
<%
	Dim t
	do until rst.EOF
		t = t + 1
%>
<TR style="border: solid thin black"><TD><% = t %></TD><TD><% = rst("Name") %></TD><TD><% = rst("Score") %></TD><TD><% = rst("Date") %></TD></TR>
<%		
		rst.movenext
	loop	
%>
</TABLE>
<A HREF="poker.asp">Play again</A>
</CENTER>

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito