<%
const dim_11_len=73
const dim_12_len=60

class class_joekoe_cms
  public web_vt,web_name,web_url,web_path,web_email,web_urls,web_dir,web_cookies,web_skin,web_dir_skin,news_skin,art_skin,web_upload,web_unit,web_health,now_time,today_time,timer_start,pro_edition,num_rs,connstr
  public js_tim,js_mod,isconn,ishealth
  function exec(esql,etype)
    if isconn=false then call conn_open()
    'response.write vbcrlf&"//<br>"&esql
    select case etype
    case 0
      conn.execute(esql)
    case 1
      set exec=conn.execute(esql)
    end select
    num_rs=num_rs+1
  end function
  
  sub conn_open()
    On Error Resume Next
    set conn=server.createobject("adodb.connection")
    set rs=server.createobject("adodb.recordset")
    conn.open connstr
	If err then
		err.clear
		Set conn = nothing
		response.write "数据库连接出错，请检查连接字串。"
		response.End
	End If
    isconn=true
  end sub

  function popedom_p(popedom_var,popedom_n)
    if cint(popedom_n)>len(popedom_var) or len(popedom_var)<>50 then
      popedom_p=0
      exit function
    end if
    popedom_p=int(mid(popedom_var,popedom_n,1))
  end function

  '-------------------------------------地址处理--------------------------------------
  function url_true(puu,pus)
    dim pupload,pu
    pupload=puu
    pu=pus
    if instr(1,pu,"://")<>0 then
      url_true=pu
    else
      if pupload="" then pupload=web_upload
      if right(pupload,1)<>"/" then pupload=pupload&"/"
      url_true=pupload&pu
    end if
  end function

  function own_http()
    dim ssort
    ssort=trim(request.servervariables("server_port"))
    own_http="http://"&trim(request.servervariables("server_name"))
    if ssort<>"80" then own_http=own_http&":"&ssort
    if right(own_http,1)<>"/" then own_http=own_http&"/"
  end function
  
  sub own_dir()
    dim path_info,now_dir,ndd
    path_info=request.servervariables("path_info")
    now_dir=left(path_info,instrrev(path_info,"/"))
    'web_dir=now_dir
    ndd=own_http()
    web_urls=left(ndd,len(ndd)-1)&now_dir
  end sub

  '-----------------------------------时间格式处理------------------------------------
  function time_type(tvar,tt)
    dim ttt,d_year,d_month,d_day,d_hour,d_minute,d_second
    ttt=tvar
    if ttt="" or isnull(ttt) then ttt=now_time
    if not(isdate(ttt)) then
      time_type=""
      exit function
    end if
    d_year=year(ttt)
    d_month=month(ttt)
    if len(d_month)<2 then d_month="0"&d_month
    d_day=day(ttt)
    if len(d_day)<2 then d_day="0"&d_day
    d_hour=hour(ttt)
    if len(d_hour)<2 then d_hour="0"&d_hour
    d_minute=minute(ttt)
    if len(d_minute)<2 then d_minute="0"&d_minute
    d_second=second(ttt)
    if len(d_second)<2 then d_second="0"&d_second
    select case tt
    case 1	'2000-10-10 23:45:45
      time_type=d_year&"-"&d_month&"-"&d_day&" "&d_hour&":"&d_minute&":"&d_second
    case 11	'20001010234545
      time_type=d_year&d_month&d_day&d_hour&d_minute&d_second
    case 2	'年(4)-月-日 时:分:秒
      time_type=d_year&"年"&d_month&"月"&d_day&"日 "&d_hour&"时"&d_minute&"分"&d_second&"秒"
    case 3	'10-10 23:45
      time_type=d_month&"-"&d_day&" "&d_hour&":"&d_minute
    case 4	'2003-10-10
      time_type=d_year&"-"&d_month&"-"&d_day
    case 5	'2003年10月10日
      time_type=d_year&"年"&d_month&"月"&d_day&"日"
    case 6      '200310 
      time_type=d_year&d_month
    case 10	'10-10
      time_type=d_month&"-"&d_day
    case else
      time_type=ttt
    end select
  end function
  
  '-------------------------------------整数处理--------------------------------------
  function int_true(nvar)
    int_true=true
    if not(isnumeric(nvar)) or instr(nvar,".")>0 then
      int_true=false
    end if
  end function
  
  '-------------------------------------字符处理--------------------------------------
  function code_form(strers)
    dim strer
    strer=trim(strers)
    if strer="" or isnull(strer) then
      code_form=""
      exit function
    end if
    strer=replace(strer,"'","""")
    code_form=strer
  end function

function html_js(strers)
    dim strer,re
    strer=trim(strers)
    if strer="" or isnull(strer) then
      html_js=""
      exit function
    end if
   Set re=new RegExp
    re.IgnoreCase=True
    re.Global=True
    re.Pattern="(script)"
    strer=re.Replace(strer,"<I>script</I>")
    set re=nothing
    html_js=strer
  end function

  function code_word(strers)
    dim strer
    strer=trim(strers)
    if strer="" or isnull(strer) then
      code_word=""
      exit function
    end if
    strer=replace(strer,chr(39),"&#39;")		'单引号
    strer=replace(strer,"<textarea","&lt;textarea")
    strer=replace(strer,"</textarea>","&lt;/textarea&gt;")
    code_word=strer
  end function

  function code_js(strers,tt)
    dim strer
    strer=trim(strers)
    if strer="" or isnull(strer) then
      code_js=""
      exit function
    end if
    if ishealth then
      strer=code_health(strer)
    end if
    strer=replace(strer,"\","\\")
    strer=replace(strer,chr(39),"&#39;")		'单引号
    'strer=replace(strer,chr(39),"\'")
    strer=replace(strer,chr(34),"&quot;")		'双引号
    'strer=replace(strer,chr(34),"\""")
    select case tt
    case 0
      'strer=replace(strer,vbcrlf,"")			'回车
      strer=replace(strer,chr(10),"")
      strer=replace(strer,chr(13),"")
    case 1
      'strer=replace(strer,vbcrlf,"\n")			'回车
      strer=replace(strer,chr(10),"\n")
      strer=replace(strer,chr(13),"")
    end select
    if right(strer,1)="\" then
      strer=strer&"n"
    end if
    code_js=strer
  end function
  
  function code_html(strers,chtype,cutenum)
    dim strer
    strer=trim(strers)
    if strer="" or isnull(strer) then
      code_html=""
      exit function
    end if
    if ishealth then
      strer=code_health(strer)
    end if
    if cutenum>0 then strer=cuted(strer,cutenum)
    strer=replace(strer,"<","&lt;")
    strer=replace(strer,">","&gt;")
    strer=replace(strer,chr(39),"&#39;")		'单引号
    strer=replace(strer,chr(34),"&quot;")		'双引号
    strer=replace(strer,chr(33),"&nbsp;")		'空格
    select case chtype
    case 1
      strer=replace(strer,chr(9),"&nbsp;")		'table
      'strer=replace(strer,vbcrlf,"")			'回车
      strer=replace(strer,chr(10),"")
      strer=replace(strer,chr(13),"")
    case 2
      strer=replace(strer,chr(9),"&nbsp;　&nbsp;")	'table
      'strer=replace(strer,vbcrlf,"<br>")		'回车
      strer=replace(strer,chr(10),"<br>")
      strer=replace(strer,chr(13),"")
    end select
    code_html=strer
  end function

  function code_health(hnn)
    dim ti,tj,tdim,ht
    code_health=hnn
    tdim=split(web_health,":")
    for ti=0 to ubound(tdim)
      ht="**"
      'for tj=1 to len(tdim(ti))
      '  ht=ht&"*"
      'next
      code_health=replace(code_health,tdim(ti),ht)
    next
    erase tdim
  end function

  '------------------------------------字符分割--------------------------------------
  function strlen(str)
    dim p_len,xx
    p_len=0
    strlen=0
      if trim(str)<>"" then
        p_len=len(trim(str))
         for xx=1 to p_len
           if asc(mid(str,xx,1))<0 then
             strlen=int(strlen) + 2
           else
             strlen=int(strlen) + 1
           end if
         next
      end if
  end function

  function cuted(types,num)
    dim p_num
    dim i,x
      if strlen(types)<=num then
        cuted=types
      else
        p_num=0
        x=0
          do while not p_num > num-2
           x=x+1
            if asc(mid(types,x,1))<0 then
              p_num=int(p_num) + 2
            else
              p_num=int(p_num) + 1
            end if
           'cuted=left(trim(types),x)&"…"
           cuted=left(trim(types),x)&""
         loop
      end if
  end function

  '-----------------------------------随机N位数字-------------------------------------
  function rand_num(rnum)
    dim ri,rmax,rmin,rndnum
    rmax=10^(rnum)-1
    rmin=10^(rnum-1)
    randomize
    rndnum=int((rmax-rmin+1)*rnd)+rmin
    for ri=1 to rnum-len(rndnum)
      rndnum="0"&rndnum
    next
    rand_num=rndnum
  end function
  
  function rand_file(leftvar)
    dim temp1
    temp1=""
    if var_null(leftvar)<>"" then temp1=left(leftvar,1)
    rand_file=temp1&time_type(now_time,11)&rand_num(2)
  end function
  
  private sub class_initialize()
    now_time=time_type(now(),1)
    today_time=time_type(now(),4)
    js_tim="?"&now_time
    timer_start=timer()
    pro_edition="H"&"S"&"C"&"M"&"S"&"_"&"2"&"0"&"0"&"6"
    num_rs=0
    js_mod=false
    isconn=false
    ishealth=false
    call own_dir()
  end sub
  
  '-------------------------------判断发言是否来自外部-------------------------------
  function post_chk()
    dim server_v1,server_v2
    server_v1=request.servervariables("http_referer")
    server_v2=request.servervariables("server_name")
    if server_v1<>"" then
      'mid(server_v1,8,len(server_v2))=server_v2
      server_v2="http://"&server_v2
      if left(server_v1,len(server_v2))=server_v2 then
        post_chk=true
        exit function
      end if
    end if
    post_chk=false
  end function

  function chk()
    chk=false
    if trim(request.form("chk"))="yes" then
      chk=post_chk()
    end if
  end function

  '------------------------------------IP SYS--------------------------------------
  function ip_sys(st)	'0=ip	1=sys
    if st=1 then
      ip_sys=request.servervariables("http_user_agent")
      exit function
    end if
    dim userip,userip2
    userip=request.servervariables("http_x_forwarded_for")
    userip2=request.servervariables("remote_addr")
    if instr(userip,",")>0 then userip=left(userip,instr(userip,",")-1)
    if instr(userip2,",")>0 then userip2=left(userip2,instr(userip2,",")-1)
    if userip="" then
      ip_sys=userip2
    else
      ip_sys=userip
    end if
  end function
   
  function js_put(j_var,j_type)  '0 src  1 code
    select case cint(j_type)
    case 0
      js_put=vbcrlf&"<script language=javascript src='"&j_var&"'></script>"
    case 1
      js_put=vbcrlf&"<script language=javascript>" & _
	      vbcrlf& j_var & _
	      vbcrlf&"</script>"
    end select
  end function
  
  function ts(j_var)
      ts="<script language=javascript>alert(""调试信息："&j_var&""");</script>"
  end function

  function fix_num(f_num,f_type)
    dim fnum:fnum=f_num
    if not(isnumeric(fnum)) then fix_num=0:exit function
    select case f_type
    case 0
      fix_num=int(fnum)
    case 1
      if instr(fnum,".")=0 then
        fix_num=fnum
      else
        fix_num=int(fnum)+1
      end if
    case 2
      if instr(fnum,".")=0 then
        fix_num=fnum
      else
        if cint(mid(fnum,instr(fnum,".")+1,1))>=5 then
          fix_num=int(fnum)+1
        else
          fix_num=int(fnum)
        end if      
      end if  
    end select
  end function
  
