📄 ctr.asp
字号:
strSes(5) = "!> inside": strSes(10) = "brk":
End If:
End Sub:
Sub SubIns():
If FktSessOpen() Then
strSes(3) = FktRplStr(Trim(Request.Querystring("fldMsg")),"<",">",0):
If Len(strSes(3)) > 0 And InStr(strSes(3), "!>") = 0 Then
Call SubMsgSet: Call SubUsrTime: Call SubSetUpd(1, 1, 1): strSes(10) = "ins":
Else:
strSes(3) = "": strSes(5) = "!> insert Message here": strSes(10) = "hlp":
End If:
Else:
strSes(0) = "": strSes(4) = "": strSes(5) = "!> outside": strSes(10) = "brk":
End If:
End Sub:
Sub SubOut():
If FktSessOpen() Then
Call SubUsrOut(strSes(0)): Call SubLckTout(strSes(1)):
Call SubSetUpd(2, 0, 0): Call SubUsrTimeout:
strSes(0) = "": strSes(4) = "": strSes(5) = "!> ciao": strSes(10) = "out":
Else:
strSes(0) = "": strSes(4) = "": strSes(5) = "!> outside": strSes(10) = "brk":
End If:
End Sub:
Sub SubCls():
Call SubUsrTimeout:
If Len(strSes(0)) > 0 Then Call SubUsrOut(strSes(0)): End If:
If IsNumeric(strSes(1)) Then Call SubLckTout(strSes(1)): End If:
strSes(0) = "": strSes(4) = "": strSes(5) = "!> ciao": strSes(10) = "":
End Sub:
Sub SubDel():
Dim intNr1, intNr2:
If FktSessOpen() Then
If strSes(4) = "God" Then
strSes(3) = FktRplStr(Trim(Request.Querystring("fldDel")),"<",">",0):
If Len(strSes(3)) > 0 And InStr(strSes(3), "!>") = 0 Then
If strSes(3) <> strSes(0) Then
Call SubUsrOut(strSes(3)):
Application.Lock:
strMsg = Application("strMsg" & Pwd(2)):
For intNr1 = 179 To 0 Step - 1:
If strMsg(intNr1, 0) = strSes(3) Then
For intNr2 = intNr1 To 179:
'If Len(strMsg(intNr2, 1)) = 0 Then Exit For: End If:
strMsg(intNr2, 0) = strMsg(intNr2 + 1, 0):
strMsg(intNr2, 1) = strMsg(intNr2 + 1, 1):
strMsg(intNr2, 2) = strMsg(intNr2 + 1, 2):
Next:
End If:
Next:
Application("strMsg" & Pwd(2)) = strMsg:
Application.Unlock:
Call SubUsrTime: Call SubSetUpd(3, 0, 0): strSes(10) = "del":
Else:
strSes(3) = "": strSes(5) = "!> can not exclude yourself": strSes(10) = "hlp":
End If:
Else:
strSes(3) = "": strSes(5) = "!> insert Name to exclude": strSes(10) = "hlp":
End If:
End If:
Else:
strSes(0) = "": strSes(4) = "": strSes(5) = "!> outside": strSes(10) = "brk":
End If:
End Sub:
Sub SubUpl():
If FktSessOpen() Then
strSes(3) = FktRplStr(Trim(Request.Querystring("fldUpl")),"<",">",0):
If strSes(4) = "God" And InStr(strSes(3), "!>") = 0 Then
Application.Lock:
strUpd = Application("strUpd" & Pwd(2)):
strUpd(CInt(strSes(1)), 1) = strSes(3):
Application("strUpd" & Pwd(2)) = strUpd:
Application.Unlock:
Call SubUsrTime: strSes(10) = "upl":
Else:
strSes(3) = "":
End If:
Else:
strSes(0) = "": strSes(4) = "": strSes(5) = "!> outside": strSes(10) = "brk":
End If:
End Sub:
Sub SubRes(intEnt1):
If FktSessOpen() Or intEnt1 = 1 Then
If strSes(4) = "God" Then
Call SubAppInit: Call SubSessInit: strSes(10) = "res":
End If:
Else:
strSes(0) = "": strSes(4) = "": strSes(5) = "!> outside": strSes(10) = "brk":
End If:
End Sub:
Sub SubUsrTime():
Dim intNr1:
Application.Lock:
strUsr = Application("strUsr" & Pwd(2)):
For intNr1 = 0 To 59:
If strUsr(intNr1, 0) = strSes(0) Then
strUsr(intNr1, 1) = Now(): Exit For:
End If:
Next:
Application("strUsr" & Pwd(2)) = strUsr:
Application.Unlock:
End Sub:
Function FktSessOpen():
Dim intNr1:
strSes(5) = "": FktSessOpen = false:
strUsr = Application("strUsr" & Pwd(2)):
For intNr1 = 0 To 59:
If strUsr(intNr1, 0) = strSes(0) And Len(strSes(0)) > 0 Then
FktSessOpen = true: Exit For:
End If:
Next:
End Function:
Sub SubLckTout(strRom1):
Dim intNr1, intCnt1:
strUsr = Application("strUsr" & Pwd(2)): intCnt1 = 0:
For intNr1 = 0 To 59:
If strUsr(intNr1, 2) = strRom1 Then intCnt1 = intCnt1 + 1: Exit For: End If:
Next:
If intCnt1 = 0 Then
Application.Lock:
strUpd = Application("strUpd" & Pwd(2)):
strUpd(CInt(strRom1), 10) = "opn": 'strUpd(CInt(strRom1), 8) = Now():
Application("strUpd" & Pwd(2)) = strUpd:
Application.Unlock:
End If:
End Sub:
Sub SubLck():
Dim strDat1, strKey1, strKey2:
If FktSessOpen() Then
If strSes(1) <> "1" Then
Application.Lock:
strUpd = Application("strUpd" & Pwd(2)): strDat1 = Now():
strKey1 = strUpd(CInt(strSes(1)),10):
If strKey1 = "opn" Then strKey1 = "lck" Else strKey1 = "opn": strKey2 = "un": End If:
strUpd(CInt(strSes(1)), 8) = strDat1: strUpd(CInt(strSes(1)), 10) = strKey1:
strSes(10) = strKey1: strSes(11) = strDat1:
strSes(5) = "!> Space " & strSes(1) & " " & strKey2 & "locked":
Application("strUpd" & Pwd(2)) = strUpd:
Application.Unlock:
Else:
strSes(10) = "hlp": strSes(5) = "!> Space " & strSes(1) & " remains open":
End If:
Else:
strSes(0) = "": strSes(4) = "": strSes(5) = "!> outside": strSes(10) = "brk":
End If:
End Sub:
Sub SubRom():
Dim intNr1, strRom1, strRom2:
If FktSessOpen() Then
strRom1 = Trim(Request.Querystring("fldRom")):
If IsNumeric(strRom1) Then
Call SubUsrTimeout: Call SubLckTout(strRom1):
If FktLoginRom(0, strRom1) < 10 Then
Call SubSetUpd(2, 0, 0): strRom2 = strSes(1): strSes(1) = strRom1:
Application.Lock:
strUsr = Application("strUsr" & Pwd(2)):
For intNr1 = 0 To 59:
If strUsr(intNr1, 0) = strSes(0) Then
strUsr(intNr1, 2) = strSes(1): Exit For:
End If:
Next:
Application("strUsr" & Pwd(2)) = strUsr:
Application.Unlock:
strSes(10) = "rom": strSes(5) = "!> now in Space " & strSes(1) & " " & strSes(0):
Call SubSetUpd(2, 1, 1): Call SubLckTout(strRom2):
Else:
strSes(10) = "hlp": strSes(5) = "!> Space " & strRom1 & " out of reach":
End If:
End If:
Else:
strSes(0) = "": strSes(4) = "": strSes(5) = "!> outside": strSes(10) = "brk":
End If:
End Sub:
Sub SubFilUsr():
Dim intNr1, intNr2:
Application.Lock:
strUsr = Application("strUsr" & Pwd(2)):
For intNr1 = 0 To 5:
For intNr2 = 0 To 9:
If CInt(CStr(intNr1) & CStr(intNr2)) <> 99 Then
strUsr(CInt(CStr(intNr1) & CStr(intNr2)), 0) = strSes(0) & CStr(intNr1) & CStr(intNr2):
strUsr(CInt(CStr(intNr1) & CStr(intNr2)), 1) = Now():
strUsr(CInt(CStr(intNr1) & CStr(intNr2)), 2) = CStr(intNr1):
End If:
Next:
Next:
Application("strUsr" & Pwd(2)) = strUsr:
Application.Unlock:
End Sub:
Sub SubMda():
If strSes(12) = "on" Then
strSes(12) = "off": strSes(5) = "!> sound and vision off":
Else:
strSes(12) = "on": strSes(5) = "!> sound and vision on":
End If:
End Sub:
Sub SubAct():
strSes(9) = "": strSes(9) = Trim(Request.Querystring("fldAct")):
Select Case strSes(9):
Case "Ent": Call SubEnt: Case "Cls": Call SubCls: Case "Mda": Call SubMda:
Case "Ins": Call SubIns: Case "Out": Call SubOut: Case "Upl": Call SubUpl:
Case "Del": Call SubDel: Case "Rom": Call SubRom: Case "Lck": Call SubLck:
Case "Res": Call SubRes(0): Case Else: Call SubUpdChgDat: Call SubSessCnt:
End Select:
End Sub:
</SCRIPT>
<!--#INCLUDE file="pwd.asp"-->
<%Dim strUsr, strMsg, strApp, strSes, strUpd:
On Error Resume Next:
If Not IsArray(Application("strApp" & Pwd(2))) Then Call SubAppInit: End If:
If Not IsArray(Session("strSes")) Then Call SubSessInit: End If:
Call SubAppRec: strSes = Session("strSes"): strSes(10) = "": Call SubAct:
If Err.Number <> 0 Then Call SubAppInit: Call SubSessInit: End If:
Session("strSes") = strSes:%>
<HTML><HEAD></HEAD>
<%If strSes(12) <> "off" Then %>
<BODY BACKGROUND="../images/space<%=CStr(strSes(1))%>.jpg" BGCOLOR="#000000"
ONLOAD="fktDoAct('<%=CStr(strSes(9))%>');">
<%Else%>
<BODY BACKGROUND="" BGCOLOR="<%=strUpd(CInt(strSes(1)), 9)%>"
ONLOAD="fktDoAct('<%=CStr(strSes(9))%>');">
<%End If%>
<FORM NAME="ctr"><FONT COLOR="#FFFF00" FACE="Arial" SIZE="-1">
<INPUT TYPE="HIDDEN" NAME="fldAct" VALUE="<%=Server.URLEncode(CStr(strSes(9)))%>" SiZE="5"><br>
<INPUT TYPE="HIDDEN" NAME="fldUsr" VALUE="<%=Server.URLEncode(CStr(strSes(0)))%>" SiZE="5"><br>
<INPUT TYPE="HIDDEN" NAME="fldRom" VALUE="<%=Server.URLEncode(CStr(strSes(1)))%>" SiZE="5"><br>
<INPUT TYPE="HIDDEN" NAME="fldGod" VALUE="<%=Server.URLEncode(CStr(strSes(4)))%>" SiZE="5"><br>
<INPUT TYPE="HIDDEN" NAME="fldMsg" VALUE="<%=Server.URLEncode(CStr(strSes(5)))%>" SiZE="5"><br>
<INPUT TYPE="HIDDEN" NAME="fldSId" VALUE="<%=Server.URLEncode(CStr(strSes(7)))%>" SiZE="5"><br>
<INPUT TYPE="HIDDEN" NAME="fldTon" VALUE="<%=Server.URLEncode(CStr(strSes(10)))%>" SiZE="5"><br>
<INPUT TYPE="HIDDEN" NAME="fldMda" VALUE="<%=Server.URLEncode(CStr(strSes(12)))%>" SiZE="5"><br>
<SCRIPT LANGUAGE="JavaScript">
if (document.ctr.fldTon.value != "" && document.ctr.fldMda.value != "off") {
if (navigator.appName.indexOf("Microsoft") != -1) { document.write("<BGSOUND SRC='../sounds/"+document.ctr.fldTon.value+".au'>"); }
else if (navigator.appName.indexOf("Netscape") != -1) { document.write("<EMBED SRC='../sounds/"+document.ctr.fldTon.value+".au' HIDDEN=TRUE AUTOSTART=TRUE>"); } }
</SCRIPT>
</FORM>
</BODY>
</HTML>
<SCRIPT LANGUAGE="JavaScript">
function fktDoAct(typ1){ switch(typ1){
case "Cls": ClsFrame(); break; case "Mda": CmdFrame(); AllFrame(); break;
case "Ent": CmdFrame(); AllFrame(); break; case "Ins": CmdFrame(); MsgFrame(); break;
case "Out": CmdFrame(); UsrFrame(); break; case "Upl": CmdFrame(); MsgFrame(); break;
case "Del": CmdFrame(); TxtFrame(); break; case "Res": CmdFrame(); AllFrame(); break;
case "Rom": CmdFrame(); AllFrame(); break; case "Lck": CmdFrame(); break;
case "Inf": UsrFrame(); break; case "Msg": MsgFrame(); break; case "Txt": TxtFrame(); break; }
setTimeout("CtrFrame();",5000); }
function ClsFrame(){ parent.close(); }
function TxtFrame(){ MsgFrame(); UsrFrame(); }
function AllFrame(){ TopFrame(); MsgFrame(); UsrFrame(); }
function CtrFrame(){ parent.frames[0].location.replace("ctr.asp"); }
function CmdFrame(){ var frm1 = document.ctr; parent.frames[4].location.replace("cmd.asp?fldRom="+frm1.fldRom.value+"&fldUsr="+frm1.fldUsr.value+"&fldGod="+frm1.fldGod.value+"&fldMsg="+frm1.fldMsg.value+"&fldMda="+frm1.fldMda.value); }
function MsgFrame(){ var frm1 = document.ctr; parent.frames[2].location.replace("msg.asp?fldRom="+frm1.fldRom.value+"&fldGod="+frm1.fldGod.value+"&fldMda="+frm1.fldMda.value); }
function UsrFrame(){ var frm1 = document.ctr; parent.frames[3].location.replace("usr.asp?fldRom="+frm1.fldRom.value+"&fldTon="+frm1.fldTon.value+"&fldMda="+frm1.fldMda.value); }
function TopFrame(){ var frm1 = document.ctr; parent.frames[1].location.replace("top.asp?fldRom="+frm1.fldRom.value+"&fldMda="+frm1.fldMda.value); }
</SCRIPT>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -