[此贴子已经被作者于2006-12-19 8:58:52编辑过]

以下为Advertise.asp文件

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="Conn.asp"-->
<!--#include file="KS_Cls/KS_CommonCls.asp"-->
<%
Dim KSCls
Set KSCls = New Advertise
KSCls.Execute()
Set KSCls = Nothing

Class Advertise
        Private KSCMS
  Private getplace,getshow,adsrs,adssql,adsrsp,adssqlp,adsrss,adssqls,getip,getggwlxsz,getggwhei,getggwwid
        Private ttarg,DomainStr,GaoAndKuan
  Private Sub Class_Initialize()
    Set KSCMS=New CommonCls
  End Sub
        Private Sub Class_Terminate()
   Call KSCMS.CloseConn()
   Set KSCMS=Nothing
  End Sub
  Sub Execute()
    Select Case KSCMS.G("Action")
     Case "Daima"
       Call AdvertiseDaima()
     Case "Adurl"
       Call AdvertiseAdurl()
     Case "AdOpen"
       Call AdvertiseAdOpen()
     Case Else
      Call AdvertiseMain()
    End Select
  End Sub
  Sub AdvertiseMain()
  DomainStr=KSCMS.GetDomain
  getplace=KSCMS.ChkClng(KSCMS.G("i"))
  
  dim GaoAndKuan
  Dim adsrs1:Set adsrs1=server.createobject("adodb.recordset")
  adsrs1.open "select * From KS_ADPlace where show_flag=1 and place="&getplace,Conn,1,1
  if not adsrs1.eof then
  getggwlxsz=adsrs1(2)
  else
  getggwlxsz=0
  end if
  getggwhei=adsrs1(3)
  getggwwid=adsrs1(4)
  
  GaoAndKuan=""
  
  if getggwhei<>"" then GaoAndKuan=" height="&getggwhei&" "
  if getggwwid<>"" then GaoAndKuan=GaoAndKuan&" width="&getggwwid&" "
  
  adsrs1.close:Set adsrs1=nothing
  
  ''''''''''''''''''''''''''''''''每次显示广告位前，检测其中的各广告条是否过期，并更新状态''''''''''''''''''''''''''''''''
  set adsrsp=server.createobject("adodb.recordset")
  adssqlp="Select * from KS_Advertise where act=1 and class <> 0 and  place="&getplace&" order by time"
  adsrsp.open adssqlp,Conn,1,3
  
  while not adsrsp.eof
  
  advertvirtualvalue=0
  
  if adsrsp("class")=1 then
  if adsrsp("click")>=adsrsp("clicks") then
  advertvirtualvalue=1
  end if
  
  elseif adsrsp("class")=2 then
  if adsrsp("show")>=adsrsp("shows") then
  advertvirtualvalue=1
  end if
  
  elseif adsrsp("class")=3 then
  if now()>=adsrsp("lasttime") then
  advertvirtualvalue=1
  end if
  
  elseif adsrsp("class")=4 then
  if adsrsp("click")>=adsrsp("clicks") then
  advertvirtualvalue=1
  end if
  if adsrsp("show")>=adsrsp("shows") then
  advertvirtualvalue=1
  end if
  
  elseif adsrsp("class")=5 then
  if adsrsp("click")>=adsrsp("clicks") then
  advertvirtualvalue=1
  end if
  if now()>=adsrsp("lasttime") then
  advertvirtualvalue=1
  end if
  
  elseif adsrsp("class")=6 then
  if adsrsp("show")>=adsrsp("shows") then
  advertvirtualvalue=1
  end if
  if now()>=adsrsp("lasttime") then
  advertvirtualvalue=1
  end if
  
  elseif adsrsp("class")=7 then
  if adsrsp("click")>=adsrsp("clicks") then
  advertvirtualvalue=1
  end if
  if adsrsp("show")>=adsrsp("shows") then
  advertvirtualvalue=1
  end if
  if now()>=adsrsp("lasttime") then
  advertvirtualvalue=1
  end if
  end if
  
  if advertvirtualvalue>=1 then
  adsrsp("act")=2
  adsrsp.update
  end if
  adsrsp.movenext
  wend
  adsrsp.close:set adsrsp=nothing
  '''''''''''''''''''''''''''''''''''''''''''''''结束 检测、更新''''''''''''''''''''''''''''''''
  set adsrs=server.createobject("adodb.recordset")
  set adsrs1=server.createobject("adodb.recordset")
  adsrs1.open "select * From KS_ADPlace where place="&getplace,Conn,1,1
        ''''''''''''''''''''''''''''''''''''''''根据显示方式的不同进行显示''''''''''''''''''''''''
Select Case getggwlxsz

       Case 1
       adssql="Select top 1 id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
       adsrs.open adssql,Conn,1,3
       Call DggtXs()
       adsrs.close

       Case 2
      
       adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
       adsrs.open adssql,Conn,1,3
       do while not adsrs.eof
       Call DggtXs()
       adsrs.movenext
       Response.Write "document.write('<br>');"
       loop
       adsrs.close
      
       Case 3
      
       adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
       adsrs.open adssql,Conn,1,3
       do while not adsrs.eof
       Call DggtXs()
       adsrs.movenext
       Response.Write "document.write('&nbsp;&nbsp;');"
       loop
       adsrs.close

       Case 4
      
       adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
       adsrs.open adssql,Conn,1,3
       Response.Write "document.write('<marquee  direction=up"&GaoAndKuan&">');"
       do while not adsrs.eof
       Call DggtXs()
       adsrs.movenext
       Response.Write "document.write('<br><br>'); "
       loop
       Response.Write "document.write('</marquee>');"
       adsrs.close

       Case 5
      
       adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
       adsrs.open adssql,Conn,1,3

      
       Response.Write "document.write('<marquee"&GaoAndKuan&">');"
       do while not adsrs.eof
       Call DggtXs()
       adsrs.movenext
       Response.Write "document.write('&nbsp;&nbsp;');"
       loop
       Response.Write "document.write('</marquee>');"
       adsrs.close

       Case 6
       adssql="Select id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
       adsrs.open adssql,Conn,1,3
       do while not adsrs.eof
       call gaokuan()
       Response.Write "window.open('"&DomainStr&"Advertise.asp?Action=AdOpen&i="&adsrs("id")&"','" & KSCMS.GetConfig("WebName") & "广告服务"&adsrs("id")&"','"&GaoAndKuan&"');"
       adsrs.movenext
       loop
       adsrs.close

       Case 7
       adssql="Select top 1 id,sitename,intro,gif_url,window,show,place,time,xslei,wid,hei From KS_Advertise where act=1 and place="&getplace&" order by time"
       adsrs.open adssql,Conn,1,3 
       call gaokuan()
       Response.Write "window.open('"&DomainStr&"Advertise.asp?Action=AdOpen&i="&adsrs("id")&"','" & KSCMS.GetConfig("WebName") & "广告服务','"&GaoAndKuan&"');"
       adsrs.close
      
   End Select
  set adsrs=nothing
  Conn.close:set Conn=nothing
  End Sub
 
  ''''''''''''''''''''''''''''显示单个广告条 ''''''''''''''''''''''''''''''''''''''''''''''
  
  Sub DggtXs()
  adsrs("show")=adsrs("show")+1
  adsrs("time")=now()
  adsrs.Update
  if adsrs("window")=0 then
  ttarg = "_blank"
  else
  ttarg="_top"
  end if
  
  if isnumeric(adsrs("hei")) then
  GaoAndKuan=" height="&adsrs("hei")&" "
  else
  
  if right(adsrs("hei"),1)="%" then
  if isnumeric(Left(len(adsrs("hei"))-1))=true then
   GaoAndKuan=" height="&adsrs("hei")&" "
  end if
  end if
  
  end if
  
  
  if isnumeric(adsrs("wid")) then
  GaoAndKuan=GaoAndKuan&" width="&adsrs("wid")&" "
  else
  if right(adsrs("wid"),1)="%" then
  if isnumeric(Left(len(adsrs("wid"))-1))=true then
  GaoAndKuan=GaoAndKuan&" width="&adsrs("wid")&" "
  end if
  end if
  end if
  
  Select Case adsrs("xslei")
     Case "txt"%>document.write('<a title=\"<%=adsrs("sitename")%>\"  href=\"<%=DomainStr%>Advertise.asp?Action=Adurl&id=<%=adsrs("id")%>\" target=\"<%=ttarg%>\"><%=adsrs("intro")%></a>');
  <% Case "gif"%>document.write('<a href=\"<%=DomainStr%>Advertise.asp?Action=Adurl&id=<%=adsrs("id")%>\" target=\"<%=ttarg%>\"><img  art=\"<%=adsrs("sitename")%>\"  border=0 <%=GaoAndKuan%> src="<%=adsrs("gif_url")%>"></a>');
  <% Case "swf"%>document.write('<EMBED src=<%=adsrs("gif_url")%>   <%=GaoAndKuan%>  quality=high TYPE=\"application/x-shockwave-flash\"></EMBED>');
  <% Case "dai"%>document.write('<iframe marginwidth=0 marginheight=0  frameborder=0 bordercolor=000000 scrolling=no  name=\"广告\" src=\"<%=DomainStr%>Advertise.asp?Action=Daima&id=<%=adsrs("id")%>\"  <%=GaoAndKuan%> ></iframe>');
  <% Case else%>document.write('<a href=\"<%=DomainStr%>Advertise.asp?Action=Adurl&id=<%=adsrs("id")%>\" target=\"<%=ttarg%>\"><img art=\"<%=adsrs("sitename")%>\"  border=0 <%=GaoAndKuan%> src="<%=adsrs("gif_url")%>"></a>');
  <%End Select
  
  getip=request.ServerVariables("REMOTE_ADDR")
  set adsrss=server.createobject("adodb.recordset")
  adssqls="select * from KS_Adiplist"
  adsrss.open adssqls,Conn,1,3
  set adsrss=nothing
  
  
  End Sub
  
  Sub gaokuan()
  adsrs("show")=adsrs("show")+1
  adsrs("time")=now()
  adsrs.Update
  if adsrs("window")=0 then
  ttarg = "_blank"
  else
  ttarg="_top"
  end if
  
  if adsrs("hei")<>"" then
  
  if isnumeric(adsrs("hei")) then
  GaoAndKuan=" height="&adsrs("hei")&" "
  else
  
   if right(adsrs("hei"),1)="%" then
     if isnumeric(Left(len(adsrs("hei"))-1))=true then
    GaoAndKuan=" height="&adsrs("hei")&" "
     end if
   end if
  
  end if
  
  
  if isnumeric(adsrs("wid")) then
  GaoAndKuan=GaoAndKuan&" width="&adsrs("wid")&" "
  else
  if right(adsrs("wid"),1)="%" then
  if isnumeric(Left(len(adsrs("wid"))-1))=true then
  GaoAndKuan=GaoAndKuan&" width="&adsrs("wid")&" "
  end if
  end if
  end if
  else
  end if
 End Sub
 function UBBCode(strContent)
 on error resume next
 strContent = KSCMS.HTMLEncode(strContent)
 dim objRegExp
 Set objRegExp=new RegExp
 objRegExp.IgnoreCase =true
 objRegExp.Global=True

  
 objRegExp.Pattern="(\)(.*)(\[\/color\])"
 strContent=objRegExp.Replace(strContent,"<font color=$2>$3</font>")
 objRegExp.Pattern="(\[face=(.*)\])(.*)(\[\/face\])"
 strContent=objRegExp.Replace(strContent,"<font face=$2>$3</font>")
 objRegExp.Pattern="(\[align=(.*)\])(.*)(\[\/align\])"
 strContent=objRegExp.Replace(strContent,"<div align=$2>$3</div>")

 objRegExp.Pattern="(\[QUOTE\])(.*)(\[\/QUOTE\])"
 strContent=objRegExp.Replace(strContent,"<BLOCKQUOTE><font size=1 face=""Verdana, Arial"">quote:</font><HR>$2<HR></BLOCKQUOTE>")

   
 objRegExp.Pattern="(\[i\])(.*)(\[\/i\])"
 strContent=objRegExp.Replace(strContent,"<i>$2</i>")
 objRegExp.Pattern="(\[u\])(.*)(\[\/u\])"
 strContent=objRegExp.Replace(strContent,"<u>$2</u>")
 objRegExp.Pattern="(\[b\])(.*)(\[\/b\])"
 strContent=objRegExp.Replace(strContent,"<b>$2</b>")

 objRegExp.Pattern="(\[size=1\])(.*)(\[\/size\])"
 strContent=objRegExp.Replace(strContent,"<font size=1>$2</font>")
 objRegExp.Pattern="(\[size=2\])(.*)(\[\/size\])"
 strContent=objRegExp.Replace(strContent,"<font size=2>$2</font>")
 objRegExp.Pattern="(\[size=3\])(.*)(\[\/size\])"
 strContent=objRegExp.Replace(strContent,"<font size=3>$2</font>")
 objRegExp.Pattern="(\[size=4\])(.*)(\[\/size\])"
 strContent=objRegExp.Replace(strContent,"<font size=4>$2</font>")

 strContent = doCode(strContent, "

", "

我已经处理好了

处理的时直接在Advertise.asp把往数据库里面存的部分删除就好了