function get_file(file_name)
  dim filetemp,fileos,filepath
  set fileos=createobject(fso_sys_var)
  filepath=server.mappath(file_name)
  set filetemp=fileos.opentextfile(filepath,1,true)
  get_file=filetemp.ReadAll
  filetemp.close
  set filetemp=nothing
  set fileos=nothing
end function

sub create_file(file_name,filetype)
  dim filetemp,fileos,filepath
  set fileos=createobject(fso_sys_var)
  filepath=server.mappath(file_name)
  set filetemp=fileos.createtextfile(filepath,true)
  filetemp.writeline( filetype )
  filetemp.close
  set filetemp=nothing
  set fileos=nothing
end sub

sub MakeNewsDir(foldername)
  dim folderos,fileos,myfolder
  set fileos=createobject(fso_sys_var)
  if foldername<>"" then
    myfolder=server.mappath(foldername)
    if not fileos.folderexists(myfolder) then
      set folderos=fileos.createfolder(myfolder)
    end if
  end if
  set fileos=nothing
end sub

function max_id(data_name,d_data,d_data1)
  dim temp
  sql="select max("&d_data&") from "&data_name
 if d_data1<>"" then 
  sql=sql&" where "&d_data1
  end if
  set rs=joekoe_cms.exec(sql,1)
  if not rs.eof then
   temp=rs(0)
  end if
  rs.close
  max_id=temp
