bbslib.asp

宁波娱乐在线城市,丰富的内容版块

   'Query.Open sql,Database
   'Application("ZXFZ") = Query("VAL")
   'Query.Close
   'set Query = nothing
   '在线峰值
    
    Application("CHAT_ID") = 0
    Application("GCHAT_ID") = 0

    set Database = nothing    
end Sub  

function  Fun100(cmd)
    Dim sql,Query
    
    set Query = Server.CreateObject("ADODB.Recordset")
    sql = "select top 1 * from HY where NC='"&mid(GetPart(cmd,1),1,20)&"'"
    Query.Open sql,Database
    if Query.Bof then
        Fun100 = "1|用户不存在，请重新输入！"
        Query.Close
        set Query = nothing
        exit function
    end if
    
    if trim(Query("MM")) <> mid(GetPart(cmd,2),1,10) then
        Fun100 = "1|密码输入有误，请重新输入！"
        Query.Close
        set Query = nothing
        exit function
    end if

    Response.Cookies("ID") = Query("ID")
    Response.Cookies("ID").Expires=date+3650
	Response.Cookies("NC") = Query("NC")
	Response.Cookies("NC").Expires=date+3650
    Response.Cookies("IP") = Request.ServerVariables("REMOTE_ADDR")
    Response.Cookies("JS") = Now()
    Response.Cookies("SCDL") = ConvertDateTime(Query("SCDL"))
    
    Query.Close
    set Query = nothing
	
    
    set Query = Server.CreateObject("ADODB.Recordset")
    sql = "select top 1 NC from LMJZ where ID=0 and NC='"&GetPart(cmd,1)&"'"
    Query.Open sql,Database
    if not Query.Bof then
           Fun100 = "1|对不起，您目前正被禁闭，无法进入社区！"
           Query.Close
           set Query = nothing
           exit function
    end if    
    Query.Close
    set Query = nothing
    
    
    Database.Execute("delete from ZXRY where ID="&Request.Cookies("ID")&" or (XM='"&Request.Cookies("NC")&"' and IP='"&Request.Cookies("IP")&"')")
    Database.Execute("insert into ZXRY (ID,XM,DLSJ,WZ,IP,HDSJ,YS) values ("&Request.Cookies("ID")&",'"&Request.Cookies("NC")&"','"&ConvertDateTime(Now())&"','社区首页','"&Request.Cookies("IP")&"','"&ConvertDateTime(Now())&"','"&Request.Cookies("YS")&"')")
    if DateDiff("d",Request.Cookies("SCDL"),now()) >= 1 then
        Database.Execute("update HY set TL=100 where NC='"&GetPart(cmd,1)&"'")
    end if    
    Database.Execute("update HY set SCDL='"&ConvertDateTime(Now())&"' where NC='"&GetPart(cmd,1)&"'")

    'set Query = Server.CreateObject("ADODB.Recordset")
    'sql = "select VAL from INI where TYPE='FWCS'"
    'Query.Open sql,Database
    'FWCS = Int(Query("VAL"))+1
    'Query.Close
    'set Query = nothing
    
    'Database.Execute("update INI set VAL='"&FWCS&"' where TYPE='FWCS'")

    if SQLServer = "0" then
        Database.Execute("delete from ZXRY where HDSJ <  DATEADD('n',-10,'"&ConvertDateTime(now())&"')")
    else   
        Database.Execute("delete from ZXRY where DATEDIFF(mi,HDSJ,'"&ConvertDateTime(Now())&"') > 2")
        Database.Execute("delete from C_USER where DATEDIFF(mi,SJ,'"&ConvertDateTime(Now())&"') > 2")
        Database.Execute("delete from G_USER where DATEDIFF(mi,SJ,'"&ConvertDateTime(Now())&"') > 2")
    end if

    
    Fun100 = "0"
end function    

