global.asa

应用于高等院校党团思想教育

<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
sub Application_OnStart
 connstr="DBQ="+Server.MapPath("world/chat/database/global.asa")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
 Application("hg_connstr")=connstr
 Set conn=Server.CreateObject("ADODB.CONNECTION")
 Set rs=Server.CreateObject("ADODB.RecordSet")
 conn.open connstr
 sql="SELECT name,value FROM system"
 rs.open sql,conn,1,1
 do while Not rs.Eof
  Select Case rs("name")
   Case "chatroomname"
    Application("hxf_c_chatroomname")=rs("value")
   Case "user"
    Application("hxf_c_user")=rs("value")
   Case "sn"
    Application("hxf_c_sn")=rs("value")
   Case "copyright"
    Application("hxf_c_copyright")=rs("value")
   Case "visitor"
    Application("hxf_c_visitor")=rs("value")
   Case "chatroombgimage"
    Application("hxf_c_chatroombgimage")=rs("value")
   Case "homepageurl"
    Application("hxf_c_homepageurl")=rs("value")
   Case "opendate"
    Application("hxf_c_opendate")=rs("value")
   Case "chatroombgcolor"
    Application("hxf_c_chatroombgcolor")=rs("value")
   Case "chatbgcolor"
    Application("hxf_c_chatbgcolor")=rs("value")
   Case "chatimage"
    Application("hxf_c_chatimage")=rs("value")
   Case "chatcolor"
    Application("hxf_c_chatcolor")=rs("value")
   Case "logo"
    Application("hxf_c_logo")=rs("value")
   Case "ver"
    Application("hxf_c_ver")=rs("value")
   Case "allowhtml"
    Application("hxf_c_allowhtml")=int(rs("value"))
   Case "iplocktime"
    Application("hxf_c_iplocktime")=int(rs("value"))
   Case "level1to2"
    Application("hxf_c_level1to2")=int(rs("value"))
   Case "level2to3"
    Application("hxf_c_level2to3")=int(rs("value"))
   Case "level3to4"
    Application("hxf_c_level3to4")=int(rs("value"))
   Case "level4to5"
    Application("hxf_c_level4to5")=int(rs("value"))
   Case "maxpeople"
    Application("hxf_c_maxpeople")=int(rs("value"))
   Case "maxtimeout"
    Application("hxf_c_maxtimeout")=int(rs("value"))
   Case "pollbegin"
    Application("hxf_c_pollbegin")=CDate(rs("value"))
   Case "pollend"
    Application("hxf_c_pollend")=CDate(rs("value"))
   Case "pollvalue"
    Application("hxf_c_pollvalue")=CDate(rs("value"))
   Case "disproxy"
    Application("hxf_c_disproxy")=rs("value")
   Case "disnewuser"
    Application("hxf_c_disnewuser")=rs("value")
   Case "titlecolor"
    Application("hxf_c_titlecolor")=rs("value")
   Case "closedoor"
    Application("hxf_c_closedoor")=rs("value")
   Case "automanname"
    Application("hxf_c_automanname")=rs("value")
   Case "disloginname"
    Application("hxf_c_disloginname")=rs("value")
   Case "userinto"
    Application("hxf_c_userinto")=rs("value")
   Case "userout"
    Application("hxf_c_userout")=rs("value")
   Case "userdown"
    Application("hxf_c_userdown")=rs("value")
  End Select
 rs.MoveNext
 loop
 rs.close
 sql="SELECT dieip FROM iplockdie"
 rs.open sql,conn,1,1
 Application("hxf_c_dieip")=rs("dieip")
 rs.close
 sql="SELECT act FROM actlib WHERE acttype='1'"
 rs.open sql,conn,1,1
 totalact=rs.RecordCount
 Randomize
 mr=Int((totalact-250)*Rnd)
 if mr<0 then mr=0
 if mr>totalact-250 then mr=totalact-250
 rs.Move mr
 Dim autoact()
 i=0
 Do while Not(rs.Eof) and i<250
  i=i+1
  Redim Preserve autoact(i)
  autoact(i)=rs("act")
 rs.MoveNext
 Loop
 rs.close
 conn.close
 set rs=nothing
 set conn=nothing
 Application("hxf_c_autoact")=autoact
 Dim nameindex(0)
 useronlinename=" "
 onliners=0
 Application("hxf_c_onlinelist")=nameindex
 Application("hxf_c_useronlinename")=useronlinename
 Application("hxf_c_chatrs")=onliners
 Dim wbq(0)
 Application("hxf_c_webicq")=wbq
 webicqname=" "
 Application("hxf_c_webicqname")=webicqname
 s=Hour(time())
 f=Minute(time())
 m=Second(time())
 if len(s)=1 then s="0" & s
 if len(f)=1 then f="0" & f
 if len(m)=1 then m="0" & m
 t=s & ":" & f & ":" & m
 Dim sd(540)
 for i=1 to 531
  sd(i)=0
 next
 sd(532)=1
 sd(533)=1
 sd(534)=0
 sd(535)="AutoMan"
 sd(536)="大家"
 sd(537)="660099"
 sd(538)="660099"
 sd(539)="对"
 sd(540)="<font color=black>【系统】</font><font color=red>聊天室开门啦！</font><font class=t>(" & t & ")</font>"
 Application("hxf_c_sd")=sd
 Application("hxf_c_line")=1
 Application("hg_title")="欢迎光临" & Application("hxf_c_chatroomname")
 Application("hxf_c_title")="祝大家聊得开心^_^！<font color=FF00FF style=font-size:9pt>（" & Application("hxf_c_automanname") & "，" & t & "）</font>"
