<%'***************************************************
'函数名：IsObjInstalled
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'       False ----没有安装
'***************************************************
Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function
'***********************************************
'函数名：JoinChar
'作  用：向地址中加入 ? 或 &
'参  数：strUrl  ----网址
'返回值：加了 ? 或 & 的网址
'***********************************************
function JoinChar(strUrl)
	if strUrl="" then
		JoinChar=""
		exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
end function

'**************************************************
'函数名：strLength
'作  用：求字符串长度。汉字算两个字符，英文算一个字符。
'参  数：str  ----要求长度的字符串
'返回值：字符串长度
'**************************************************
function strLength(str)
	ON ERROR RESUME NEXT
	dim WINNT_CHINESE
	WINNT_CHINESE    = (len("中国")=2)
	if WINNT_CHINESE then
        dim l,t,c
        dim 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
            end if
        next
        strLength=t
    else 
        strLength=len(str)
    end if
    if err.number<>0 then err.clear
end function
'********************************************
'函数名：IsValidEmail
'作  用：检查Email地址合法性
'参  数：email ----要检查的Email地址
'返回值：True  ----Email地址合法
'       False ----Email地址不合法
'********************************************
function IsValidEmail(email)
	dim names, name, i, c
	IsValidEmail = true
	names = Split(email, "@")
	if UBound(names) <> 1 then
	   IsValidEmail = false
	   exit function
	end if
	for each name in names
		if Len(name) <= 0 then
			IsValidEmail = false
    		exit function
		end if
		for i = 1 to Len(name)
		    c = Lcase(Mid(name, i, 1))
			if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
		       IsValidEmail = false
		       exit function
		     end if
	   next
	   if Left(name, 1) = "." or Right(name, 1) = "." then
    	  IsValidEmail = false
	      exit function
	   end if
	next
	if InStr(names(1), ".") <= 0 then
		IsValidEmail = false
	   exit function
	end if
	i = Len(names(1)) - InStrRev(names(1), ".")
	if i <> 2 and i <> 3 then
	   IsValidEmail = false
	   exit function
	end if
	if InStr(email, "..") > 0 then
	   IsValidEmail = false
	end if
end function

function HTMLEncode(fString)
if not isnull(fString) then
    fString = replace(fString, ">", "&gt;")
    fString = replace(fString, "<", "&lt;")
    fString = Replace(fString, CHR(32), "&nbsp;")
    fString = Replace(fString, CHR(9), "&nbsp;")
    fString = Replace(fString, CHR(34), "&quot;")
    fString = Replace(fString, CHR(39), "&#39;")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
    fString = Replace(fString, CHR(10), "<BR> ")
    HTMLEncode = fString
end if
end function
'********************************************
'函数名：symbol_name
'作  用：检查判断用户名、代号和密码的合法性
'参  数：sn_var ----要检查的用户名、代号和密码
'返回值：True  ----用户名、代号和密码合法
'       False ----用户名、代号和密码不合法
'********************************************
function symbol_name(sn_var)
  symbol_name=false
  if len(sn_var)>20 or instr(sn_var,"|")>0 or instr(sn_var,":")>0 or instr(sn_var,"'")>0 or instr(sn_var,"""")>0 or instr(sn_var,chr(9))>0 or instr(sn_var,chr(10))>0 or instr(sn_var,chr(13))>0 or instr(sn_var,chr(32))>0 then
    exit function
  end if
  for i=1 to len(sn_var)
    if instr(web_dim(15),mid(sn_var,i,1))>0 then exit function
  next
  symbol_name=true
end function

function symbol_ok(symbol_var)
  symbol_ok=false
  symbol_var=symbol_var
  if symbol_var="" or len(symbol_var)>20 then exit function
  for i=1 to len(symbol_var)
    if instr(web_dim(16),mid(symbol_var,i,1))=0 then exit function
  next
  symbol_ok=true
end function

function checknum(str)
	if isnull(str) or str=""  then
		exit function
	else
		if not isnumeric(str) then
			response.write"<center>非法操作导致程序中止!</center>"
			response.end
		else
			checknum=int(str)
		end if
	end if
end function

function code_admin(strers,at,acut)
  dim strer
  strer=trim(strers)
  select case int(at)
  case 1
    strer=trim(request.form(strer))
  case 2
    strer=trim(request.querystring(strer))
  end select
  if isnull(strer) or strer="" then
    code_admin=""
    exit function
  end if
  strer=replace(strer,"'","""")
  if int(acut)>0 then strer=left(strer,acut)
  code_admin=strer
end function

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
    if session("Hx_cms")=false then chk=false
end function

 ' 检查sql字符串中是否有单引号，有则进行转化
function CheckStr(str)
   dim tstr,l,i,ch
       l=len(str)
       for i=1 to l
	   ch=mid(str,i,1)
	   if ch="'" then
		tstr=tstr+"'"
	   end if
		tstr=tstr+ch
       next
   CheckStr=tstr
end function

function chktopic(str)
if str<>"" then
str=replace(str,"""","")
str=replace(str,"'","")
str=replace(str,"“","")
str=replace(str,chr(10),"")
str=replace(str,chr(13),"")
str=replace(str,")"," ）")
str=replace(str,"(","〈")
end if
chktopic=str
end function
%>