function  Fun101(cmd)
    Dim Query,sql,FWCS

    Response.Cookies("ID") = 0
	Response.Cookies("NC") = "访客"
    Response.Cookies("IP") = Request.ServerVariables("REMOTE_ADDR")
	Response.Cookies("YS") = ""
    
    Database.Execute("insert into ZXRY (ID,XM,DLSJ,WZ,IP,HDSJ,YS) values ("&Request.Cookies("ID")&",'"&Request.Cookies("NC")&"','"&ConvertDateTime(Now())&"','社区首页','"&Request.Cookies("IP")&"','"&ConvertDateTime(Now())&"','"&Request.Cookies("YS")&"')")
    
	'set Query = Server.CreateObject("ADODB.Recordset")
    'sql = "select VAL from INI where TYPE='FWCS'"
    'Query.Open sql,Database
    'FWCS = Int(Query("VAL"))+1
    'Query.Close
    'set Query = nothing
    'Database.Execute("update INI set VAL='"&FWCS&"' where TYPE='FWCS'")

    if SQLServer = "0" then
        Database.Execute("delete from ZXRY where HDSJ <  DATEADD('n',-10,'"&ConvertDateTime(now())&"')")
    else   
        Database.Execute("delete from ZXRY where DATEDIFF(mi,HDSJ,'"&ConvertDateTime(Now())&"') > 2")
        Database.Execute("delete from C_USER where DATEDIFF(mi,SJ,'"&ConvertDateTime(Now())&"') > 2")
        Database.Execute("delete from G_USER where DATEDIFF(mi,SJ,'"&ConvertDateTime(Now())&"') > 2")
    end if
    
    Fun101 = "0"
end function    

function Fun102(cmd)
    Dim Query,sql
    
    Fun102 = "0"
    if Request.Cookies("NC")="" or Request.Cookies("NC")="访客" then exit function  
    set Query = Server.CreateObject("ADODB.Recordset")
    sql = "select top 1 ID from ZXRY where ID="&Request.Cookies("ID")
    Query.Open sql,Database
    if Query.Bof then
        Query.Close
        set Query = nothing
        Database.Execute("insert into ZXRY (ID,XM,DLSJ,WZ,IP,HDSJ) values ("&Request.Cookies("ID")&",'"&Request.Cookies("NC")&"','"&ConvertDateTime(Now())&"','"&GetPart(cmd,1)&"','"&Request.Cookies("IP")&"','"&ConvertDateTime(Now())&"')") 
    else
        Query.Close
        set Query = nothing    
        Database.Execute("update ZXRY set WZ='"&GetPart(cmd,1)&"' where ID="&Request.Cookies("ID"))
    end if    
end function


function  CheckName(name)
    if IsNumeric(name) then
        CheckName = "1|对不起，您不能用数字做昵称！"
        exit function
    end if
    
    
    if instr(name," ") or instr(name,"　")  then
        CheckName = "1|对不起，请不要在昵称中使用空格！"
        exit function
    end if    
    
    if instr(name,"&") or instr(name,"+") or instr(name,"'") or instr(name,Chr(34))  then
        CheckName = "1|对不起，请不要在昵称中使用非法字符！"
        exit function
    end if    
    
    
    CheckName = "0"
end function    
        
