|
|
|
|
|
|
|
|
Dicas
|
|
|
ASP - Active Server Page (Miscelâneas)
|
|
 |
Título da Dica: Integração de Sistema de Gestão de Banners
|
 |
|
|
|
Postada em 23/10/2003 por ^HEAVY-METAL^
Este novo artigo assume a compreensão previa do meu anterior sobre Banners (Criar um sistema de Rotacao de Banners de forma simples e sem ter de adquirir controlos). Neste artigo exemplifico como criar um sistema de gestao de banners com suporte em Base de dados, que inclui administracao bem como contagem de hits. Na realidade, com este artigo, acabei por criar uma aplicacao inteira que podera integrar no seu website para gerir os seus banners.
Para tal criei uma base de dados Access 2000 com uma tabela apenas, de nome "Banners":
Tabela : Banners
ID AutoNumber
Imagem Text
Link Text
Nome Text
Frequencia Number
Cliques Number
Primeiro criei um ficheiro com as funcoes necessarias para os restantes. Neste, defini o caminho para a Base de Dados, uma funcao para escolher um banner atraves do Ad Rotator, uma outra para calcular a percentagem de mostragem de cada banner (usando a Frequencia) e uma ultima usada sempre que gravo strings na Base de Dados (para garantir a inexistencia de plicas a mais que poderao arruinar a operacao na base de dados).
ficheiro : funcoes.ASP
<%
Option Explicit
Dim DSN
' ##### Ligacao a Base de Dados. Usada em todas as queries desta aplicacao
DSN = "driver={Microsoft Access Driver (*.mdb)};DBQ=" & Server.Mappath("banners.mdb") & ";"
' ##### Funcao que vai ao Ad Rotator obter o banner
Function EscolherBanner()
Dim PubBanner
' Criacao de uma instancia do Banner Ad Rotator
Set PubBanner = Server.CreateObject("MSWC.AdRotator")
' Definir a instancia do Banner Ad Rotator para o link abrir sempre numa nova janela
PubBanner.TargetFrame = "TARGET=new"
' Definir o caminho para o ficheiro com a informacao dos Banners
EscolherBanner = PubBanner.GetAdvertisement("./bannersInfo.txt")
Set PubBanner = Nothing
End Function
' ##### Funcao que remove os apostrofes duma string SQL
' ##### Exemplo: novastring = SQLQuotes("Vitor's SQL string")
Function SQLQuotes(sData)
If IsNull(sData) or sData = "" or len(sData)=0 Then
SQLQuotes = "NULL"
Else
SQLQuotes = "'" & Replace(sData,"'","''") & "'"
End If
End Function
' ##### Funcao que calcula a percentagem de mostragem de um banner
Function CalcPercent(ValorBase, Total)
If ValorBase <> 0 and Total <> 0 Then
CalcPercent = CInt(( ValorBase / Total ) * 100)
Else
CalcPercent = 0
End If
End Function
%>
Depois criei um ficheiro para mostrar os banners, ficheiro este basicamente em HTML, cujo unico codigo ASP e a chamada a funcao EscolherBanner().
ficheiro : default.ASP
<!-- #include file = "funcoes.asp" -->
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>Banner Ad Rotator</title>
</head>
<body leftmargin="0" marginwidth="0" topmargin="0"
marginheight="0" bgcolor="white">
<table border="0" cellpadding="4" cellspacing="0" width="100%">
<tr>
<td>
<hr>
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td align="left"><font face="Arial">
Banner Ad Rotator (pressione 'REFRESH' para actualizar)
</font></td>
<td align="right">[<font color="#0000ee">
<a href="admin.asp" target="_top">Administracao</a>
</font> ] </font>[<font color="#0000ee">
<a href="Javascript:window.close()">Fechar</a>
</font> ]</td>
</tr>
</table>
<hr>
</td>
</tr>
<tr>
<td>
<table width="100%" cellpadding="3" cellspacing="3">
<tr height="70">
<td align="left" valign="middle" height="70" width="470">
<%=EscolherBanner()%></td>
</tr>
</table>
</td>
</tr>
</table>
</body>
</html>
Seguidamente criei o ficheiro que o Ad Rotator usa para redireccionar o utilizador para o link do banner, mas desta vez inclui o procedimento de incremento da contagem de hits (cliques).
ficheiro : bnredir.ASP
<!-- #include file = "funcoes.asp" -->
<%
' ##### Definir o Response Buffer
Response.Buffer = True
Dim URLBanner, bannerImagem
Dim rsBanners, sSQL, sConn, rsActualizaContador
Dim TotalCliques, ContadorRegistos
' ##### Obter o URL e a imagem do banner na Querystring
URLBanner = Request.QueryString("URL")
bannerImagem = Mid(Request.QueryString("image"),9)
' ##### Acrescentar mais um hit ao contador desse banner (na BD)
Set rsBanners = Server.CreateObject("ADODB.Recordset")
sSQL = "SELECT * FROM Banners WHERE Imagem = " & SQLQuotes(bannerImagem)
With rsBanners
.Open sSQL,DSN
ContadorRegistos = 0
Do Until .EOF
ContadorRegistos = ContadorRegistos + 1
.MoveNext
Loop
If ContadorRegistos = 1 Then
.MoveFirst
Set rsActualizaContador = Server.CreateObject("ADODB.Recordset")
sSQL = "UPDATE Banners SET Cliques = Cliques + 1 WHERE ID = " & .Fields("ID")
rsActualizaContador.Open sSQL,DSN
End If
.Close
End With
Set rsBanners = Nothing
' ##### Limpa o Response e redirecciona o utilizador para o URL
Response.Clear()
Response.Redirect(URLBanner)
%>
Por ultimo, construi uma ASP para administracao dos banners. Como o registo dos banners esta sempre em Base de Dados, e o Ad Rotator so pode ir buscar informacao ao ficheiro de texto (com a sua estrutura correctamente definida), criei aqui uma rotina para que esse mesmo ficheiro da estrutura de banners seja recriado sempre. Tambem sao utilizadas aqui rotinas para upload de imagens por HTTP (sem recurso a controlos no server, disponibilizadas gratuitamente pela PSTRUH Software, cujas encontram-se no ficheiro upload.inc).
ficheiro : admin.ASP
<!-- #include file = "funcoes.asp" -->
<!-- #include file = "upload.inc" -->
<%
' ###### Definicao de todas as variaveis
Dim nID, sOP, sSubmit
Dim rsBanners, rsActBanner, rsApagaBanner, rsAdicionaBanner
Dim sErro, sSQL, Fields, CaminhoFicheiro
Dim sLink, sNome, sImagem, nFrequencia, nFrequenciaTotal
' ###### nID - Identificador do ID do Banner
' ###### sOP - Guarda qual a operacao a fazer
nID = Request.QueryString("ID")
sOP = Request.QueryString("Op")
' ###### ActualizaFicheiroBanner - vai recriar o ficheiro com a configuracao dos banners
ActualizaFicheiroBanner()
' ###### Se o ID que vem da QueryString contiver algo
If Request.QueryString("ID") <> "" Then
' ###### Quer dizer que ou vai fazer Edicao ou Eliminacao do registo de um banner
' ###### Mas ve se esta a fazer POST da informacao ou se tem de mostrar o form
' ###### e actua de acordo
Select Case sOp
Case "editar"
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
GravarBanner()
Else
MostraForm()
End If
Case "apagar"
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
ConfirmaApagar()
Else
MostraApagar()
End If
End Select
Else
' ###### Se o ID nao contiver nada entao ou vai criar um novo registo de banner
' ###### ou vai mostrar a pagina principal de Administracao
Select Case sOp
Case "novo"
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
GravaNovo()
Else
MostraForm()
End If
Case Else
MostraAdmin()
End Select
End If
' ###### Rotina que vai mostrar a pagina principal de Administracao
' ###### Chama a rotina Cabecalho, escreve o html da pagina e chama
' ###### a rotina Rodape
Sub MostraAdmin()
Call Cabecalho
%>
<table cellpadding="3" cellspacing="3">
<tr>
<td height="20"><A HREF="admin.asp?Op=novo">Adicionar Novo Banner</a></td></td>
</tr>
</table>
<%
Set rsBanners = Server.CreateObject("ADODB.Recordset")
sSQL = "SELECT * FROM Banners"
With rsBanners
.Open sSQL,DSN
If Not .EOF Then
' ###### Vai achar o somatorio de todas as frequencias para poder usar no calculo
' ###### da percentagem de cada uma em relacao ao somatorio de todas
nFrequenciaTotal = 0
Do Until .EOF
nFrequenciaTotal = nFrequenciaTotal + .Fields("Frequencia")
.MoveNext
Loop
' ###### Volta ao primeiro registo
.MoveFirst
Do Until .EOF %>
<P>
<table cellpadding="3" cellspacing="3">
<tr>
<td height="80"><IMG title="<%=.Fields("Nome")%>" height=60 alt="<%=.Fields("Nome")%>"
src="imagens/<%=.Fields("Imagem")%>" width=468 border=0></td>
<td height="80"><A HREF="admin.asp?ID=<%=.Fields("ID")%>&Op=editar">Editar</a></td>
<td height="80"><A HREF="admin.asp?ID=<%=.Fields("ID")%>&Op=apagar">Apagar</a></td>
</tr>
</table>
<table cellpadding="3" cellspacing="3">
<tr><td>Ficheiro: </td><td colspan="2"><%=.Fields("Imagem")%></td></tr>
<tr><td>Nome: </td><td colspan="2"><%=.Fields("Nome")%></td></tr>
<tr><td>Link: </td><td colspan="2"><A HREF="<%=.Fields("Link")%>" target=_new><%=.Fields("Link")%></A></td></tr>
<tr><td>Freq.: </td><td colspan="2"><%=.Fields("Frequencia")%></td></tr>
<tr><td>Percentagem em que surge: </td><td colspan="2"><%=CalcPercent(.Fields("Frequencia"),nFrequenciaTotal)%>%</td></tr>
<tr><td>Cliques: </td><td colspan="2"><%=.Fields("Cliques")%></td></tr>
</table>
<% .MoveNext
Loop
End If
.Close
End With
Set rsBanners = Nothing
Call Rodape
End Sub ' MostraAdmin
' ###### Rotina que vai avaliar os dados do form de Edicao de um banner
' ###### Se estiverem ok, vai gravar em BD e voltar a pagina de administracao
' ###### Caso contrario, mostra o erro encontrado
Sub GravarBanner()
Set Fields = GetUpload()
sLink = Fields("link").Value.String
sImagem = Fields("imagem").FileName
sNome = Fields("nome").Value.String
nFrequencia = Fields("Frequencia").Value.String
sErro= ""
If len(sLink) < 8 or left(sLink,7) <> "http://" Then sErro = sErro & "Erro na 'Frequencia'<BR>"
If len(sNome) < 1 Then sErro = sErro & "Erro no 'Nome'<BR>"
If Not IsNumeric(nFrequencia) and nFrequencia >= 11 Then sErro = sErro & "Erro no 'Link'<BR>"
' ##### Se a String com erros tiver vazia, grava. Se nao, mostra o erro
' ##### e depois o form de novo
If Not len(sErro) > 0 Then
Set rsActBanner = Server.CreateObject("ADODB.Recordset")
sSQL = "UPDATE Banners SET "
sSQL = sSQL & " Nome = " & SQLQuotes(sNome) & ", "
sSQL = sSQL & " Link = " & SQLQUotes(slink) & ", "
sSQL = sSQL & " Frequencia = " & nFrequencia
' ##### Vai avaliar se esta a ser colocada nova imagem para este banner
' ##### Se estiver, tambem tem de colocar o nome no registo da B.D.
If sImagem <> "" Then
If Right(sImagem,4) = ".jpg" and Right(sImagem,4) = ".gif" Then
CaminhoFicheiro = Server.MapPath("imagens") & "\" & sImagem
Fields("imagem").Value.SaveAs CaminhoFicheiro
sSQL = sSQL & ", Imagem = " & SQLQuotes(sImagem)
End If
End If
sSQL = sSQL & " WHERE ID = " & nID
rsActBanner.Open sSQL,DSN
Response.Redirect "admin.asp"
Else
Call MostraForm()
End If
End Sub ' GravarBanner
' ###### Rotina que vai avaliar os dados do form dum novo banner
' ###### Se estiverem ok, vai gravar em BD e voltar a pagina de administracao
' ###### Caso contrario, mostra o erro encontrado
Sub GravaNovo()
' ##### Chama o GetUpload (presente no upload.inc) para obter os campos do form
Set Fields = GetUpload()
' ##### Preenche as variaveis, usadas adiante, com os valores correctos
sLink = Fields("link").Value.String
sImagem = Fields("imagem").FileName
sNome = Fields("nome").Value.String
nFrequencia = Fields("Frequencia").Value.String
sErro = ""
If len(sLink) < 8 or left(sLink,7) <> "http://" Then sErro = sErro & "Erro no 'Link'<BR>"
If len(sNome) < 1 Then sErro = sErro & "Erro no 'Nome'<BR>"
If Not IsNumeric(nFrequencia) Then sErro = sErro & "Erro na 'Frequencia'<BR>"
If Len(sImagem) < 4 Then sErro = sErro & "Erro no ficheiro da imagem<BR>"
If Right(sImagem,4) <> ".jpg" and Right(sImagem,4) <> ".gif" Then sErro = sErro & "Ficheiro de imagem nao reconhecido<BR>"
If Not len(sErro) > 0 Then
CaminhoFicheiro = Server.MapPath("imagens") & "\" & sImagem
Fields("imagem").Value.SaveAs CaminhoFicheiro
Set rsAdicionaBanner = Server.CreateObject("ADODB.Recordset")
sSQL = "INSERT INTO Banners (Nome, Link, Frequencia, Imagem, Cliques) VALUES ("
sSQL = sSQL & SQLQuotes(sNome) & ", "
sSQL = sSQL & SQLQuotes(slink) & ", "
sSQL = sSQL & nFrequencia & ", "
sSQL = sSQL & SQLQuotes(sImagem) & ",0)"
'response.Write sSQL
'response.end
rsAdicionaBanner.Open sSQL,DSN
Response.redirect "admin.asp"
Else
Call MostraForm()
End If
End Sub ' GravaNovo
' ###### Rotina que vai apagar o registo de um banner
Sub ConfirmaApagar()
If Request.Form("submit") = "Apagar" Then
Set rsApagaBanner = Server.CreateObject("ADODB.Recordset")
sSQL = "DELETE FROM Banners WHERE ID = " & nID
rsApagaBanner.Open sSQL,DSN
Response.redirect "admin.asp"
Else
Response.Redirect "admin.asp"
End If
End Sub ' ConfirmaApagar
' ###### Rotina que vai recriar o ficheiro com a informacao dos banners
' ###### necessario para o Banner Ad Rotator
Sub ActualizaFicheiroBanner()
Dim fso, FicheiroBanner
set fso = Server.CreateObject("scripting.FileSystemObject")
set FicheiroBanner = fso.CreateTextFile(Server.Mappath("bannersinfo.txt"), true)
FicheiroBanner.WriteLine("REDIRECT bnredir.asp")
FicheiroBanner.WriteLine("WIDTH 468")
FicheiroBanner.WriteLine("HEIGHT 60")
FicheiroBanner.WriteLine("BORDER 0")
FicheiroBanner.WriteLine("*")
Set rsBanners = Server.CreateObject("ADODB.Recordset")
sSQL = "SELECT * FROM Banners"
With rsBanners
.Open sSQL,DSN
Do While Not .EOF
FicheiroBanner.WriteLine("imagens/" & .Fields("Imagem"))
FicheiroBanner.WriteLine(.Fields("Link"))
FicheiroBanner.WriteLine(.Fields("Nome"))
FicheiroBanner.WriteLine(.Fields("Frequencia"))
.MoveNext
Loop
.Close
End With
FicheiroBanner.Close
Set rsBanners = Nothing
Set FicheiroBanner = Nothing
Set fso = Nothing
End Sub ' ActualizaFicheiroBanner
' ###### Rotina que vai mostrar o Form (para edicao ou criacao de um banner)
Sub MostraForm()
If sOP = "editar" and Request.ServerVariables("REQUEST_METHOD") <> "POST" Then
Set rsBanners = Server.CreateObject("ADODB.Recordset")
sSQL = "SELECT * FROM Banners WHERE ID = " & nID
With rsBanners
.Open sSQL,DSN
If not .EOF Then
sLink = .Fields("Link")
sNome = .Fields("Nome")
sImagem = .Fields("Imagem")
nFrequencia = .Fields("Frequencia")
End If
End With
End If
Call Cabecalho
%>
<CENTER><FONT color="red"><%=sErro%></FONT>
<form method=post ENCTYPE="multipart/form-data" action="admin.asp?ID=<%=nID%>&Op=<%=sOp%>">
<TABLE cellpadding="0" cellspacing="0" border="0" align="center">
<%If sOp = "editar" Then %>
<tr>
<td height="40">Editar Banner</td>
</tr>
<% Else %>
<tr>
<td height="40">Adicionar Banner</td>
</tr>
<%End If %>
<tr>
<TD>Nome:<br><input type="text" name="nome" size="30" value="<%=sNome%>"><p></td>
</tr>
<tr>
<TD>Link:<br><input type="text" name="link" size="30" value="<%=sLink%>"><p></td>
</tr>
<%If sOP = "editar" Then %>
<tr>
<td>Imagem actual:<br>
<IMG SRC="imagens/<%=sImagem%>" title="<%=sNome%>" alt="<%=sNome%>"
height="60" width="468" border="0"><p></td>
</tr>
<tr>
<TD>Nova Imagem: <input type="file" name="imagem" value="<%=sImagem%>">(optional)<p></td>
</tr>
<% Else %>
<tr>
<TD>Imagem:<input type="file" name="imagem" value="<%=sImagem%>"><p></td>
</tr>
<%End If %>
<tr>
<TD>Frequencia: <input type="text" name="frequencia" size="2" maxlength="2" value="<%=nFrequencia%>">(1-10)<p></td>
</tr>
<tr>
<td><input type="submit" value="Gravar" name="submit"></td>
</tr>
</TABLE>
</form>
</CENTER>
<%
Call Rodape
End Sub ' MostraForm
' ###### Rotina q vai mostrar o Form para eliminacao de um registo
Sub MostraApagar()
Call Cabecalho
Set rsBanners = Server.CreateObject("ADODB.Recordset")
sSQL = "SELECT * FROM Banners WHERE ID = " & nID
With rsBanners
.Open sSQL,DSN
If not .EOF Then
sLink = .Fields("Link")
sNome = .Fields("Nome")
sImagem = .Fields("Imagem")
nFrequencia = .Fields("Frequencia")
%>
<CENTER>
<form action="admin.asp?ID=<%=nID%>&Op=<%=sOp%>" method="post">
<table>
<tr>
<td height="40">APAGAR BANNER</td>
</tr>
<tr>
<td colspan="2" height="80"><IMG title="<%=sNome%>" height=60 alt="<%=sNome%>"
src="imagens/<%=sImagem%>" width=468 border=0></td>
</tr>
<tr><td>Ficheiro: </td><td><%=sImagem%></td></tr>
<tr><td>Nome: </td><td><%=sNome%></td></tr>
<tr><td>Link: </td><td><A HREF="<%=sLink%>" target=_new><%=sLink%></A></td></tr>
<tr><td>Freq.: </td><td><%=nFrequencia%></td></tr>
</table>
<input type="submit" name="submit" value="Apagar">
<input type="submit" name="submit" value="Cancelar">
</form>
</CENTER>
<% End If
.Close
End With
Set rsBanners = Nothing
Call Rodape
End Sub ' MostraApagar
Sub Cabecalho
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head><title>Administracao Banners</title></head>
<body leftmargin="0" marginwidth="0" topmargin="0" marginheight="0" bgcolor="white">
<CENTER>
<hr>
<table border="0" cellpadding="0" cellspacing="2" width="100%">
<tr>
<td><font face="Arial">Administracao de Banners</font></td>
<td>
<div align="right">
<font color="#0000ee">[ <a href="default.asp">Voltar ao Banner Ad Rotator</a> ] [ <a href="Javascript:window.close()">Fechar</a> ]</font></div>
</td>
</tr>
</table>
<hr>
</center>
<p>
<%
End Sub
Sub Rodape
%>
</body>
</html>
<%
End Sub
%>
Parece extenso, mas (admitamos) todas as seccoes de administracao o sao... esta nem sequer esta optimizada pois assumo que quem quer que faca a administracao de banners nao o vai fazer de 5 em 5 minutos, e dificilmente o fara com acessos simultaneos, logo nao precisa de grandes arranjos.
T+,
|
|
|
|
|
