Ir para conteúdo

POWERED BY:

Arquivado

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

xanburzum

Sistema de Avaliação de Site

Por , em ASP Clássico

Recommended Posts

xanburzum    169

xanburzum
Postado

Esta é uma aplicação simples para dar aos usuários a oportunidade de avaliar seu site e exibe os resultados na forma de gráficos de barras (sem gráficos incluídos). O código-fonte contém uma base de dados flexíveis configuráveis. banco de dados do aplicativo é composto por quatro tabelas:

 

1- Category, com os campos:

CategoryID - Numeração Automática

CategoryName - Texto

 

2- CategoryGradeDesc, com os campos:

GradeID - Número

CategoryID - Número

Default - Sim/Não

Description - Memorando

 

3- Grade, contendo os campos:

GradeID - Numeração Automática

GradeName - Texto

GradeValue - Número

 

e a última tabela,

 

4- Rating, com os campos

RatingID - Numeração Automática

CategoryID - Número

GradeID - Número

 

<%
Option Explicit



%>

<html>
	<head>
		<title>Site Rating</title>
		<style>h2{color:#3366cc;}</style>
	</head>
	<body scroll=auto>
	<h2>Site Rating</h2>
<%

Dim Conn
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE="& Server.MapPath("site_rating.mdb") &";"

If Request.Form.Count=0 Then
	If CBool(Request.Cookies(Request.ServerVariables("HTTP_HOST"))("HasRated")) Then
		If CBool(Request("Again")) Then
			ShowForm
		Else
			DisplayResults		
		End If
	Else
		ShowForm
	End if
Else
	UpdateSiteRating
	Response.Cookies(Request.ServerVariables("HTTP_HOST"))("HasRated") = True
	Response.Redirect(Request.ServerVariables("SCRIPT_NAME"))
End If

Conn.Close 
Set Conn = Nothing

%>
</body>
</head>
<%


Sub DisplayResults
	DrawChart
	
	'menu
	Response.Write("<blockquote>")
	Response.Write("<a href=""" & Request.ServerVariables("SCRIPT_NAME") & "?again=true"">Avaliar este site novamente</a>")
	Response.Write("    ")
	Response.Write("</blockquote>")
End Sub

Sub ShowForm
	Dim intLastCatgegoryId, intCatgegoryId, intGradeId
	Dim RS,SQL
	SQL = "SELECT Category.CategoryID, Category.CategoryName, Grade.GradeID, Grade.GradeName, CategoryGradeDesc.Description, CategoryGradeDesc.Default"
		SQL = SQL & " FROM Grade INNER JOIN (Category INNER JOIN CategoryGradeDesc ON Category.CategoryID = CategoryGradeDesc.CategoryID) ON Grade.GradeID = CategoryGradeDesc.GradeID"
		SQL = SQL & " ORDER BY Category.CategoryID, Grade.GradeID;"
	Set RS = Conn.Execute(SQL)
	
	If Not RS.EOF Then
		Response.Write("<form method=post action=""" & Request.ServerVariables("SCRIPT_NAME") & """>")
		Response.Write("<table border=0>")
		Do While Not RS.EOF			
			intGradeId = RS("GradeID")	
			intCatgegoryId = RS("CategoryID")			
			If intLastCatgegoryId <> intCatgegoryId Then
				If intLastCatgegoryId <> "" Then
					Response.Write("</table></td></tr>")
				End If
				Response.Write("<tr><td><b>" & RS("CategoryName") & ":</b></td></tr><tr><td align=right><table border=0 width=""97%"" bgcolor=#cccccc cellpadding=2 cellspacing=1>")
			End If
			
			Response.Write("<tr><td nowrap bgcolor=white><input ")
			If CBool(RS("Default")) Then
				Response.Write(" checked ")
			End If
			Response.Write(" type=radio name=""cat" & intCatgegoryId &""" value=""" & intGradeId &""" id=""cat" & intCatgegoryId & "_" & intGradeId &""">")
			Response.Write("<label for=""cat" & intCatgegoryId & "_" & intGradeId &""">" & RS("GradeName") & "</label></td><td width=""99%"" bgcolor=white>")
			Response.Write(RS("Description"))
			Response.Write("</td></tr>")
			
			intLastCatgegoryId = intCatgegoryId
			RS.MoveNext
		Loop
		Response.Write("</table></td></tr>")
		Response.Write("<tr><td align=right height=50><input type=submit value=""Submit »"">    </td></tr>")
		Response.Write("</table></form>")
		RS.Close
	End If
	Set RS = Nothing
End Sub

Sub UpdateSiteRating
	Dim fld
	Dim intCatgegoryId, intGradeId
	Const SQL = "INSERT INTO Rating(CategoryID, GradeID) VALUES(@CategoryID, @GradeID)"
	For Each fld In Request.Form 
		If Left(fld,3)="cat" Then
			intCatgegoryId = Mid(fld,4)
			intGradeId = Mid(Request.Form(fld),InStrRev(Request.Form(fld),"_")+1)
			Conn.Execute(Replace(Replace(SQL,"@CategoryID",intCatgegoryId),"@GradeID",intGradeId))
		End If
	Next
End Sub

Sub DrawChart
	Dim RS,SQL
	SQL = " SELECT Rating.CategoryID, Category.CategoryName, Sum(Grade.GradeValue) AS [Sum], Count(Rating.CategoryID) AS [Count], Max(Grade.GradeValue) AS [Max]"
		SQL = SQL & " FROM Grade INNER JOIN (Category INNER JOIN Rating ON Category.CategoryID = Rating.CategoryID) ON Grade.GradeID = Rating.GradeID"
		SQL = SQL & " GROUP BY Rating.CategoryID, Category.CategoryName"
		SQL = SQL & " ORDER BY Rating.CategoryID;"

	Set RS = Conn.Execute(SQL)
	
	If RS.EOF Then
		Response.Write("Sem avaliação disponível.")
	Else		
		Response.Write("<table border=0 width=300>")
		Do While Not RS.EOF	
			Call DrawCategory(RS("CategoryName"),RS("Sum"),RS("Count") * RS("Max"))	
			RS.MoveNext
		Loop
		Response.Write("<tr><td> </td><td align=right>")
		
			Response.Write("<table width=""100%"" cellpadding=0 cellspacing=0><tr>")
			Response.Write("<td align=left><font size=1 face=arial>0</td>")
			Response.Write("<td align=right><font size=1 face=arial>100%</td>")
			Response.Write("</table>")
			
		Response.Write("</td></tr>")
		
		Response.Write("</table>")
		
		RS.Close
	End If
	Set RS = Nothing
End Sub

Sub DrawCategory(strName,intValue,intMax)
	Response.Write("<tr><td nowrap>" & strName & " (<font size=1 face=arial>" & CInt((intValue/intMax)*100) & "%)</td><td bgcolor=black width=""99%"">")
	DrawBar(CInt((intValue/intMax)*100))
	Response.Write("</td></tr>")
End Sub

Sub DrawBar(intPercentage)
	Response.Write("<table width=""100%"" cellpadding=0 cellspacing=0><tr>")
	Response.Write("<td bgcolor=purple title=""" & intPercentage & "%"" width=""" & intPercentage & "%""> </td>")
	Response.Write("<td bgcolor=yellow width=""" & (100-intPercentage) & "%""> </td>")
	Response.Write("</table>")
End Sub


%>

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

Não é dai a fonte, tenho apenas o code salvo, no pc, mas valeu, por complementar.

Compartilhar este post

Link para o post
Compartilhar em outros sites

desisto    0

desisto
Postado

esse eu ja tinha visto e lembrei quando você postou

 

eu sei que você tem tudo ai no pc, tb tenho alguns gb de cod :)

 

 

 

 

so que é bom aproveitar quando tem exemplo online que fica mas didatico

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

isso, memso desisto....

tenho gigas e gigas de code, cada dia me surpreendo mais, parece que não termina, hehehe

Compartilhar este post

Link para o post
Compartilhar em outros sites

desisto    0

desisto
Postado

e quando vai passar de um hd pro outro

 

'restando 15 minutos'... desanima

 

sql de 100 mb, zips e zips

 

hehehe

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