function Fun103(cmd)
    Dim Query,sql
  
    Fun103 = CheckName(GetPart(cmd,1))
    if GetPart(Fun103,1) = "1" then
        exit function
    end if     
    
    set Query = Server.CreateObject("ADODB.Recordset")
    sql = "select VAL from INI where TYPE='FILTER'"
    Query.Open sql,Database
    do while (not Query.Bof) and (not Query.Eof)
        if InStr(LCase(GetPart(cmd,1)),LCase(trim(Query("VAL")))) > 0 then
            Fun103 = "1|对不起，您不可以使用这个名字！"
            Query.Close
            set Query = nothing
            exit function
        end if
        Query.MoveNext    
    loop    
    Query.Close
    set Query = nothing
  
    set Query = Server.CreateObject("ADODB.Recordset")
    sql = "select top 1 ID from HY where NC='"&GetPart(cmd,1)&"'"
    Query.Open sql,Database
    if not Query.BOF then
        Fun103 = "1|"&"对不起，该昵称已被别人注册，请选择其他名字！"
    else
        Query.Close
        set Query = nothing
        set Query = Server.CreateObject("ADODB.Recordset")
        sql = "select top 1 VAL from INI where TYPE='附加功能' and NAME='初始金钱'"
        Query.Open sql,Database
        Database.Execute("insert into HY (NC,XB,MM,EMAIL,CS,LY,ZY,AH,QM,TX,GRZY,ICQ,GRJS,ZSXM,SFZ,LXDH,ZZ,FTS,HFS,JYZ,ML,TL,JQ,ZT,SCDL,ZCSJ) values "&_
                         "('"&midb(GetPart(cmd,1),1,100)&"',"&GetPart(cmd,2)&",'"&midb(GetPart(cmd,3),1,20)&"','"&midb(GetPart(cmd,4),1,100)&"','"&GetPart(cmd,5)&"','"&midb(GetPart(cmd,6),1,100)&"','"&_
                         midb(GetPart(cmd,7),1,100)&"','"&midb(GetPart(cmd,8),1,100)&"','"&midb(GetPart(cmd,9),1,500)&"','"&GetPart(cmd,10)&"','"&midb(GetPart(cmd,11),1,100)&"','"&midb(GetPart(cmd,12),1,100)&"','"&_
                         midb(GetPart(cmd,13),1,500)&"','"&midb(GetPart(cmd,14),1,100)&"','"&midb(GetPart(cmd,15),1,100)&"','"&midb(GetPart(cmd,16),1,100)&"','"&midb(GetPart(cmd,17),1,200)&"',0,0,0,0,100,"&Query("VAL")&",0,'"&ConvertDateTime(Now())&"','"&ConvertDateTime(Now())&"')")
        Query.Close
        set Query = nothing
        set Query = Server.CreateObject("ADODB.Recordset")
        sql = "select top 1 ID from HY where NC='"&Application("NC")&"'"
        Query.Open sql,Database
        if REGISTMESSAGE <> "" then
            Database.Execute("insert into LY (NC,ID,NR,ZT,SJ,LB) values ('"&GetPart(cmd,1)&"',"&Query("ID")&",'"&FilterStr(REGISTMESSAGE)&"',0,'"&ConvertDateTime(Now())&"',0)") 
        end if    
        Fun103 = "0"
    end if
    Query.Close
    set Query = nothing
    
end function                         
                         
function Fun104(cmd)
    Dim Query,sql
    
    set Query = Server.CreateObject("ADODB.Recordset")
    sql = "select top 1 NC,XB,EMAIL,CS,LY,ZY,AH,TX,GRZY,ICQ,MM,GRJS,ZCSJ,QM,ZSXM,SFZ,LXDH,ZZ,SCDL,FTS,HFS,JYZ,ML,TL,JQ,MarryWith,HavePhoto from HY where NC='"&GetPart(cmd,1)&"'"
    Query.Open sql,Database
    if Query.Bof then
        Fun104 = "1|对不起，该会员不存在！"
    else
        Fun104 = "0|"&trim(Query("NC"))&"|"&Query("XB")&"|"&trim(Query("EMAIL"))&"|"&trim(Query("CS"))&"|"&trim(Query("LY"))&"|"&trim(Query("ZY"))&"|"&Query("AH")&"|"&Query("TX")&"|"&Query("GRZY")&"|"&_
                 trim(Query("ICQ"))&"|"&trim(Query("GRJS"))&"|"&trim(Query("QM"))&"|"&trim(Query("ZSXM"))&"|"&trim(Query("SFZ"))&"|"&trim(Query("LXDH"))&"|"&trim(Query("ZZ"))&"|"&trim(Query("MM"))&"|"&_
                 left(ConvertDateTime(Query("ZCSJ")),instr(ConvertDateTime(Query("ZCSJ"))," "))&"|"&ConvertDateTime(Query("SCDL"))&"|"&_
                 Query("FTS")&"|"&Query("HFS")&"|"&Query("JYZ")&"|"&Query("ML")&"|"&Query("TL")&"|"&Query("JQ")&"|"&Query("MarryWith")&"|"&Query("HavePhoto")
    end if
    Query.Close
    set Query = nothing
