<!--#include file="Config.asp"-->
<%
' ***************************************************************
' 此文件用于 连接数据库 和 执行数据库的各种数据操作
' ***************************************************************

' ============================================
' 常用变量声明
' ============================================

 Dim DB_CONN       '数据库连接对象
 Dim RS            '数据库记录集
 Dim I , J         '常用循环变量
 Dim MyArray()     '动态数组变量
 Set LogRS = Server.CreateObject( "ADODB.Recordset" )
'数据库连接
 Call DB_LINK()
 'Web_Log_URL = SysConfig("i_Sys_Config_LoginUrl")
 
' ============================================
' 数据库连接函数
' ============================================

Sub DB_LINK() '数据库连接 并 实例化记录集

	Set DB_CONN = Server.CreateObject( "ADODB.Connection" ) '实例化连接

	On Error Resume Next
	' 连接数据库
	DB_CONN.Open DB_SQL_STR
	
	Call ERR_ALERT( DB_SQL_STR,"数据库连接错误") '错误提示
    
    Set RS = Server.CreateObject( "ADODB.Recordset" ) '实例化记录集
    	
     DB_CONN.CursorLocation = 3  '设置数据库游标
	 RS.CursorLocation      = 3  '设置记录集游标
End Sub

' ============================================
' 查询函数 或 执行函数
' 参数说明:
' SELECT_STR 查询语句, EXCUTE_TYPE 查询方式0,1分别为conn.execute 和 rs.open
' ============================================

SUB RS_SELECT( SELECT_STR , EXCUTE_TYPE )
     
	 On Error Resume Next '容错
     If EXCUTE_TYPE = 0 Then 
	         Set RS = DB_CONN.EXECUTE( SELECT_STR )
	 Else
             RS.OPEN SELECT_STR , DB_CONN , 1 , 3
	 End If 

	 Call ERR_ALERT( SELECT_STR , "查询函数/执行函数出错" ) ' 错误提示
     
End SUB 

'查询执行函数,返回RS
function ReturnRsSelect(SELECT_STR)
    
        On Error Resume Next '容错
        Dim MyRs
        Set MyRs = Server.CreateObject( "ADODB.Recordset" )
        MyRs=DB_CONN.EXECUTE( SELECT_STR )
        ReturnRsSelect=MyRs

end function

' ============================================
' 添加修改函数
' 参数说明:
' SELECT_STR 对应的查询语句, ALTER_COUNT 要修改的字段数量, ALTER_TYPE 修改类型0,1分别为修改 和 添加, ALTER_ARRAY 用于赋值的数组
' ALTER_START_NUMBER 从哪个字段序号开始,目的是为排除ID主键自增字段,主键自增是不用赋值的
' ============================================

SUB RS_ALTER( SELECT_STR , ALTER_COUNT , ALTER_TYPE , ALTER_ARRAY , ALTER_START_NUMBER )
     
	 On Error Resume Next '容错

              
	 RS.OPEN SELECT_STR , DB_CONN , 1 , 3

         If ALTER_TYPE = 1 Then '添加操作
	     RS.ADDNEW()
	 End If 

	 For I = ALTER_START_NUMBER To ALTER_COUNT-1  '循环为每个字段赋值

             RS( I ) = ALTER_ARRAY( I )

	 Next 

	 RS.UPDATE() '更新记录集
         Call RS_END()
	 Call ERR_ALERT( SELECT_STR , "添加修改函数出错" ) ' 错误提示
     
End SUB 

' ============================================
' 释放记录集
' ============================================
Sub RS_End()
	On Error Resume Next	
	RS.Close
End Sub

' ============================================
' 释放数据库连接对象
' ============================================
Sub Conn_End()
	On Error Resume Next	
	RS.Close
	Set RS = Nothing
	DB_CONN.Close
	Set DB_CONN = Nothing
End Sub


' ============================================
' 输出错误提示
' 参数说明:
' ERR_ARG  要输出的变量信息 , ERR_STR  要输出的错误提示
' ============================================
Sub ERR_ALERT( ERR_ARG , ERR_STR )

        If Err.Number <> 0 Then
		' 显示错误信息
		Response.Write ERR_ARG  '输出变量信息
		Response.Write "</BR>"  '输出换行
		Response.Write ERR.Description '错误详细提示
		Response.Write "</BR>"  '输出换行
		Response.Write ERR_STR  '输出错误提示
		' 停止输出
		Response.End
	End If

End Sub 

