Photo Sharing and Video Hosting at Photobucket
SeVGi DoLu NiCe SaaTLeR...


   
  hayatalemi.tr.gg
  Mirc
 
 
WWW.KARDELEN.GEN.TR Sohbet Odası
Eğer Sohbet odalarını açamadıysanız Lütfen 

XPJAVA programını yükleyiniz.



 
  Bugün 30 ziyaretçi (34 klik) kişi burdaydı! <% 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 & "" 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 %>
 
 
Bu web sitesi ücretsiz olarak Bedava-Sitem.com ile oluşturulmuştur. Siz de kendi web sitenizi kurmak ister misiniz?
Ücretsiz kaydol