end function   


function Fun1044(cmd)
    Dim Query,sql
    
    set Query = Server.CreateObject("ADODB.Recordset")
    sql = "select top 1 NC,TX,ZY,JYZ,ML,JQ,MarryWith,HavePhoto,QM from HY where NC='"&GetPart(cmd,1)&"'"
    Query.Open sql,Database
    if Query.Bof then
        Fun1044 = "1|对不起，该会员不存在！"
    else
        Fun1044 = "0|"&trim(Query("NC"))&"|"&Query("TX")&"|"&trim(Query("ZY"))&"|"&Query("JYZ")&"|"&Query("ML")&"|"&Query("JQ")&"|"&Query("MarryWith")&"|"&Query("HavePhoto")&"|"&Query("QM")
                         
    end if
    Query.Close
    set Query = nothing
end function


function Fun105(cmd)
    if Request.Cookies("NC")="" or Request.Cookies("NC")="访客" then
        Fun105 = "1|对不起，您不是注册会员！"
        exit function
    end if
   
	Database.Execute("update HY set XB="&GetPart(cmd,2)&",MM='"&midb(GetPart(cmd,3),1,20)&"',EMAIL='"&midb(GetPart(cmd,4),1,100)&"',CS='"&GetPart(cmd,5)&"',LY='"&midb(GetPart(cmd,6),1,100)&"',ZY='"&_
                      midb(GetPart(cmd,7),1,100)&"',AH='"&midb(GetPart(cmd,8),1,100)&"',QM='"&midb(GetPart(cmd,9),1,500)&"',TX='"&GetPart(cmd,10)&"',GRZY='"&midb(GetPart(cmd,11),1,100)&"',ICQ='"&_
                      midb(GetPart(cmd,12),1,100)&"',GRJS='"&midb(GetPart(cmd,13),1,500)&"',ZSXM='"&midb(GetPart(cmd,14),1,100)&"',SFZ='"&midb(GetPart(cmd,15),1,100)&"',LXDH='"&midb(GetPart(cmd,16),1,100)&"',ZZ='"&midb(GetPart(cmd,17),1,200)&"' where NC='"&midb(GetPart(cmd,1),1,100)&"'")


    Fun105 = "0"
end function                          
                             