end function

sub chk_creat()
  dim tmp1,power,name,gnum
  data_name="jk_user_group"
  web_dim(19)=""

  sql="select * from "&data_name&" order by g_order"

  set rs=joekoe_cms.exec(sql,1)
  do while not rs.eof
    power=rs("g_power")
    name=rs("g_name")
    gnum=rs("g_mod_num")
	color=rs("tcolor")
    if web_dim(19)="" then
      web_dim(19)=power&":"&name&":"&gnum&":"&color
    else
      web_dim(19)=web_dim(19)&"|"&power&":"&name&":"&gnum&":"&color
    end if
    rs.movenext
  loop
  rs.close
  application.contents.remove(joekoe_cms.web_cookies&"_user_group")
end sub

sub chk_server(di)
dim  v_name,s_url,d_url,n_sort
select case di
  case 28
  n_sort="msong"
  case 41
  n_sort="video"
end select
  web_dim(di)=""
  sql="select * from jk_server where nsort='"&n_sort&"' order by s_id" 
  set rs=joekoe_cms.exec(sql,1)
  do while not rs.eof
  v_name=rs("s_name")
  s_url=rs("s_url")
  d_url=rs("ds_url")
  if d_url=""or d_url="http://" then
  d_url=s_url
  end if
  if web_dim(di)="" then
  web_dim(di)=s_url&"|"&d_url&"|"&v_name
  else
  web_dim(di)=web_dim(di)&"$"&s_url&"|"&d_url&"|"&v_name
  end if
  rs.movenext
  loop
  rs.close