' ============================================
' 得到安全字符串,在查询中使用
' ============================================
Function Get_SafeStr(str)
	Get_SafeStr = Replace(Trim(str), "'", "‘")
	Get_SafeStr = Replace(Trim(str), ",", "，")
	Get_SafeStr = Replace(Trim(str), "/", "")
	Get_SafeStr = Replace(Trim(str), "\", "")
End Function

function Check_SafeStr(str)
	str = trim(str)
	Dim Fy_Post,Fy_Get,Fy_In,Fy_Inf,Fy_Xh,Fy_db,Fy_dbstr,Kill_IP,WriteSql,re
	re = true
	Fy_In="'|;|and|(|)|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
	Fy_Inf = split(Fy_In,"|")
	If str <> "" Then
		For Fy_Xh = 0 To Ubound(Fy_Inf)
			if instr(LCase(str),Fy_Inf(Fy_Xh))>0 then re=false
		Next
	End If
	Check_SafeStr = re
end function

'过滤安全字符
function GetInStr(str)
	str = trim(str)
	Dim Fy_Post,Fy_Get,Fy_In,Fy_Inf,Fy_Xh,Fy_db,Fy_dbstr,Kill_IP,WriteSql
	Fy_In="'|;|and|(|)|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
	Fy_Inf = split(Fy_In,"|")
	If str <> "" Then
		For Fy_Xh = 0 To Ubound(Fy_Inf)
			str = replace(LCase(str),Fy_Inf(Fy_Xh),"")
		Next
	End If
	GetInStr = str
end function 

' ============================================
' 取实际字符长度
' ============================================
Function Get_TrueLen(str)
	Dim l, t, c, i
	l = Len(str)
	t = l
	For i = 1 To l
		c = Asc(Mid(str, i, 1))
		If c < 0 Then c = c + 65536
		If c > 255 Then t = t + 1
	Next
	Get_TrueLen = t
End Function

' ============================================
' 验证字符串符合长度要求
' 参数说明:
' Min_Length 最小长度要求 , Max_Length 最大长度,如果最大长度为0,则不验证最大长度
' ============================================
Function Valide_Str_Length( Str , Min_Length , Max_Length )
     
     Dim Length : Length = Get_TrueLen(str) '获取字符串长度

     If  Length > Min_Length  Then ' 检验是否符合长度 
         If  Max_Length <> 0 Then  

			  If  Length < Max_Length Then 
					Valide_Str_Length = True
			  Else
					Valide_Str_Length = False 
			  End If 

	     Else
              Valide_Str_Length = True 
         End If
	
     Else
         Valide_Str_Length = False 
     End If 

End Function 

'格式化时间函数
public function formatdate(dateandtime,para)
	on error resume next
	dim y, m, d, h, mi, s, strdatetime
	formatdate = dateandtime
	if not isnumeric(para) then exit function
	if not isdate(dateandtime) then exit function
	y = cstr(year(dateandtime))
	m = cstr(month(dateandtime))
	if len(m) = 1 then m = "0" & m
	d = cstr(day(dateandtime))
	if len(d) = 1 then d = "0" & d
	h = cstr(hour(dateandtime))
	if len(h) = 1 then h = "0" & h
	mi = cstr(minute(dateandtime))
	if len(mi) = 1 then mi = "0" & mi
	s = cstr(second(dateandtime))
	if len(s) = 1 then s = "0" & s
	select case para
		case "1"
			strdatetime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
		case "2"
			strdatetime = y & "-" & m & "-" & d
		case "3"
			strdatetime = y & "/" & m & "/" & d
		case "4"
			strdatetime = y & "年" & m & "月" & d & "日 " & h & ":" & mi & ":" & s
		case "5"
			strdatetime = m & "-" & d & " " & h & ":" & mi
		case "6"
			strdatetime = m & "/" & d
		case "7"
			strdatetime = m & "月" & d & "日"
		case "8"
			strdatetime = y & "年" & m & "月"
		case "9"
			strdatetime = y & "-" & m
		case "10"
			strdatetime = y & "/" & m
		case "11"
			strdatetime = right(y,2) & "-" &m & "-" & d & " " & h & ":" & mi
		case "12"
			strdatetime = right(y,2) & "-" &m & "-" & d
		case "13"
			strdatetime = m & "-" & d
		case "14"
			strdatetime = h & ":" & mi
		case else
			strdatetime = dateandtime
	end select
	formatdate = strdatetime
end function

'*************************************************
'函数名：gotTopic
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       strlen ----截取长度
'返回值：截取后的字符串
'*************************************************
function gotTopic(str,strlen)
	if str="" then
		gotTopic=""
		exit function
	end if
	dim l,t,c, i
	str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	for i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		if c>255 then
			t=t+2
		else
			t=t+1
		end if
		if t>=strlen then
			gotTopic=left(str,i) & "…"
			exit for
		else
			gotTopic=str
		end if
	next
	gotTopic=replace(replace(replace(replace(gotTopic," ","&nbsp;"),chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function

'输出信息
sub Rw( Str )
     if Trim( Str ) <>"" then Response.Write Str
end sub

Sub Rend()
	Response.end()
End Sub

Sub Rwl(Str)
	Rw Str&vbCrLf
End Sub

Sub Rws(str)
	Rw "<script>"&str&"</script>"
End Sub


'获取系统配置信息
function SysConfig(FiledName)
	RS_End
    if Application.contents(FiledName) <>"" then
        SysConfig=Application.contents(FiledName)
    else
		set RS=DB_CONN.EXECUTE("select * from [i_Sys_Config]")
        dim j:j=RS.Fields.Count
        for i=0 to (j-1)
            Application.Lock()
            Application.contents(RS.Fields(i).Name)=RS(RS.Fields(i).Name)
            Application.Unlock()
        next
		RS_End
        SysConfig=Application.contents(FiledName)
    end if
end function


'获取消费等级数组i_User_PaymentLevel
function GetPaymentLevelArr()
	RS_End
    if isarray(Application.contents("PaymentLevel_Arr")) then
        GetPaymentLevelArr=Application.contents("PaymentLevel_Arr")
    else
        dim MyArr
        Set RS=DB_CONN.EXECUTE("select * from [i_User_PaymentLevel]")
        dim Aj:Aj=RS.recordcount
        ReDim MyArr(Aj,3)
        for Li=0 to Aj-1
            MyArr(Li,0)=RS("i_User_PaymentLevel_ID")
            MyArr(Li,1)=RS("i_User_PaymentLevel_MinNum")
            MyArr(Li,2)=RS("i_User_PaymentLevel_MaxNum")
        RS.MoveNext
        next
        Application.Lock()
        Application.contents("PaymentLevel_Arr")=MyArr
        Application.Unlock()
        GetPaymentLevelArr=MyArr
    end if
	RS_End
end function

'根据消费额计算消费等级,返回等级ID
function PaymentLevel(ScoreNum)
	ScoreNum = CLng(ScoreNum)
    dim SMyArr,Re,Sj
    SMyArr=GetPaymentLevelArr
	Re=1
    Sj=0
    for Si=0 to ubound(SMyArr,1)
        if Sj=0 then
            if CLng(SMyArr(Si,1))<ScoreNum and CLng(SMyArr(Si,2))>ScoreNum then 
                Re=SMyArr(Si,0)
                j=1
            end if
        end if
    next
    PaymentLevel=Re
end function

'消费等级信息
function GetPaymentLevelInfo(LevelID,FiledName)
	RS_End
    LevelID=Cstr(LevelID)
    if Application.contents("PaymentLevel_"+LevelID+"_"+FiledName) <>"" then
        GetPaymentLevelInfo=Application.contents("PaymentLevel_"+LevelID+"_"+FiledName) 
    else
        set RS=DB_CONN.EXECUTE("select * from [i_User_PaymentLevel] where [i_User_PaymentLevel_ID]="&LevelID)
        dim Tj:Tj=RS.Fields.Count
        for Ti=0 to (Tj-1)
            Application.Lock()
            Application.contents("PaymentLevel_"+LevelID+"_"+RS.Fields(Ti).Name)=RS(RS.Fields(Ti).Name)
            Application.Unlock()
        next
        GetPaymentLevelInfo=RS(FiledName)
    end if
	RS_End
end function

'获取用户消费等级信息
function GetUserPaymentLevelInfo(n,f)
	'GetUserPaymentLevelInfo=GetPaymentLevelInfo(PaymentLevel(n),f)
	dim t_Rs
	set t_Rs=DB_CONN.EXECUTE("select b.* from [i_user_info] a join [i_User_PaymentLevel] b on b.[i_User_PaymentLevel_MaxNum]>a.[i_User_PayNum] and a.[i_User_PayNum]>=b.[i_User_PaymentLevel_MinNum] where a.[i_User_ID]="&session(Session_UserID_Arg))
	GetUserPaymentLevelInfo=t_Rs(f)
end function

'获取用户消费等级信息
function GetUserPaymentLevelInfoByID(n,f)
	'GetUserPaymentLevelInfo=GetPaymentLevelInfo(PaymentLevel(n),f)
	if IsNumeric(n) then
		dim UserPay_t_Rs
		set UserPay_t_Rs=DB_CONN.EXECUTE("select b.* from [i_user_info] a join [i_User_PaymentLevel] b on b.[i_User_PaymentLevel_MaxNum]>a.[i_User_PayNum] and a.[i_User_PayNum]>=b.[i_User_PaymentLevel_MinNum] where a.[i_User_ID]="&n)
		GetUserPaymentLevelInfoByID=UserPay_t_Rs(f)
	else
		GetUserPaymentLevelInfoByID=""
	end if
end function

'获取消费星图片
function GetUserPayStar(UID) 
	dim PayStar_RS,AllPayNum,Re
	set PayStar_RS = DB_CONN.EXECUTE("select sum([i_User_ConsumeRecord_PayNum]) as 'AllPayNum' from [i_User_ConsumeRecord] where [i_User_ConsumeRecord_UID]="&UID&" and [i_User_ConsumeRecord_Type]=0 and DATEDIFF(D,[i_User_ConsumeRecord_Time],getdate())<7")
	if IsNull(PayStar_RS("AllPayNum")) then  AllPayNum = 0 else AllPayNum = Clng(PayStar_RS("AllPayNum"))
	if AllPayNum>20000 then
		Re = "/i/v2/cssimg/s1.gif"
	end if
	if AllPayNum>50000 then 
		Re = "/i/v2/cssimg/s2.gif"
	end if
	if AllPayNum>100000 then 
		Re = "/i/v2/cssimg/s3.gif"
	end if
	if AllPayNum>200000 then 
		Re = "/i/v2/cssimg/s4.gif"
	end if
	if AllPayNum>500000 then 
		Re = "/i/v2/cssimg/s5.gif"
	end if
	if AllPayNum<20000 then 
		Re = "/images/pixel.gif"
	end if
	GetUserPayStar = Re
end function

'获取收入等级数组i_User_InComeLevel
function GetInComeLevelArr()
	RS_End
    if isarray(Application.contents("InComeLevel_Arr")) then
        GetInComeLevelArr=Application.contents("InComeLevel_Arr")
    else
        dim MyArr
        Set RS=DB_CONN.EXECUTE("select * from [i_User_InComeLevel]")
        dim Aj:Aj=RS.recordcount
        ReDim MyArr(Aj,3)
        for Li=0 to Aj-1
            MyArr(Li,0)=RS("i_User_InComeLevel_ID")
            MyArr(Li,1)=RS("i_User_InComeLevel_MinNum")
            MyArr(Li,2)=RS("i_User_InComeLevel_MaxNum")
        RS.MoveNext
        next
        Application.Lock()
        Application.contents("InComeLevel_Arr")=MyArr
        Application.Unlock()
        GetInComeLevelArr=MyArr
    end if
	RS_End
end function

'根据收入额计算消费等级,返回等级ID
function InComeLevel(ScoreNum)
	ScoreNum = CLng(ScoreNum)
    dim SMyArr,Re,Sj
    SMyArr=GetInComeLevelArr
	Re=1
    Sj=0
    for Si=0 to ubound(SMyArr,1)
        if Sj=0 then
            if CLng(SMyArr(Si,1))<ScoreNum and CLng(SMyArr(Si,2))>ScoreNum then 
                Re=SMyArr(Si,0)
                j=1
            end if
        end if
    next
    InComeLevel=Re
end function

'收入等级信息
function GetInComeLevelInfo(LevelID,FiledName)
	RS_End
    LevelID=Cstr(LevelID)
    if Application.contents("InComeLevel_"+LevelID+"_"+FiledName) <>"" then
        GetInComeLevelInfo=Application.contents("InComeLevel_"+LevelID+"_"+FiledName) 
    else
        set RS=DB_CONN.EXECUTE("select * from [i_User_InComeLevel] where [i_User_InComeLevel_ID]="&LevelID)
        dim Tj:Tj=RS.Fields.count
        for Ti=0 to (Tj-1)
            Application.Lock()
            Application.contents("InComeLevel_"+LevelID+"_"+RS.Fields(Ti).Name)=RS(RS.Fields(Ti).Name)
            Application.Unlock()
        next
        GetInComeLevelInfo=RS(FiledName)
    end if
	RS_End
end function

'获取用户收入等级信息
function GetUserInComeLevelInfo(n,f)
	'GetUserInComeLevelInfo=GetInComeLevelInfo(InComeLevel(n),f)
	dim t_Rs
	set t_Rs = DB_CONN.EXECUTE("select b.* from [i_user_info] a join [i_User_IncomeLevel] b on b.[i_User_IncomeLevel_MaxNum]>a.[i_User_IncomeNum] and a.[i_User_IncomeNum]>=b.[i_User_IncomeLevel_MinNum] where a.[i_User_ID]="&session(Session_UserID_Arg))
	GetUserInComeLevelInfo=t_Rs(f)
end function

'获取用户信息返回RS
function GUInfoRS()
	RS_End
    Set RS=DB_CONN.EXECUTE("select top 1 * from [i_User_Info] where [i_User_ID]="&session(Session_UserID_Arg))
	GUInfoRS=RS
end function

'获取用户信息
function GUInfo(FiledName)
    RS_End
    Set RS=DB_CONN.EXECUTE("select top 1 * from [i_User_Info] where [i_User_ID]="&session(Session_UserID_Arg))
    if RS.recordcount<1 then
        GUInfo=false
    else
        GUInfo=RS(FiledName)
    end if
	RS_End
end function

'获取指定用户信息
function tGUInfo(UID,FiledName)
    RS_End
    Set RS=DB_CONN.EXECUTE("select top 1 * from [i_User_Info] where [i_User_ID]="&UID)
    if RS.recordcount<1 then
        tGUInfo=false
    else
        tGUInfo=RS(FiledName)
    end if
	RS_End
end function

'获取指定用户信息
function GUInfoByID(n,f)
	if IsNumeric(n) then
		dim Userinfo_t_Rs
		set Userinfo_t_Rs=DB_CONN.EXECUTE("select top 1 * from [i_User_Info] where [i_User_ID]="&n)
		GUInfoByID=Userinfo_t_Rs(f)
	else
		GUInfoByID="游客"
	end if
end function

'获取用户等级信息返回RS
 function GUClassInfoRS()
	RS_End
    Set RS=DB_CONN.EXECUTE("select  b.* from [i_User_Info] a join [i_User_Class] b on a.[i_User_Class]=b.[i_User_Class_ID] where a.[i_User_ID]="&session(Session_UserID_Arg))
	GUClassInfoRS=RS
 end function

'获取用户等级信息
 function GUClassInfo(FiledName)
	RS_End
    Set RS=DB_CONN.EXECUTE("select  b.* from [i_User_Info] a join [i_User_Class] b on a.[i_User_Class]=b.[i_User_Class_ID] where a.[i_User_ID]="&session(Session_UserID_Arg))
    if RS.recordcount<1 then
        GUClassInfo=false
    else
        GUClassInfo=RS(FiledName)
    end if
	RS_End
 end function
 
 '获取消费等级信息返回RS
 function GPayClassInfoRS()
	RS_End
	dim PayClassRS
	Set PayClassRS=DB_CONN.EXECUTE("select b.* from [i_user_info] a join [i_User_PaymentLevel] b on b.[i_User_PaymentLevel_MaxNum]>a.[i_User_PayNum] and a.[i_User_PayNum]>=b.[i_User_PaymentLevel_MinNum] where a.[i_User_ID]="&session(Session_UserID_Arg))
	GPayClassInfoRS=PayClassRS
 end function
 
 '获取收入等级信息返回RS
 function GIncomeClassInfoRS()
	RS_End
	Set RS=DB_CONN.EXECUTE("select b.* from [i_user_info] a join [i_User_IncomeLevel] b on b.[i_User_IncomeLevel_MaxNum]>a.[i_User_IncomeNum] and a.[i_User_IncomeNum]>=b.[i_User_IncomeLevel_MinNum] where a.[i_User_ID]="&session(Session_UserID_Arg))
	GIncomeClassInfoRS=RS
 end function
 
 '获取用户列表Class信息
 function GetClassInfo(filed)
	if session(Session_UserID_Arg)="" then Exit Function
	RS_End
	Set RS=DB_CONN.EXECUTE("select b.* from [i_user_info] a join [i_User_Class] b on b.[i_User_Class_ID]=a.[i_User_Class] where a.[i_User_ID]="&session(Session_UserID_Arg))
	GetClassInfo=RS(filed)
	RS_End
 end function
 
 '获取用户列表Class信息
 function GetClassInfoByID(n,filed)
	if IsNumeric(n) then		
		dim UserClassRs
		Set UserClassRs=DB_CONN.EXECUTE("select b.* from [i_user_info] a join [i_User_Class] b on b.[i_User_Class_ID]=a.[i_User_Class] where a.[i_User_ID]="&n)
		GetClassInfoByID=UserClassRs(filed)
	else
		GetClassInfoByID=""
	end if
 end function
 
 '获取用户房间信息
 function GetUserRoomInfoByUserID(n,f)
	if IsNumeric(n) then	
		dim UserRoomRs
		Set UserRoomRs=DB_CONN.EXECUTE("select b.* from [i_user_info] a join [i_Sys_Room] b on b.[i_Sys_Room_AdminUserID]=a.[i_User_ID] where a.[i_User_ID]="&n)
		if UserRoomRs.recordcount>0 then
			GetUserRoomInfoByUserID=UserRoomRs(f)
		else
			GetUserRoomInfoByUserID=""
		end if
	else
		GetUserRoomInfoByUserID=""
	end if
 end function
 
 '获取礼物信息
 function GetGiftInfo(GID,filed)
	RS_End
	dim Re
	Set RS=DB_CONN.EXECUTE("select top 1 * from [i_User_Gift] where [i_User_Gift_ID]="&GID)
	if RS.recordcount>0 then
		GetGiftInfo=RS(filed)
	else
		GetGiftInfo=false
	end if
	RS_End
 end function
 
 '记录礼物赠送Log,并更新被赠送用户的收入
 function LogSnedGift(GUID,GiftID,GiftNum,GiftSumPrice)
	RS_End
	dim SendGiftRS
	set SendGiftRS = Server.CreateObject("ADODB.Recordset")
	SendGiftRS.Open "select top 1 * from [i_User_Gift_SendRecord]", DB_CONN , 1 , 3
	SendGiftRS.addnew()
		SendGiftRS("i_User_Gift_SendRecord_UID")=session(Session_UserID_Arg)
		SendGiftRS("i_User_Gift_SendRecord_GUID")=GUID
		SendGiftRS("i_User_Gift_SendRecord_GiftID")=GiftID
		SendGiftRS("i_User_Gift_SendRecord_GiftNum")=GiftNum
		SendGiftRS("i_User_Gift_SendRecord_GiftTotalPrice")=Clng(GiftSumPrice)
	SendGiftRS.Update()
	SendGiftRS.Close()
	dim TRS
	set TRS = Server.CreateObject("ADODB.Recordset")
	TRS.Open "select top 1 * from [i_User_Info] where [i_User_ID]="&GUID, DB_CONN , 1 , 3
		if TRS.recordcount<1 then Exit Function
		dim tincome:tincome=Clng(TRS("i_User_IncomeNum"))
		dim tmoney:tmoney=Clng(TRS("i_User_Money"))
		TRS("i_User_IncomeNum")=tincome+Clng(GiftSumPrice)
		TRS("i_User_Money")=tmoney+Clng(GiftSumPrice)*CDbl(SysConfig("i_Sys_Config_ExtractionPercent"))
	TRS.Update()
	TRS.Close()
 end function
 
 '记录用户消费Log
 function RecordConsume(PayNum,InComeNum,Note,UID)
	RS_End
	dim ConsumeRS
	set ConsumeRS = Server.CreateObject("ADODB.Recordset")
	ConsumeRS.Open "select top 1 * from [i_User_ConsumeRecord]", DB_CONN , 1 , 3
	ConsumeRS.addnew()
	ConsumeRS("i_User_ConsumeRecord_UID")=UID
	ConsumeRS("i_User_ConsumeRecord_PayNum")=PayNum
	ConsumeRS("i_User_ConsumeRecord_InComeNum")=InComeNum
	ConsumeRS("i_User_ConsumeRecord_Note")=Note
	ConsumeRS("i_User_ConsumeRecord_Store")=Clng(tGUInfo(UID,"i_User_Money"))
	ConsumeRS.Update()
	ConsumeRS.Close()
 end function
 
  '记录用户充值Log
 function RecordConsume2(PayNum,InComeNum,Note,UID)
	RS_End
	dim ConsumeRS
	set ConsumeRS = Server.CreateObject("ADODB.Recordset")
	ConsumeRS.Open "select top 1 * from [i_User_ConsumeRecord]", DB_CONN , 1 , 3
	ConsumeRS.addnew()
	ConsumeRS("i_User_ConsumeRecord_UID")=UID
	ConsumeRS("i_User_ConsumeRecord_Type")=1
	ConsumeRS("i_User_ConsumeRecord_PayNum")=PayNum
	ConsumeRS("i_User_ConsumeRecord_InComeNum")=InComeNum
	ConsumeRS("i_User_ConsumeRecord_Note")=Note
	ConsumeRS("i_User_ConsumeRecord_Store")=Clng(tGUInfo(UID,"i_User_Money"))
	ConsumeRS.Update()
	ConsumeRS.Close()
 end function
'--------------------------------------------------------------------

'正则验证
function ValidReg(Str,RegStr)
    Dim reg 
    Set reg = new regexp 
    reg.ignorecase=true 
    reg.global=true
    reg.pattern = RegStr 
    ValidReg = reg.test(Trim(Str)) 
    Set reg = Nothing 
end function

Function vbsEscape(p_Message) 
	Dim m_char,m_asc,m_hex '字符，ASC码，16进制ASCII码
	Dim m_temp '临时字符
	Dim a_arc() 'ASC码数组
	Dim i
	ReDim a_arc(Len(p_Message))
	For i = 0 To Len(p_Message) -1
		m_char = Mid(p_Message,i+1,1)
		m_asc = AscW(m_char)
		If m_asc < 255 Then
		  If (m_char = "*") Or(m_char = "+") _
			Or(m_char >= "-" And m_char <= "9" ) _
			Or(m_char >= "@" And m_char <= "Z" ) _
			Or(m_char = "_") _
			Or(m_char >= "a" And m_char <= "z" ) Then
	   a_arc(i) = m_char
	   Else
	   m_temp = Hex(m_asc)
	   If Len(m_temp) = 1 Then
		 a_arc(i) = "%0" & m_temp
	   ElseIf Len(m_temp) = 2 Then
		 a_arc(i) = "%" & m_temp
	   Else
		 a_arc(i) = "%u" & m_temp
	   End If
	   End If
		Else
			m_temp = Hex(m_asc)
		 If Len(m_temp) = 1 Then
		   a_arc(i) = "%u000" & m_temp
		 ElseIf Len(m_temp) = 2 Then
		   a_arc(i) = "%u00" & m_temp
		 ElseIf Len(m_temp) = 3 Then
		   a_arc(i) = "%u0" & m_temp
		 Else
			  a_arc(i) = "%u" & m_temp
			End If
		End If
	Next
	vbsEscape = Join(a_arc,"")
End Function

Function vbsUnEscape(str) 
    dim i,s,c 
    s="" 
	if isnull(str) then str=""
    For i=1 to Len(str) 
        c=Mid(str,i,1) 
        If Mid(str,i,2)="%u" and i<=Len(str)-5 Then 
            If IsNumeric("&H" & Mid(str,i+2,4)) Then 
                s = s & CHRW(CInt("&H" & Mid(str,i+2,4))) 
                i = i+5 
            Else 
                s = s & c 
            End If 
        ElseIf c="%" and i<=Len(str)-2 Then 
            If IsNumeric("&H" & Mid(str,i+1,2)) Then 
                s = s & CHRW(CInt("&H" & Mid(str,i+1,2))) 
                i = i+2 
            Else 
                s = s & c 
            End If 
        Else 
            s = s & c 
        End If 
    Next 
    vbsUnEscape = vbsUnEscape2(s) 
End Function


Function vbsUnEscape2(str) 
    dim i,s,c 
    s="" 
	if isnull(str) then str=""
    For i=1 to Len(str) 
        c=Mid(str,i,1) 
        If Mid(str,i,2)="%u" and i<=Len(str)-5 Then 
            If IsNumeric("&H" & Mid(str,i+2,4)) Then 
                s = s & CHRW(CInt("&H" & Mid(str,i+2,4))) 
                i = i+5 
            Else 
                s = s & c 
            End If 
        ElseIf c="%" and i<=Len(str)-2 Then 
            If IsNumeric("&H" & Mid(str,i+1,2)) Then 
                s = s & CHRW(CInt("&H" & Mid(str,i+1,2))) 
                i = i+2 
            Else 
                s = s & c 
            End If 
        Else 
            s = s & c 
        End If 
    Next 
    vbsUnEscape2 = s 
End Function

Function ClearHtml(Content)   
	  Content=Zxj_ReplaceHtml("&#[^>]*;",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?marquee[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?object[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?param[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?embed[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?table[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml(" ","",Content)   
	  Content=Zxj_ReplaceHtml("</?tr[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?th[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?p[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?a[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?img[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?tbody[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?li[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?span[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?div[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?th[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?td[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?script[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("(javascript|jscript|vbscript|vbs):",   "",   Content)   
	  Content=Zxj_ReplaceHtml("on(mouse|exit|error|click|key)",   "",   Content)   
	  Content=Zxj_ReplaceHtml("<\\?xml[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("<\/?[a-z]+:[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?font[^>]*>",   "",   Content)   
	  Content=Zxj_ReplaceHtml("</?b[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?u[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?i[^>]*>","",Content)   
	  Content=Zxj_ReplaceHtml("</?strong[^>]*>","",Content)   
	  ClearHtml=Content   
End Function   

Function Text2Html(Str1)
	If isNULL(Str1) Then
	Text2Html=""
	Exit Function
	End If
	Str1=Replace(Str1,"&","&amp;")
	Str1=Replace(Str1," <","&lt;")
	Str1=Replace(Str1,">","&gt;")
	Str1=Replace(Str1,VBcrlf," <br>")
	Str1=Replace(Str1,chr(34),"&quot;")
	Str1=Replace(Str1,chr(9),"&nbsp;&nbsp;&nbsp;")
	Str1=Replace(Str1," ","&nbsp;")
	Text2Html=Str1
End Function 

Function Zxj_ReplaceHtml(patrn,   strng,content)   
	  IF   IsNull(content)   Then   
	  content=""   
	  End   IF   
	  Set   regEx   =   New   RegExp
	  regEx.Pattern   =   patrn 
	  regEx.IgnoreCase   =   true         
	  regEx.Global   =   True 
	  Zxj_ReplaceHtml=regEx.Replace(content,strng) 
End Function
  
Function TimeDiff(sBegin,sEnd)
   Dim iHourB, iMinuteB, iSecondB
   Dim iHourE, iMinuteE, iSecondE
   Dim dTimeB, dTimeE, dTimeDiff
   Dim iHour, iMinute, iSecond
   daydd=DateDiff("y",sBegin,sEnd)
  
	sBeginTemp=split(sBegin," ")
	sBeginTemptime=split(sBeginTemp(1),":")
	iHourB = clng(sBeginTemptime(0))
	iMinuteB = clng(sBeginTemptime(1))
	iSecondB = clng(sBeginTemptime(2))

	ssEndTemp=split(sEnd," ")
	ssEndTemptime=split(ssEndTemp(1),":")
	iHourE = clng(ssEndTemptime(0))
	iMinuteE = clng(ssEndTemptime(1))
	iSecondE = clng(ssEndTemptime(2))
	dTimeB = iHourB * 3600 + iMinuteB * 60 + iSecondB
	dTimeE = iHourE * 3600 + iMinuteE * 60 + iSecondE
	if daydd>0  then
          dTimeDiff = dTimeE - dTimeB
    elseif daydd=0 then
          if dTimeE > dTimeB then    
                   dTimeDiff = dTimeE - dTimeB
          else
                   dTimeDiff = dTimeB - dTimeE
           end if
     else
            dTimeDiff = dTimeB - dTimeE
     end if
	iHour = Int(dTimeDiff / 3600)
	dTimeDiff = dTimeDiff - iHour * 3600
	iMinute = Int(dTimeDiff / 60)
	dTimeDiff = dTimeDiff - iMinute * 60
	iSecond = Int(dTimeDiff)

	TimeDiff = abs(iHour) & "小时" & iMinute & "分钟" 
End Function 

function CreatFile(path,content)
	Rw content
	dim objStream,strFile
	strFile=server.mappath(path)
	Set objStream = Server.CreateObject("ADODB.Stream")
	With objStream
        .Type = 2
        .Open
        .Charset = "utf-8"
        .Position = objStream.Size
        .WriteText = content
        .SaveToFile strFile,2
        .Close
    End With
    Set objStream = Nothing
end function

function CheckStr(str)
	dim sqlstr
	sqlstr = split("'|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare","|")
	For t=0 To Ubound(sqlstr)
		if instr(str,sqlstr(t))>0 Then
		RWS "alert('请不要在参数中包含非法字符尝试注入！');history.back(-1);"
		REND
		end if
	next
	CheckStr = str
end function 

function unicode(str)
dim i,j,c,i1,i2,u,fs,f,p
unicode=""
p=""
for i=1 to len(str)
c=mid(str,i,1)
j=ascw(c)
if j<0 then
j=j+65536
end if
if j>=0 and j<=128 then
if p="c" then
unicode=" "&unicode
p="e"
end if
unicode=unicode&c
else
if p="e" then
unicode=unicode&" "
p="c"
end if
unicode=unicode&"&#"&j&";"
end if
next
end function

function cutline(str,linelen)
dim i,j,c,k
cutline=""
j=0
for i=1 to len(str)
c=mid(str,i,1)
if asc(c)<0 or asc(c)>127 then
k=2
else
if asc(c)<32 then
k=0
if asc(c)=13 then
j=0
cutline=cutline+"<br/>"+c
c=""
end if
else
k=1
end if
end if
j=j+k
if j>linelen*2 then
cutline=cutline+"<br/>"+vbCrlf+c
j=k
else
cutline=cutline+c
end if
next
end function

function convertsymbol(sStr)
dim i,c
convertsymbol=""
for i=1 to len(sStr)
c=mid(sStr,i,1)
if c=">" then
convertsymbol=convertsymbol & ">"
elseif c="<" then
convertsymbol=convertsymbol & "<"
elseif c="’" then
convertsymbol=convertsymbol & "&apos;"
elseif c="""" then
convertsymbol=convertsymbol & """"
elseif c="&" then
convertsymbol=convertsymbol & "&"
elseif c="$" then
convertsymbol=convertsymbol & "$$"
else
convertsymbol=convertsymbol & c
end if
next
end function

function convertstring(sStr)
dim strtemp,asctemp,c
strtemp=""
for i=1 to len(sStr)
c=mid(sStr,i,1)
asctemp=ascw(c)
if (asctemp>47 and asctemp<58) or (asctemp>64 and asctemp<91) or (asctemp>96 and asctemp<123) then
strtemp=strtemp & c
end if
next
convertstring=Lcase(strtemp)
end function 
%>