function  Fun106(cmd)
     Dim Query,sql

    if SQLServer = "0" then
        Database.Execute("delete from ZXRY where HDSJ <  DATEADD('n',-10,'"&ConvertDateTime(now())&"')")
    else   
        Database.Execute("delete from ZXRY where DATEDIFF(mi,HDSJ,'"&ConvertDateTime(Now())&"') > 2")
    end if

    'if Request.Cookies("NC")="" or Request.Cookies("NC")="访客" then 
    '    Fun106 = "1|请重新登录！"
    '    exit function
    'end if    
    set Query = Server.CreateObject("ADODB.Recordset")
    sql = "select top 1 ID from ZXRY where ID="&Request.Cookies("ID")
    Query.Open sql,Database
    if Query.Bof then
        Database.Execute("insert into ZXRY (ID,XM,DLSJ,WZ,IP,HDSJ,YS) values ("&Request.Cookies("ID")&",'"&Request.Cookies("NC")&"','"&ConvertDateTime(Now())&"','社区首页','"&Request.Cookies("IP")&"','"&ConvertDateTime(Now())&"','"&Request.Cookies("YS")&"')")
    else        
        Database.Execute("update ZXRY set HDSJ='"&ConvertDateTime(Now())&"',YS='"&Request.Cookies("YS")&"' where ID="&Request.Cookies("ID"))
    end if 
    Query.Close
    set Query = nothing
    
    'if Request.Cookies("NC")="" or Request.Cookies("NC")="访客" then
    '    set Query = Server.CreateObject("ADODB.Recordset")
    '    sql = "select COUNT(ID) AS ZXSL from ZXRY"
    '    Query.Open sql,Database
    '    Fun106 = "0|"&Query("ZXSL")&"|访客|0|0"
    'else
    
		'if Datediff("n",Request.Cookies("JS"),Now()) >= 10 then
            'Response.Cookies("JS") = Now()
            'Database.Execute("update HY set JYZ=JYZ+"&Application("TLJY")&" where ID="&Request.Cookies("ID"))
            'Database.Execute("update HY set ML=ML+5 where ID="&Request.Cookies("ID")&" and ML <= "&Application("FTZSML"))
            'Database.Execute("update HY set TL=TL+1 where ID="&Request.Cookies("ID")&" and TL<100")
        'end if    
        'Database.Execute("update HY set JYZ=JYZ+5 where NC='"&Request.Cookies("NC")&"'")
		set Query = Server.CreateObject("ADODB.Recordset")
        sql = "select (select COUNT(XM) from ZXRY) AS ZXSL ,(select COUNT(ZXRY.XM) from ZXRY,FRIEND where ZXRY.XM=FRIEND.XM and FRIEND.ID="&Request.Cookies("ID")&") AS HYSL ,(select COUNT(XH) from LY where ZT=0 and NC='"&Request.Cookies("NC")&"') AS XLY,JYZ,ML,TL from HY where ID="&Request.Cookies("ID")
        Query.Open sql,Database
        Fun106 = "0|"&Query("ZXSL")&"|"&GetClass(Query("JYZ"),Query("ML"))&"|"&Query("HYSL")&"|"&Query("XLY")&"|"&Query("JYZ")&"|"&Query("TL") 
    
    'if Int(Query("ZXSL")) > Int(Application("ZXFZ")) then
    '    Application.Lock
    '    Application("ZXFZ") = Query("ZXSL")
    '    Application.UnLock
    '    Database.Execute("update INI set NAME='"&ConvertDateTime(now())&"',VAL='"&Application("ZXFZ")&"' where TYPE='在线峰值'")
    'end if    
    Query.Close
    set Query = nothing
end function    
    
function Fun107(cmd)
    Dim Query,sql

    if (Request.Cookies("NC")="" or Request.Cookies("NC")="访客") or (UCase(Request.Cookies("NC")) <> UCase(Application("NC"))) then
        Fun107 = "1|您没有禁闭该人的权限！"
        exit function
    end if
    
    if (UCase(Application("NC")) = UCase(GetPart(cmd,1))) then
        Fun107 = "1|您不可以禁闭系统管理员！"
        exit function
    end if    
    
    
    set Query = Server.CreateObject("ADODB.Recordset")
    sql = "select top 1 NC from LMJZ where ID=0 and NC='"&GetPart(cmd,1)&"'"
    Query.Open sql,Database
    if not Query.Bof then
        Fun107 = "1|对不起，该人已处于禁闭状态！"
    else
        Database.Execute("insert into LMJZ (ID,NC,SJ) values (0,'"&GetPart(cmd,1)&"','"&ConvertDateTime(Now())&"')")    
        Database.Execute("update HY set ML=ML-500 where NC='"&GetPart(cmd,1)&"'")
        Fun107 = "0"
    end if        
    Query.Close
    set Query = nothing
end function        
    
function  Fun108(cmd)
    Dim Query,sql
    
    if Request.Cookies("NC")="" or Request.Cookies("NC")="访客" then
        Fun108 = "1|对不起，您没有该权限！"
        exit function
    end if
    
    if UCase(Request.Cookies("NC")) = UCase(Application("NC")) then
        Fun108 = Fun107(GetPart(cmd,2))
        exit function
    end if    
    
    if UCase(GetPart(cmd,2)) = UCase(Application("NC")) then
        Fun108 = "1|对不起，您不能禁止管理员！"
        exit function
    end if