end sub

sub chk_down_server()
  dim s_name,s_url,sql3,rs3
  data_name="jk_server"
  web_dim(53)=""
  sql3="select * from "&data_name&" where nsort='down' order by s_id" 
  set rs3=joekoe_cms.exec(sql3,1)
            do while not rs3.eof
                s_name=rs3("s_name")
    		s_url=rs3("s_url")
            if web_dim(53)="" then
	      web_dim(53)=s_url&"|"&s_name
            else
	      web_dim(53)=web_dim(53)&"$"&s_url&"|"&s_name
            end if
            rs3.movenext
            loop
            rs3.close
            set rs3=nothing
end sub
	
function server_url(n_sort,server_id)
  data_name="jk_server"
  	sql="select top 1 * from "&data_name&" where nsort='"&n_sort&"' and s_id="&server_id
  set rs=joekoe_cms.exec(sql,1)
  if not rs.eof then
  server_url=rs("s_url")
  end if
  rs.close
end function
			
sub server_select(n_sort,case_name)
  	dim temp,n_id,sql3,rs3
  data_name="jk_server"
  	temp="<select name="&case_name&" size=1><option value='0'>请先选择...</option>"
  	sql3="select s_id,s_name from "&data_name&" where nsort='"&n_sort&"'"
  	set rs3=joekoe_cms.exec(sql3,1)
  	do while not rs3.eof
    	n_id=int(rs3(0))
    	temp=temp&vbcrlf&"<option value='"&n_id&"'>"&rs3(1)&"</option>"
    	rs3.movenext
  	loop
  	rs3.close
  	set rs3=nothing
	response.write temp&"</select>"
end sub

function userid(login_username,login_password)
  data_name="user_data"
  	sql="select top 1 id from "&data_name&" where hidden=1 and abate=0 and username='"&login_username&"' and password='"&login_password&"'"
  set rs=joekoe_cms.exec(sql,1)
  if not rs.eof then
  userid=rs("id")
  end if
  rs.close
end function		  
  end class
%>
