<% Response.Expires = 0 Response.Expiresabsolute = Now() - 1 Response.AddHeader "pragma","no-cache" Response.AddHeader "cache-control","private" Response.CacheControl = "no-cache" '----------------setup------------------ Const UserTiemout = 5 ' mins for user's timeout Const Title = "ASLAN Chat v.2.5" 'title of web page '----------------/setup------------------ Select Case Request("event") Case "login" If Request("login") = "" Then Response.Redirect "index.asp" End If If ConnectUser(HTMLFormat(Request("login"))) = False Then Response.Redirect "index.asp?error=1&username=" & request("login") End If For ln =20 to 2 Step -1 Application(ln)=Application(ln-1) Next Application("1")=""& Request("login") & " Sohbete Katıldı" Response.Redirect "chat.asp" ' Show ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Case "show" Response.Write "" Response.Write "" Response.Write "" For f=1 to 20 Response.Write Application(f) & "
" Next ' Post ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Case "post" For ln =20 to 2 Step -1 Application(ln)=Application(ln-1) Next ' Smiles are here ChatText = HTMLFormat(Request("text")) ChatText = Replace(ChatText, ":)", "") ChatText = Replace(ChatText, ":D", "") ChatText = Replace(ChatText, ":o","") ChatText = Replace(ChatText, ":(", "") ChatText = Replace(ChatText, ";)", "") ChatText = Replace(ChatText, ":p", "") ChatText = Replace(ChatText, "8)", "") ChatText = Replace(ChatText, ":[", "") ChatText = Replace(ChatText, ":kill:", "") ChatCommand = Lcase(Mid(ChatText, 1, InstrRev(ChatText,":"))) Select Case ChatCommand Case "/clear:" For t=1 to 20 Application(t) = "" Next Case Else CurrentNickName = "" & Session("nickname") & "" Application("1")="" & Session("nickname") & ": "& ChatText End Select x= SetUserSettings(Session("nickname"),"timer",Timer) Response.Redirect "chat.asp?event=form" ' Logout ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Case "logout" For ln =20 to 2 Step -1 Application(ln)=Application(ln-1) Next Application("1")=""& Session("nickname") & " Sohbetten çıktı" x = DisconnectUser (Session("nickname")) Response.Redirect"../default.asp" ' List Users ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Case "listusers" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & ListUsers tmpBuf = tmpBuf &"" Response.Write tmpBuf ' Setup ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Case "setup" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "Ayarlama Bölümü" tmpBuf = tmpBuf & "

---

" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "

" tmpBuf = tmpBuf & "" For Rfrsh = 5 To 60 Step 10 tmpBuf = tmpBuf & "" & Rfrsh & "" Next tmpBuf = tmpBuf & "" & Session("refresh") & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "

" Response.Write tmpBuf ' Refresh ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Case "refresh" Session("refresh") = Request("refresh") Response.Redirect"chat.asp" ' Form ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Case "form" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "

" tmpBuf = tmpBuf & " " tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & " " ' Smiles ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ tmpBuf = tmpBuf & " " tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & " " tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & " " tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & " " tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & " " tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & " " tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & " " tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & " " tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ tmpBuf = tmpBuf & "

" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "

" tmpBuf = tmpBuf & "" Response.Write tmpBuf ' Anything Else ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Case Else tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "<link href=""site.css"" rel=""stylesheet"" type=""text/css"">" tmpBuf = tmpBuf & "<body>" tmpBuf = tmpBuf & "<p>This page uses frames, but your browser doesn't support them.</p>" tmpBuf = tmpBuf & "</body>" tmpBuf = tmpBuf & "" tmpBuf = tmpBuf & "" Response.Write tmpBuf End Select Function ListUsers() Dim UsersBuf Set XMLDOC = CreateObject("Microsoft.XMLDOM") XMLDOC.async = False XMLDOC.resolveExternals = False If Application("xmldoc") = "" Then Application("xmldoc") = "" End If XMLDoc.LoadXML Application("xmldoc") XPath = "//users/*" Set UsersList = XMLDOC.SelectNodes(XPath) If UsersList.Length = 0 Then ListUsers = "Oda boş" Else For Each UserName In UsersList ThisUserTimeout = GetUserSettings(UserName.GetAttribute ("nick"), "timer") + (UserTiemout * 100) If Timer > ThisUserTimeout Then DisconnectUser(UserName.GetAttribute ("nick")) Exit For End If UsersBuf = UsersBuf & UserName.GetAttribute ("nick") & "
" '" (" & FormatNumber((ThisUserTimeout - Timer)/100,2) & ")" & "
" Next ListUsers = UsersBuf End IF End Function Function ConnectUser (NickName) Set XMLDOC = CreateObject("Microsoft.XMLDOM") XMLDOC.async = False XMLDOC.resolveExternals = False If Application("xmldoc") = "" Then Application("xmldoc") = "" End If XMLDoc.LoadXML Application("xmldoc") XPath = "//user[@nick='" & NickName & "']" Set RegisteredUser = XMLDOC.SelectSingleNode(XPath) If RegisteredUser Is Nothing Then XPath = "//users" Set UsersList = XMLDOC.SelectSingleNode(XPath) Set NewUser = XMLDOC.CreateElement("user") NewUser.SetAttribute "nick", NickName NewUser.SetAttribute "timer", Timer UsersList.AppendChild NewUser Application("xmldoc") = XMLDOC.xml Session("nickname") = NickName Session("refresh") = 5 ConnectUser = True Else ConnectUser = False End If End Function Function DisconnectUser(NickName) Set XMLDOC = CreateObject("Microsoft.XMLDOM") XMLDOC.async = False XMLDOC.resolveExternals = False If Application("xmldoc") = "" Then Application("xmldoc") = "" End If XMLDoc.LoadXML Application("xmldoc") XPath = "//user[@nick='" & NickName & "']" Set UserList = XMLDOC.SelectNodes(XPath) If UserList Is Nothing Then DisconnectUser = False Else For Each Node In UserList Node.parentNode.removeChild Node Next Application("xmldoc") = XMLDoc.xml DisconnectUser = True End If End Function Function GetUserSettings(LoginName, PropertyName) If LoginName = "" then Exit Function Set XMLDOC = CreateObject("Microsoft.XMLDOM") XMLDOC.async = False XMLDOC.resolveExternals = False If Application("xmldoc") = "" Then Application("xmldoc") = "" End If XMLDoc.LoadXML Application("xmldoc") XPath = "//user[@nick='" & LoginName & "']" Set SelectedUser = XMLDOC.SelectSingleNode(XPath) If SelectedUser Is Nothing Then GetUserSettings = "" Else If Len(SelectedUser.GetAttribute(PropertyName)) = 0 Then GetUserSettings = "" Else GetUserSettings = SelectedUser.GetAttribute(PropertyName) End If End If End Function Function SetUserSettings(NickName,UserProperty,PropertyInfo) ' As Boolean Set XMLDOC = CreateObject("Microsoft.XMLDOM") XMLDOC.async = False XMLDOC.resolveExternals = False If Application("xmldoc") = "" Then Application("xmldoc") = "" End If XMLDoc.LoadXML Application("xmldoc") XPath = "//user[@nick='" & NickName & "']" Set SelectedUser = XMLDOC.SelectSingleNode(XPath) If SelectedUser Is Nothing Then SetUserSettings = False Else SelectedUser.SetAttribute UserProperty, PropertyInfo Application("xmldoc") = XMLDOC.XML SetUserSettings = True End If End Function Function HTMLFormat(sInput) Dim sAns Dim sIIIStart, sIIIEnd sAns = Replace(sInput, " ", "  ") sAns = Replace(sAns, Chr(34), """) sIllStart = "<" & Chr(37) sIllEnd = Chr(37) & ">" If InStr(sAns, sIllStart) > 0 Or InStr(sAns, sIllEnd) > 0 Then sAns = Replace(sAns, "<" & Chr(37), "") sAns = Replace(sAns, Chr(37) & ">", "") End If sAns = Replace(sAns, ">", ">") sAns = Replace(sAns, "<", "<") sAns = Replace(sAns, vbCrLf, "
") sAns = Replace(sAns, "[b]", "") sAns = Replace(sAns, "[/b]", "") sAns = Replace(sAns, "[i]", "") sAns = Replace(sAns, "[/i]", "") HTMLFormat = sAns End Function %>