End sub
</SCRIPT>
<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
Sub Session_OnStart
 Session.Timeout=3
 Application.Lock
  Application("hxf_c_active")=Application("hxf_c_active")+1
 Application.UnLock
End Sub
</SCRIPT>
<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
Sub Session_OnEnd
 Application.Lock
 Application("hxf_c_active")=Application("hxf_c_active")-1
 if Session("hxf_u_inthechat")="1" then
  nickname=Session("hxf_u_nickname")
  useronlinename=Application("hxf_c_useronlinename")
  if InStr(useronlinename," " & nickname & " ")<>0 then
   onlinelist=Application("hxf_c_onlinelist")
   dim newonlinelist()
   useronlinename=""
   onliners=0
   js=1
   for i=1 to UBound(onlinelist) step 6
    if CStr(onlinelist(i+1))<>CStr(nickname) then
     onliners=onliners+1
     useronlinename=useronlinename & " " & onlinelist(i+1)
     Redim Preserve newonlinelist(js),newonlinelist(js+1),newonlinelist(js+2),newonlinelist(js+3),newonlinelist(js+4),newonlinelist(js+5)
     newonlinelist(js)=onlinelist(i)
     newonlinelist(js+1)=onlinelist(i+1)
     newonlinelist(js+2)=onlinelist(i+2)
     newonlinelist(js+3)=onlinelist(i+3)
     newonlinelist(js+4)=onlinelist(i+4)
     newonlinelist(js+5)=onlinelist(i+5)
     js=js+6
    end if
   next
   useronlinename=useronlinename&" "
   if onliners=0 then
    dim listnull(0)
    Application("hxf_c_onlinelist")=listnull
   else
    Application("hxf_c_onlinelist")=newonlinelist
   end if
   Application("hxf_c_useronlinename")=useronlinename
   Application("hxf_c_chatrs")=onliners
   s=Hour(time())
   f=Minute(time())
   m=Second(time())
   if len(s)=1 then s="0" & s
   if len(f)=1 then f="0" & f
   if len(m)=1 then m="0" & m
   t=s & ":" & f & ":" & m
   sd=Application("hxf_c_sd")
   line=int(Application("hxf_c_line"))
   Application("hxf_c_line")=line+1
   Dim newsd(540)
   j=1
   for i=10 to 540 step 9
    newsd(j)=sd(i)
    newsd(j+1)=sd(i+1)
    newsd(j+2)=sd(i+2)
    newsd(j+3)=sd(i+3)
    newsd(j+4)=sd(i+4)
    newsd(j+5)=sd(i+5)
    newsd(j+6)=sd(i+6)
    newsd(j+7)=sd(i+7)
    newsd(j+8)=sd(i+8)
    j=j+9
   next
   newsd(532)=line+1
   newsd(533)=1
   newsd(534)=0
   newsd(535)=nickname
   newsd(536)="大家"
   newsd(537)="660099"
   newsd(538)="660099"
   newsd(539)="对"
   newsd(540)="<font color=black>【公告】</font><font color=F08000>" & Replace(Application("hxf_c_userdown"),"%%","<font color=black>" & nickname & "</font>") & "</font><font class=t>(" & t & ")</font>"
   Application("hxf_c_sd")=newsd
  end if
 end if
 Application.UnLock
End sub
</SCRIPT>
<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
Sub Application_OnEnd
End sub
</SCRIPT>