global.asa

聊天室源码呵呵你好用~~~~~~2.0版本

<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
sub Application_OnStart
 dim all_saysdata(400),reg_data(),user_online()
 Application("a_c_chatroom_name")="聊吧"
 Application("a_c_user_active")=0
 Application("a_c_all_closedoor")=0
 Application("a_c_user_inthechat")=0
 Application("a_c_all_title")="<font color=0000FF>欢迎光临" & Application("a_c_chatroom_name") & "，祝你聊得开心！</font>"
 Application("a_c_ip_locknum")=0
 Application("a_c_user_online")=user_online
 for i=1 to 400
  all_saysdata(i)=""
 next
 Set FileObject=Server.CreateObject("Scripting.FileSystemObject")
 f1txtfile=Server.MapPath("f1.txt")
 saysfile=Server.MapPath("saysdata.asp")
 userdatafile=Server.MapPath("userdata_v150.asp")
 Application("a_c_f1txtfile")=f1txtfile
 Application("a_c_saysfile")=saysfile
 Application("a_c_userdatafile")=userdatafile
 Set InStream=FileObject.OpenTextFile(saysfile,1,False)
 countud=0
 do while not InStream.AtEndOfStream
  thisline=InStream.readline
  all_saysdata(countud)=thisline
  countud=countud + 1
 loop
 InStream.Close
 Application("a_c_all_saysdata")=all_saysdata
 Set InStream=FileObject.OpenTextFile(f1txtfile,1,False)
 Application("a_c_chatroom_f1")=InStream.readall
 InStream.Close
 Set InStream=FileObject.OpenTextFile(userdatafile,1,False)
 countud=0
 do while not InStream.AtEndOfStream
  thisline=InStream.readline
  ReDim Preserve reg_data(countud)
  reg_data(countud)=thisline
  countud=countud + 1
 loop
 InStream.Close
 Application("a_c_reg_data")=reg_data
 Application("a_c_reg_num")=(countud-1)
 lydatafile=Server.MapPath("speakdata_v200.asp")
 dim ly_data(),ly_index()
 Set InStream=FileObject.OpenTextFile(lydatafile,1,False)
 countud=0
 do while not InStream.AtEndOfStream
  thisline=InStream.readline
  ReDim Preserve ly_data(countud)
  ly_data(countud)=thisline
  countud=countud + 1
 loop
 InStream.Close
 countindex=1
 for i=1 to countud-1 step 11
  Redim Preserve ly_index(countindex),ly_index(countindex+1),ly_index(countindex+2)
  ly_index(countindex)=ly_data(i)
  ly_index(countindex+1)=ly_data(i+1)
  ly_index(countindex+2)=ly_data(i+3)
  countindex=countindex+3
 next
 if countindex=1 then
  Application("a_c_ly_num")=0
 else
  Application("a_c_ly_num")=UBound(ly_index)
 end if
 Application("a_c_ly_index")=ly_index
 lockfile=server.mappath("iplocked.txt")
 Set InStream=FileObject.OpenTextFile(lockfile,1,False)
 thisline=InStream.ReadLine
 Application("a_c_ip_locked")=thisline
 ipfile=Server.Mappath("ipaddress.asp")
 Set InStream=FileObject.OpenTextFile(ipfile,1,False)
 dim inputip()
 counter=0
 do while not InStream.AtEndOfStream
  thisline=InStream.readline
  Redim preserve inputip(counter)
  inputip(counter)=thisline
  counter=counter + 1
 loop
 InStream.close
 Application("a_c_ip_address")=inputip
End sub
</SCRIPT>
<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
Sub Session_OnStart
 Session.Timeout=3
 Application.Lock
 Application("a_c_user_active")=Application("a_c_user_active")+1
 Application.UnLock
 Session("a_c_user_name")=""
 Session("a_c_user_level")=""
 Session("a_c_user_ip")=Request.ServerVariables("REMOTE_ADDR")
 Session("a_c_user_times")=""
 Session("a_c_user_value")=""
 Session("a_c_user_alreadylogin")=0
 Session("a_c_user_outchat")=1
 Session("a_c_user_gender")=""
 Session("a_c_user_savetime")=""
End Sub
</SCRIPT>
<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
Sub Session_OnEnd
 username=Session("a_c_user_name")
 Application.Lock
 Application("a_c_user_active")=Application("a_c_user_active")-1
 Application.UnLock
 if username="" then
  Response.End
 end if
 Dim all_saysdata(400), user_online()
 Application.Lock
 online=Application("a_c_user_online")
 saysdata=Application("a_c_all_saysdata")
 inthechat=Application("a_c_user_inthechat")
 uoc=1
 for i=1 to inthechat*4 step 4
  if online(i)=username then
   n=Year(date())
   y=Month(date())
   r=Day(date())
   s=Hour(time())
   f=Minute(time())
   m=Second(time())
   if len(y)=1 then y="0" & y
   if len(r)=1 then r="0" & r
   if len(s)=1 then s="0" & s
   if len(f)=1 then f="0" & f
   if len(m)=1 then m="0" & m
   sj=s & ":" & f & ":" & m
   sj2= n & "-" & y & "-" & r & " " & sj
   all_saysdata(1)=1
   all_saysdata(2)=0
   all_saysdata(3)=username
   all_saysdata(4)="大家"
   all_saysdata(5)="660099"
   all_saysdata(6)="660099"
   all_saysdata(7)="对"
   all_saysdata(8)="<font color=000000>【衡蠡时空聊吧公告】</font><font color=F08000>“砰”的一声，<font color=000000>" & username & "</font>重重地摔了下去……</font><font class=p9>(" & sj & ")</font>"
   for j=9 to 400
    all_saysdata(j)=saysdata(j-8)
   next
   Application("a_c_all_saysdata")=all_saysdata
   Application("a_c_user_inthechat")=Application("a_c_user_inthechat")-1
  else
   Redim Preserve user_online(uoc),user_online(uoc+1),user_online(uoc+2),user_online(uoc+3)
   user_online(uoc)=online(i)
   user_online(uoc+1)=online(i+1)
   user_online(uoc+2)=online(i+2)
   user_online(uoc+3)=online(i+3)
   uoc=uoc + 4
  end if
 next
 Application("a_c_user_online")=user_online
 Application.UnLock
 Set Session("a_c_user_name")=nothing
 Set Session("a_c_user_level")=nothing
 Set Session("a_c_user_ip")=nothing
 Set Session("a_c_user_times")=nothing
 Set Session("a_c_user_value")=nothing
 Set Session("a_c_user_alreadylogin")=nothing
 Set Session("a_c_user_outchat")=nothing
 Set Session("a_c_user_gender")=nothing
 Session("a_c_user_savetime")=nothing
End sub
</SCRIPT>
<SCRIPT LANGUAGE="VBScript" RUNAT="Server">
Sub Application_OnEnd
 sayoutput=Application("a_c_all_saysdata")
 regoutput=Application("a_c_reg_data")
 Set FileOutObject=Server.CreateObject("Scripting.FileSystemObject")
 Set SayOut=FileOutObject.CreateTextFile(Application("a_c_saysfile"),TRUE,FALSE)
 SayOut.WriteLine("<" & "%Response.End%" & ">")
 for i=1 to 400
  SayOut.WriteLine sayoutput(i)
 next
 SayOut.Close
 Set RegOut=FileOutObject.CreateTextFile(Application("a_c_userdatafile"),TRUE,FALSE)
 for i=0 to Application("a_c_reg_num")
  RegOut.WriteLine regoutput(i)
 next
 RegOut.Close
End sub
</SCRIPT>