USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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:&nbsp;</td><td colspan="2"><%=.Fields("Imagem")%></td></tr>
<tr><td>Nome:&nbsp;</td><td colspan="2"><%=.Fields("Nome")%></td></tr>
<tr><td>Link:&nbsp;</td><td colspan="2"><A HREF="<%=.Fields("Link")%>" target=_new><%=.Fields("Link")%></A></td></tr>
<tr><td>Freq.:&nbsp;</td><td colspan="2"><%=.Fields("Frequencia")%></td></tr>
<tr><td>Percentagem em que surge:&nbsp;</td><td colspan="2"><%=CalcPercent(.Fields("Frequencia"),nFrequenciaTotal)%>%</td></tr>
<tr><td>Cliques:&nbsp;</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:&nbsp;<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:&nbsp;<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:&nbsp;</td><td><%=sImagem%></td></tr>
<tr><td>Nome:&nbsp;</td><td><%=sNome%></td></tr>
<tr><td>Link:&nbsp;</td><td><A HREF="<%=sLink%>" target=_new><%=sLink%></A></td></tr>
<tr><td>Freq.:&nbsp;</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">[&nbsp;<a href="default.asp">Voltar ao Banner Ad Rotator</a>&nbsp;]&nbsp;[&nbsp;<a href="Javascript:window.close()">Fechar</a>&nbsp;]</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+,
 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página