<%
function alertbox(str,kindnum)
	select case kindnum
		case "1"
			response.write("<script>alert(""" & str & """);</script>")
			response.end()
		case "2"
			response.write("<script>alert(""" & str & """);window.history.back();</script>")
			response.end()
		case "3"
			response.write("<script>alert(""" & str & """);window.close();</script>")
			response.end()
		case "4"
			response.write("<script>alert(""" & str & """);history.back();</script>")
			response.end()			
	end select
end function

function cursor(strLink,sec)
    response.write("<script>setTimeout(""location.href='"&strLink&"'"","&sec&"*1000);</sc"&"ript>")
end function
function helpcursor(strLink,sec)
    response.write("<script>setTimeout(""location.href='help.asp"&strLink&"'"","&sec&"*1000);</sc"&"ript>")
end function

sub LINE(str)
	response.write ltrim(str)
end sub

function gfv(str)
	gfv = request.form(str)
end function

function gqv(str)
	gqv = request.querystring(str)
end function


Function ChkNum(Byval Num)
	Dim tNum:tNum = ""
	If Num = "" Or Not IsNumeric(Num) Then
		Response.Write("<script>alert(""参数类型错误!"");history.back();</script>")
		Response.End()
	ElseIf len(Num) > 8 Then
		Response.Write("<script>alert(""参数超出范围!"");history.back();</script>")
		Response.End()
	Else
		tNum = clng(left(Num,8))
	End If
	ChkNum = tNum
End Function

Function ChkInput(Str)
	Dim RegEx
	Set RegEx = New RegExp
		RegEx.IgnoreCase = True
		RegEx.Pattern = "<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|url|eval|\t"
	If RegEx.Test(LCase(Str)) Then
		Response.Write("<script>alert(""请不要输入非法字符!"");history.back();</script>")
		Response.End()
	End If
	Set RegEx = Nothing
	ChkInput = Str
End Function

Function NoSqlHack(FS_inputStr)
	Dim f_NoSqlHack_AllStr,f_NoSqlHack_Str,f_NoSqlHack_i
		f_NoSqlHack_AllStr="'|;| and |chr(|exec |insert |select |delete from|update |mid(|master."
		f_NoSqlHack_Str = Split(f_NoSqlHack_AllStr,"|")

	For f_NoSqlHack_i=LBound(f_NoSqlHack_Str) To Ubound(f_NoSqlHack_Str)
		If Instr(LCase(FS_inputStr),f_NoSqlHack_Str(f_NoSqlHack_i))<>0 Then
		   If f_NoSqlHack_Str(f_NoSqlHack_i)="'" Then f_NoSqlHack_Str(f_NoSqlHack_i)=" \' "
		   Response.Write "<html><title>警告</title><body bgcolor=""EEEEEE"" leftmargin=""60"" topmargin=""30""><font style=""font-size:16px;font-weight:bolder;color:blue;""><li>您提交的数据有恶意字符</li></font><font style=""font-size:14px;font-weight:bolder;color:red;""><br><li>您的数据已经被记录!</li><br><li>您的IP："&Request.ServerVariables("Remote_Addr")&"</li><br><li>操作日期："&Now&"</li></font></body></html><!--Powered by 654上网导航,AddTime:"&now&"-->"
		   Response.End
		 End if
	Next
	NoSqlHack = FS_inputStr
End Function

Function NoHtmlHackInput(Str) '过滤跨站脚本和HTML标签
	Dim regEx
	Set regEx = New RegExp  '建立正则表达式。
	regEx.IgnoreCase = True  '设置是否区分字符大小写。
	regEx.Pattern = "<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|eval|\t" '设置模式。
	If regEx.Test(LCase(Str)) Then
			Response.Write "<html><title>警告</title><body bgcolor=""EEEEEE"" leftmargin=""60"" topmargin=""30""><font style=""font-size:16px;font-weight:bolder;color:blue;""><li>您提交的数据有恶意字符</li></font><font style=""font-size:14px;font-weight:bolder;color:red;""><br><li>提交的内容不能包括[<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|eval]</li><li>您的数据已经被记录!</li><br><li>您的IP："&Request.ServerVariables("Remote_Addr")&"</li><br><li>操作日期："&Now&"</li></font></body></html><!--Powered by 654.cn Inc.,AddTime:"&now&"-->"
			Response.End
	End If
	Set regEx = Nothing
	NoHtmlHackInput = Str
End Function


Function FuckJP(ByVal Str)
	If IsNull(Str) Or IsEmpty(Str) Then Exit Function
	Dim F,I
		F = Array("ゴ","ガ","ギ","グ","ゲ","ザ","ジ","ズ","ヅ","デ","ド","ポ","ベ","プ","ビ","パ","ヴ","ボ","ペ","ブ","ピ","バ","ヂ","ダ","ゾ","ゼ")
 	FuckJP = Str
 	For I = 0 To 25
 		FuckJP = Replace(FuckJP,F(I),"")
 	Next
End Function

Function ChkPost()
	Dim From_Url:From_Url = CStr(Request.ServerVariables("HTTP_REFERER"))
	Dim Serv_Url:Serv_Url = CStr(Request.ServerVariables("SERVER_NAME"))
	If Mid(From_Url,8,Len(Serv_Url)) <> Serv_Url Then
		Response.Write("<script>alert(""请不要非法提交数据!"");history.back();</script>")
		Response.End()
	End If
End Function

Function GetIP()
	Dim StrIP_List,StrIP,IP_Ary
		StrIP_List = Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"'","")
	If InStr(StrIP_List,",") <> 0 Then
		IP_Ary = Split(StrIP_List,",")
		StrIP = IP_Ary(0)
	Else
		StrIP = StrIP_List
	End If
	If StrIP = Empty Then StrIP = Replace(Request.ServerVariables("REMOTE_ADDR"),"'","")
	GetIP = StrIP
End Function

Function SendTo654cn(Str1,Str2,Str3,Str4)
	On Error Resume Next
	LINE "<script>setTimeout(""document.form.submit()"",0);</script>"
	LINE "<form name=""form"" action=""http://Update.654.cn/center/receive.asp"" method=""post"">"
	LINE "<input name=""k1"" type=""hidden"" value=""" & Str1 & """>"
	LINE "<input name=""k2"" type=""hidden"" value=""" & Str2 & """>"
	LINE "<input name=""k3"" type=""hidden"" value=""" & Str3 & """>"
	LINE "<input name=""k4"" type=""hidden"" value=""" & Str4 & """>"
	LINE "<input name=""kx"" type=""hidden"" value=""" & DH_654_SN & """>" '识别码！
	LINE "</form>"
End Function

function dateformat(datestr,types)
	dim datestring
	if isdate(datestr) = false then
		datestring = ""
	end if
	select case types
		case "1" 
			datestring = year(datestr) & "-" & month(datestr) & "-" & day(datestr)
		case "2"
			datestring = year(datestr) & "." & month(datestr) & "." & day(datestr)
		case "3"
			datestring = month(datestr) & "-" & day(datestr) & "-" & year(datestr)
		case "4"
			datestring = month(datestr) & "." & day(datestr) & "." & year(datestr)
		case "5"
			datestring = year(datestr) & month(datestr) & day(datestr)
		case "6"
			datestring = hour(datestr) & minute(datestr) & second(datestr)
		case "7"
			datestring = year(datestr) & "年" & month(datestr) & "月" & day(datestr) & "日"
		case "8"
			datestring = month(datestr) & "月" & day(datestr) & "日" & hour(datestr) & "时"& minute(datestr) & "分"
		case else
			datestring = datestr
	end select
	dateformat = datestring
end function


'**************************************************** 
'函数名：SendMail 
'作 用：用Jmail组件发送邮件 
'参 数：MailtoAddress ----收信人地址 
' MailtoName -----收信人姓名 
' Subject -----主题 
' MailBody -----信件内容 
' FromName -----发信人姓名 
' MailFrom -----发信人地址 
' Priority -----信件优先级 
'如：SendMail("13822990077@126.com","你好，阿莲","这是一封情书!","你好,我知道我对不
'_起你,你也是,不是我不小心,只是真情难以抗拒!","来自乐府诗","laidunet@126.com",1)
'**************************************************** 
function SendMail(MailtoAddress,MailtoName,Subject,MailBody,FromName)
  dim MailFrom:MailFrom=SMTPServerUserName&"@"&MailDomain  
  If IsObjInstalled("JMail.SmtpMail") = True Then
     On Error Resume Next  
     dim jmail,msg
     set jmail=server.createobject("Jmail.message")  
     if err then 
        SendMail= "<br><li>没有安装JMail组件</li>" 
        err.clear 
        exit function 
     end if    
     jmail.silent=true 
     jmail.charset=""&chrset&"" 
     jmail.fromname=FromName       '发件人
     jmail.from=MailFrom  '这里是发件人邮箱，可以从数据库或表单中取值，但格式一定要正确
     jmail.addrecipient MailtoAddress,MailtoName '对方邮箱地址,名称
     jmail.subject=Subject
     jmail.Body=MailBody
     jmail.mailserverusername=SMTPServerUserName '邮件发送服务器登录名称 
     jmail.mailserverpassword=SMTPServerPassword '邮件发送服务器登录密码 
     jmail.maildomain=MailDomain                 '邮件发送服务器域名 
     msg=jmail.send(SMTPServer)                  'smtp服务器名称 
     if msg then 
        response.write("<font color=""red"">恭喜您，邮件发送成功</font>")
     else 
        response.write("<font color=""red"">对不起，邮件发送失败，可能由于服务器登录设置配置不当造成或填写的信息有误，请确认正确后再进行发送！</font>")
     end if
   Else
     Response.Write("<font color=""red""><b>×你还未安装JMail组件！无法发送。</b></font>")
   End If
end function

'============================================
'控制输出字符串的长度，可以区别中英文
'函数在下面，是方法是：
'strvalue("如果不填写则取",14)'
'这里26是指26个英文字母，也就是13个汉字
' ============================================
function strlen(str)
   dim xx,p_len: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 strvalue(str,lennum)
   dim x,p_num,i
   if strlen(str)<=lennum then
      strvalue=str
   else
      p_num=0:x=0
      do while not p_num > lennum-2
         x=x+1
         if asc(mid(str,x,1))<0 then
            p_num=int(p_num) + 2
         else
            p_num=int(p_num) + 1
         end if
         strvalue=left(trim(str),x)&""  '"…"
     loop
   end if
end function

'检查英文名称是否合法
Function chkinputchar(DH654_char)
	Dim DH654_name, i, c
	DH654_name = DH654_char
	chkinputchar = True
	If Len(DH654_name) <= 0 Then
		chkinputchar = False
		Exit Function
	End If
	For i = 1 To Len(DH654_name)
	   c = Mid(DH654_name, i, 1)
		If InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ@,.0123456789|-_", c) <= 0  Then
		   chkinputchar = False
		Exit Function
	   End If
   Next
End Function

''暂不支持中文
'可配合server.URLEncode如：server.URLEncode(Encrypt(防止被转化成'报错。
Function Ecode654cn(ecode)  ''加密
   dim texts,i
   for i=1 to len(ecode)
       texts=texts & chr(asc(mid(ecode,i,1))+3)
   next
   Ecode654cn = texts
End Function
''暂不支持中文
Function Dcode654cn(dcode)  ''解密
   dim texts,i
   for i=1 to len(dcode)
       texts=texts & chr(asc(mid(dcode,i,1))-3)
   next
   Dcode654cn=texts
End Function

function CodeCookie(str)
  Dim i,strRtn
  for i=len(str) to 1 step -1
      strRtn=strRtn & ascw(mid(str,i,1))
      if (i<>1) then strRtn=strRtn & "|"
  next
  CodeCookie=strRtn
end function

function DecodeCookie(str)
  Dim i,strArr,strRtn
  strArr=Split(str,"|")
  for i=UBound(strArr)-LBound(strArr) to 0 step -1
      strRtn=strRtn & chrw(strArr(i))
  next
  DecodeCookie=strRtn
end function

'普通字符串转换成二进制字符串函数
Function Str2Bin(String)
  Dim i,tmpbin
  For i=1to strLength(String)
    tmpbin=tmpbin&ChrB(Asc(Mid(String,I,1)))
  Next
  Str2Bin=tmpbin
End Function
Function strLength(str)
   If(len("老乐")=2) then
      Dim l,t,c,i
      l=Len(str)
      t=l
      For i=1 To l
         c=asc(mid(str,i,1))
         If c<0Then
            c=c+65536
         End If
         'asc对中文字符求出来的值可能为负数，加上65536就可求出它的无符号数值
         '-1在机器内是用补码表示的0xffff,其无符号值为65535,65535=-1+65536，其他负数依次类推。
         If c>255 Then
            t=t+1
         End If
      Next
      strLength=t
   Else
      strLength=len(str)
   End If
End Function
Function bytes2BSTR(vIn) 
  Dim strReturn:strReturn = "" 
  Dim i,ThisCharCode,NextCharCode
  For i = 1 To LenB(vIn) 
      ThisCharCode = AscB(MidB(vIn,i,1)) 
      If ThisCharCode < &H80 Then 
         strReturn = strReturn & Chr(ThisCharCode) 
      Else 
         NextCharCode = AscB(MidB(vIn,i+1,1)) 
         strReturn = strReturn & Chr (CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) 
         i = i + 1 
      End If 
  Next 
  bytes2BSTR = strReturn 
End Function

'字符转化
function unencode(str)
  str=replace(str,"&amp;","&")
  str=replace(str,"&quot;",chr(34))
  str=replace(str,"&lt;","<")
  str=replace(str,"&gt;",">")
  unencode=str
end function

'内容转化

Rem 过滤HTML代码
function HTMLEncode(str)
  if not isnull(str) then
         str = replace(str, ">", "&gt;")
         str = replace(str, "<", "&lt;")
         str = replace(str, CHR(32), "&nbsp;")
         str = replace(str, CHR(9), "&nbsp;")
         str = replace(str, CHR(34), "&quot;")
         str = replace(str, CHR(39), "&#39;")
         str = replace(str, CHR(13), "")
         str = replace(str, CHR(10) & CHR(10), " ")
         str = replace(str, CHR(10), " ")
        'str = ChkBadWords(str)
         HTMLEncode = str
  end if
end function

'================================================
'过程名：PreventRefresh
'作  用：防止刷新页面
'================================================
Sub PreventRefresh(RefreshTime)  '防止刷新时间,单位（10秒）
    Dim isRefresh
    isRefresh = 1    '是否使用防刷新功能，0=否，1=是
    If isRefresh = 1 Then
        If (Not IsEmpty(Session("RefreshTime"))) And RefreshTime > 0 Then
            If DateDiff("s", Session("RefreshTime"), Now()) < RefreshTime Then
                Response.Write "<META http-equiv=Content-Type content=text/html; chaRset=gb2312><meta HTTP-EQUIV=REFRESH CONTENT="&RefreshTime&"><br>本页面起用了防刷新机制，请不要在"&RefreshTime&"秒内连续刷新本页面<BR>正在打开页面，请稍后……"
                Response.End
            Else
                Session("RefreshTime") = Now()
            End If
        Else
            Session("RefreshTime") = Now()
        End If
    End If
End Sub


Function FullChinese(str) '判断字符全为中文函数 
   Dim i:i = Len(str)
   If i = 0 Then 
      FullChinese = False 
      Exit Function 
   End If    
   Do While i > 0 
      If Asc(Mid(str, i, 1)) < 10000 And Asc(Mid(str, i, 1)) > -10000 Then 
         FullChinese = False 
         Exit Function 
      End If 
      i = i - 1 
   Loop 
   FullChinese = True 
End Function 



'判断文件名是否合法 
Function isFilename(aFilename) 
   Dim sErrorStr,iNameLength,i 
   isFilename=TRUE 
   sErrorStr=Array("/","\",":","*","?","""","<",">","|") 
   iNameLength=Len(aFilename) 
   If iNameLength<1 Or iNameLength=null Then 
   isFilename=FALSE 
   Else 
   For i=0 To 8 
   If instr(aFilename,sErrorStr(i)) Then 
   isFilename=FALSE 
   End If 
   Next 
   End If 
End Function 

Function CheckSafe(ParaName,ParaType)  
  '--- 传入参数 ---
       'ParaName:参数名称-字符型
       'ParaType:参数类型-数字型(1表示以上参数是数字，0表示以上参数为字符)
       '数字型:Num,字符:
 If Isnull(ParaName) Then  
  CheckSafe = ""  
  Exit Function   
 End If  
 
 ParaName = Replace(ParaName,Chr(0),"", 1, -1, 1)  
 ParaName = Replace(ParaName, """", "&quot;", 1, -1, 1)  
 ParaName = Replace(ParaName,"<","&lt;", 1, -1, 1)  
 ParaName = Replace(ParaName,">","&gt;", 1, -1, 1)   
 ParaName = Replace(ParaName, "script", "&#115;cript", 1, -1, 0)  
 ParaName = Replace(ParaName, "SCRIPT", "&#083;CRIPT", 1, -1, 0)  
 ParaName = Replace(ParaName, "Script", "&#083;cript", 1, -1, 0)  
 ParaName = Replace(ParaName, "script", "&#083;cript", 1, -1, 1)  
 ParaName = Replace(ParaName, "object", "&#111;bject", 1, -1, 0)  
 ParaName = Replace(ParaName, "OBJECT", "&#079;BJECT", 1, -1, 0)  
 ParaName = Replace(ParaName, "Object", "&#079;bject", 1, -1, 0)  
 ParaName = Replace(ParaName, "object", "&#079;bject", 1, -1, 1)  
 ParaName = Replace(ParaName, "applet", "&#097;pplet", 1, -1, 0)  
 ParaName = Replace(ParaName, "APPLET", "&#065;PPLET", 1, -1, 0)  
 ParaName = Replace(ParaName, "Applet", "&#065;pplet", 1, -1, 0)  
 ParaName = Replace(ParaName, "applet", "&#065;pplet", 1, -1, 1)  
 ParaName = Replace(ParaName, "[", "&#091;")  
 ParaName = Replace(ParaName, "]", "&#093;")  
 ParaName = Replace(ParaName, """", "", 1, -1, 1)  
 ParaName = Replace(ParaName, "=", "&#061;", 1, -1, 1)  
 ParaName = Replace(ParaName, "’", "’’", 1, -1, 1)  
 ParaName = Replace(ParaName, "select", "sel&#101;ct", 1, -1, 1)  
 ParaName = Replace(ParaName, "execute", "&#101xecute", 1, -1, 1)  
 ParaName = Replace(ParaName, "exec", "&#101xec", 1, -1, 1)  
 ParaName = Replace(ParaName, "join", "jo&#105;n", 1, -1, 1)  
 ParaName = Replace(ParaName, "union", "un&#105;on", 1, -1, 1)  
 ParaName = Replace(ParaName, "where", "wh&#101;re", 1, -1, 1)  
 ParaName = Replace(ParaName, "insert", "ins&#101;rt", 1, -1, 1)  
 ParaName = Replace(ParaName, "delete", "del&#101;te", 1, -1, 1)  
 ParaName = Replace(ParaName, "update", "up&#100;ate", 1, -1, 1)  
 ParaName = Replace(ParaName, "like", "lik&#101;", 1, -1, 1)  
 ParaName = Replace(ParaName, "drop", "dro&#112;", 1, -1, 1)  
 ParaName = Replace(ParaName, "create", "cr&#101;ate", 1, -1, 1)  
 ParaName = Replace(ParaName, "rename", "ren&#097;me", 1, -1, 1)  
 ParaName = Replace(ParaName, "count", "co&#117;nt", 1, -1, 1)  
 ParaName = Replace(ParaName, "chr", "c&#104;r", 1, -1, 1)  
 ParaName = Replace(ParaName, "mid", "m&#105;d", 1, -1, 1)  
 ParaName = Replace(ParaName, "truncate", "trunc&#097;te", 1, -1, 1)  
 ParaName = Replace(ParaName, "nchar", "nch&#097;r", 1, -1, 1)  
 ParaName = Replace(ParaName, "char", "ch&#097;r", 1, -1, 1)  
 ParaName = Replace(ParaName, "alter", "alt&#101;r", 1, -1, 1)  
 ParaName = Replace(ParaName, "cast", "ca&#115;t", 1, -1, 1)  
 ParaName = Replace(ParaName, "exists", "e&#120;ists", 1, -1, 1)  
 ParaName = Replace(ParaName,Chr(13),"<br>", 1, -1, 1)  
 CheckSafe = Replace(ParaName,"’","’’", 1, -1, 1)  
End Function   
  
function sqlcheck(Str,errtype)
if Instr(LCase(Str),"select ") > 0 or Instr(LCase(Str),"insert ") > 0 or Instr(LCase(Str),"delete ") > 0 or Instr(LCase(Str),"delete from ") > 0 or Instr(LCase(Str),"count(") > 0 or Instr(LCase(Str),"drop table") > 0 or Instr(LCase(Str),"update ") > 0 or Instr(LCase(Str),"truncate ") > 0 or Instr(LCase(Str),"asc(") > 0 or Instr(LCase(Str),"mid(") > 0 or Instr(LCase(Str),"char(") > 0 or Instr(LCase(Str),"xp_cmdshell") > 0 or Instr(LCase(Str),"exec master") > 0 or Instr(LCase(Str),"net localgroup administrators") > 0  or Instr(LCase(Str),"and ") > 0 or Instr(LCase(Str),"net user") > 0 or Instr(LCase(Str),"or ") > 0 then
 Response.write("<script language=javascript>" & vbcrlf & "window.location.href ='ShowError.asp?errtype=" & errtype & "'" & vbcrlf & "</script>")
 Response.End
end if
Str=Replace(Str,"_","")     '过滤SQL注入_
Str=Replace(Str,"*","")     '过滤SQL注入*
Str=Replace(Str," ","")     '过滤SQL注入空格
Str=Replace(Str,chr(34),"")   '过滤SQL注入"
Str=Replace(Str,chr(39),"")            '过滤SQL注入'
Str=Replace(Str,chr(91),"")            '过滤SQL注入[
Str=Replace(Str,chr(93),"")            '过滤SQL注入]
Str=Replace(Str,chr(37),"")            '过滤SQL注入%
Str=Replace(Str,chr(58),"")            '过滤SQL注入:
Str=Replace(Str,chr(59),"")            '过滤SQL注入;
Str=Replace(Str,chr(43),"")            '过滤SQL注入+
Str=Replace(Str,"{","")            '过滤SQL注入{
Str=Replace(Str,"}","")            '过滤SQL注入}
sqlcheck=Str            '返回经过上面字符替换后的Str
end function
  
function l1ll(l1,l2)
	dim l5
	if cstr(l2)="8" then
		l5=l11(trim(request.servervariables("query_string")),"/",king.ext)
		'当l2=8的时候,l1=0代表 值可以为空　反之 l1=1
		if cstr(l1)<>"0" and len(l5)=0 then king.error("system/not")
	else
		l5=killjapan(trim(request.querystring(l1)))
	end if
	if len(l5)=0 then exit function
	select case cstr(l2)
	case"0"
	case"1","2","3"
		if II11(l5,l2)=false then king.error("system/checkstr")
	case"8"'?/ Value king.ext
		if II11(l5,2)=false then king.error("system/checkstr")
	case else king.error("system/checkstr")
	end select
	l1ll=l5
end function

function II11(l1,l2)'l1:str;l2:类型
	dim l3,l4
	set l4=New regexp
	select case cstr(l2)
		case"0" l3="^[a-zA-Z0-9\,\/\-\_\[\]]+$"
		case"1" l3="^[A-Za-z]+$"
		case"2" l3="^\d+$"
		case"3" l3="^[A-Za-z0-9\_\-]+$"
		case"4" l3="^\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*$"
		case"5" l3="^(http|https|ftp):(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&amp;)|&)+"
		case"6" l3="^[0-9\,]+$"
		case"7" l3="^((http|https|ftp):(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&amp;)|&)+|\/([\w\/\\\.\=\?\+\-~`@\':!%#]|(&amp;)|&)+)\.(jpeg|jpg|gif|png|bmp)$"
		case"8" l3="^\w+\.(\w){1,10}$"
		case"9" l3="^((((1[6-9]|[2-9]\d)\d{2})-(0?[13578]|1[02])-(0?[1-9]|[12]\d|3[01]))|(((1[6-9]|[2-9]\d)\d{2})-(0?[13456789]|1[012])-(0?[1-9]|[12]\d|30))|(((1[6-9]|[2-9]\d)\d{2})-0?2-(0?[1-9]|1\d|2[0-8]))|(((1[6-9]|[2-9]\d)(0[48]|[2468][048]|[13579][26])|((16|[2468][048]|[3579][26])00))-0?2-29-)) (20|21|22|23|[0-1]?\d):[0-5]?\d:[0-5]?\d$"
		case"10" l3="^(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])$"
		case else l3=l2
	end select
	l4.pattern=l3
	II11=l4.Test(trim(l1))
	set l4=nothing
end function

function killjapan(l1)
	on error resume next
	if cstr(G_654_SQL_DB)="0" then
		dim I1,I2,i,l2:l2=l1
		I1=array("ガ","ギ","グ","ア","ゲ","ゴ","ザ","ジ","ズ","ゼ","ゾ","ダ","ヂ","ヅ","デ","ド","バ","パ","ビ","ピ","ブ","プ","ベ","ペ","ボ","ポ","ヴ")
		I2=array("460","462","463","450","466","468","470","472","474","476","478","480","482","485","487","489","496","497","499","500","502","503","505","506","508","509","532")
		for i=0 to 26
			l2=replace(l2,I1(i),"&#12"&I2(i)&";")
		next
		killjapan=l2
	else
		killjapan=l1
	end if
end function

function III11(l1)
	dim I1,l2,l3,l4,I2,I3,I4
	if isdate(l1) then
		l2=year(l1):l3=month(l1):l4=day(l1):I2=right(l2,2)
		if len(l3)=1 then I3=chr(48)&cstr(l3) else I3=l3
		if len(l4)=1 then I4=chr(48)&cstr(l4) else I4=l4
		dim DH654_datestyle:DH654_datestyle="1"
		select case cstr(DH654_datestyle)
			case"0" I1=l2&"-"&l3&"-"&l4
			case"1" I1=l2&"-"&I3&"-"&I4
			case"2" I1=I2&"-"&I3&"-"&I4
			case"3" I1=l2&I3&I4
			case"4" I1=I2&I3&I4
			case else I1=l2&"-"&l3&"-"&l4
		end select
	end if
	III11=I1
end function

sub II1(l1) '删除文件
	'on error resume next
	dim fs,l2
	set fs=createobject(G_654_FSO)
		l2=server.mappath(l1)
			if fs.fileexists(l2) then
				fs.deletefile(l2)
			end if
	set fs=nothing
	if err.number<>0 then
		err.clear
	end if
end sub

%>