<meta http-equiv="Content-Type" content="text/html; charset=gb2312"><%
CLASS HX_SYSTEMCONFIG
'防sql注入
   Public function HX_Replace(str)
    if not isnull(str) and str<>"" then
	str	= Replace(str,"&","&amp;")	
	str = replace(str, ">", "&gt;")
	str = replace(str, "<", "&lt;")
	str = Replace(str, CHR(32), " ")
	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, "script", "&#115;cript")
	str = Replace(str, "＆#115;", "&#115;")
    HX_Replace = str
   end if
  end function
'是否为数
    Public Function HX_IsNum(Str)
	   if Str<>"" and isnumeric(Str) then
	     HX_IsNum=True
	   else
	    HX_IsNum=False
	   end if
	End Function  
'是否为空
    Public Function HX_Isnull(Msg,Str)
	   If str="" or isnull(Str) then
	     HX_GoBack Msg,""
	   End If
	End Function
	 
	Function IDCheck(e)
	       dim arrVerifyCode,Wi,Checker
            IDCheck = true 
            arrVerifyCode = Split("1,0,x,9,8,7,6,5,4,3,2", ",") 
            Wi = Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2", ",") 
            Checker = Split("1,9,8,7,6,5,4,3,2,1,1", ",") 
           If Len(e) < 15 Or Len(e) = 16 Or Len(e) = 17 Or Len(e) > 18 Then 
              IDCheck = False 
            Exit Function 
          End If 
          Dim Ai 
          If Len(e) = 18 Then 
             Ai = Mid(e, 1, 17) 
          ElseIf Len(e) = 15 Then 
             Ai = e 
             Ai = Left(Ai, 6) & "19" & Mid(Ai, 7, 9) 
          End If 
         If Not IsNumeric(Ai) Then 
              IDCheck = False 
         Exit Function 
      End If 	  
      Dim strYear, strMonth, strDay ,BirthDay
      strYear = CInt(Mid(Ai, 7, 4)) 
      strMonth = CInt(Mid(Ai, 11, 2)) 
      strDay = CInt(Mid(Ai, 13, 2)) 
      BirthDay = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay) 
      If IsDate(BirthDay) Then 
         If DateDiff("yyyy",Now,BirthDay)<-140 or cdate(BirthDay)>date() Then 
           IDCheck = False 
           Exit Function 
         End If 
         If strMonth > 12 Or strDay > 31 Then 
            IDCheck = False 
            Exit Function 
         End If 
     Else 
      IDCheck = False 
     Exit Function 
    End If		 
 End Function 
 
'时间格式处理
	Public Function Format_Time(Tvar,sType)
        dim Tt,sYear,sMonth,sDay,sHour,sMinute,sSecond
        If Not IsDate(Tvar) Then Format_Time = "" : Exit Function
        Tt			= Tvar
        sYear		= Year(Tt)
        sMonth		= Right("0" & Month(Tt),2)
		sDay		= Right("0" & Day(Tt),2)
		sHour		= Right("0" & Hour(Tt),2)
		sMinute		= Right("0" & Minute(Tt),2)
		sSecond		= Right("0" & Second(Tt),2)
        Select Case sType
        Case 1	'2006-3-13 23:45:45
			Format_Time = sYear & "-" & sMonth & "-" & sDay & " " & sHour & ":" & sMinute & ":" & sSecond
        Case 2	'年-月-日 时:分:秒
			Format_Time = sYear & "年" & sMonth & "月" & sDay & "日 " & sHour & "时" & sMinute & "分" & sSecond & "秒"
        Case 3	'3-13 23:45
			Format_Time = sMonth & "-" & sDay & " " & sHour & ":" & sMinute
        Case 4	'2006-3-13
			Format_Time = sYear & "-" & sMonth & "-" & sDay
        Case 5	'2006年3月13日
			Format_Time = sYear & "年" & sMonth & "月" & sDay & "日"
        Case 6	'3-13
			Format_Time = sMonth & "-" & sDay
        Case 7	'20060313234545
			Format_Time = sYear & sMonth & sDay & sHour & sMinute & sSecond
		Case 8  '20060313
		   	Format_Time = sYear & sMonth & sDay
        Case Else
			Format_Time = Tt
        End Select
    End Function
'显示文字着色	
	Public Function FormatColor(sValue,sColor)
		sColor=Trim(sColor)
		If IsNull(sColor) or sColor="" then
			FormatColor = sValue
		Else
			FormatColor = "<font color="& sColor &" >" & sValue & "</font>"
		End if
	End Function
'显示员工权限
	Public Function MemberPriv(ColPriv)
	  if HX_ISNUM(loginuid) then
	     MemberPriv=0
		 set MemberPrivrs=WS_S.HX_SetRSD("","HX_CompanyUser"," where WS_Uid="&loginuid)
		   if MemberPrivrs.recordcount>0 then		     
	         set privrs=WS_S.HX_SetRSD(ColPriv,"HX_MemberPriv"," where WS_MPID="&MemberPrivrs("WS_MPID"))
		     if privrs.recordcount>0 then			  
			   MemberPriv=privrs(0)
     	     end if
		   end if
     	   HX_RSClose MemberPrivrs:HX_RSClose privrs
	  end if	
	End Function	
'检查用户的性别	
	Public Function GetUserSex(strSex)
		  Select Case ChkClng(strSex)
		   Case 0 : GetUserSex="女"
		   Case 1 : GetUserSex="男"
		   Case Else : GetUserSex="保密"
		  End Select		
	End Function
'创建目录
    Sub CreateDir(sFolderPath)
		On Error Resume Next
		Dim objFSO,tPath
		tPath=sFolderPath
		err=0
		Set objFSO = Server.CreateObject(scripting.FileSystemObject)
		If objFSO.FolderExists(Server.MapPath(tPath)) Then
			Set objFSO = Nothing
			Exit Sub
		Else
			objFSO.CreateFolder Server.MapPath(tPath)
			Set objFSO = Nothing
		End If
		err=0
	End Sub
'
    Function HX_OutSaleMan(Str)
      if WS_S.HX_ISNUM(Str) then
		  set cors=WS_S.HX_SetRSD("","HX_CustomContact"," where WS_CCID="&Str)
		  if cors.recordcount>0 then
		     set crs=WS_S.HX_SetRSD("","HX_CustomInfo"," where WS_CIID="&cors("WS_CIID"))
		     if crs.recordcount>0 then
		       HX_OutSaleMan="["&crs("WS_CustomInfoName")&"]"&cors("WS_CustomContactName")
			 else
			   HX_OutSaleMan=cors("WS_CustomContactName")
			 end if
		  else
		    HX_OutSaleMan="无"	 
		  end if
	  else
	     HX_OutSaleMan="无"	  
	  end if	  
    End Function	
'检查目录是否存在！(sFolderPath,sIsCreate(False,True) 不存在创建)
	Public Function CheckDir(sFolderPath,sIsCreate)
		On Error Resume Next
		Dim objFSO,tPath
		tPath=sFolderPath
		CheckDir=False:err=0
		Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
		If objFSO.FolderExists(Server.MapPath(tPath)) Then
			CheckDir=True
			Set objFSO = Nothing
			Exit Function
		Else
			if sIsCreate=True then
				objFSO.CreateFolder Server.MapPath(tPath)
				if err=0 then CheckDir=True
			end if
			Set objFSO = Nothing
		End If
		err=0
	End Function
    Function ShowFolderSize(filespec)
	   call CheckDir(filespec,True)
	   Dim fso, f, s
       Set fso = CreateObject("Scripting.FileSystemObject")
	   filespec=server.mappath(filespec)
       Set f = fso.GetFolder(filespec)
	   ShowFolderSize = f.size
	   set f=nothing
	   set fso=nothing
    End Function
'检查目录是否存在！(sFolderPath,sIsCreate(False,True) 存在是否删除)
	Public Function CheckFolder(sFolderPath,sIsCreate)
		'On Error Resume Next
		Dim objFSO,tPath
		tPath=sFolderPath		
		Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
		If objFSO.FolderExists(Server.MapPath(tPath)) Then
			if sIsCreate=True then
				objFSO.DeleteFolder Server.MapPath(tPath)
			end if
			Set objFSO = Nothing
		End If
	End Function
'检查文件是否存在！(strFileSource,sIsDelete(False,True)存在是否删除)	
    Public Function CheckFile(strFileSource,sIsDelete)
	  dim fso	   
       Set fso = CreateObject("scripting.FileSystemObject") 
       If fso.FileExists(strFileSource) Then
	     if sIsDelete=True then 
           fso.DeleteFile(strFileSource)
		  end if 
       End If 
      Set fso = Nothing 	
     End Function
'取得文件路径
	Public Function GetClassIDPath(sParentPath, sClassID)
		Dim P,tPath
		GetClassIDPath="":tPath=sParentPath
		if Instr(tPath,",")>0 or Instr(tPath,"|")>0 then
			tPath=Split(Replace(tPath,"|",","),",")
			for p=1 to Ubound(tPath)
				GetClassIDPath=GetClassIDPath & "Class" & tPath(p)&"/"
			next
		end if
		GetClassIDPath=GetClassIDPath & "Class" & sClassID&"/"
	End Function
'检查Email地址合法性
	Public Function ChkEmail(email)
		dim names, name, i, c
		ChkEmail = true : names = Split(email, "@")
		if UBound(names) <> 1 then ChkEmail = false : Exit Function
		for each name in names
			if Len(name) <= 0 then ChkEmail = false:exit function
			for i = 1 to Len(name)
		   	    c = Lcase(Mid(name, i, 1))
				if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
		    	   ChkEmail = false:Exit Function
		   	    end if
		    next
		    if Left(name, 1) = "." or Right(name, 1) = "." then
   		 	    ChkEmail = false:Exit Function
	 	    end if
		next
		if InStr(names(1), ".") <= 0 then ChkEmail = false:exit function
		i = Len(names(1)) - InStrRev(names(1), ".")
		if i <> 2 and i <> 3 then ChkEmail = false : Exit function
		if InStr(email, "..") > 0 then ChkEmail = false
	End Function
'检查是否已经安装
	Public Function ChkObjInstalled(strClassString)
		On Error Resume Next
		ChkObjInstalled = False
		Err = 0
		Dim xTestObj
		Set xTestObj = Server.CreateObject(strClassString)
		If 0 = Err Then ChkObjInstalled = True
		Set xTestObj = Nothing
		Err = 0
	End Function
'判断提交信息是否来自外部
	Public Function ChkIsOuter()
		Dim server_v1,server_v2
		server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
		server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
		If Mid(server_v1,8,len(server_v2))<>server_v2 Then 
		response.Write("<script language=javascript>alert('请不要从外部数据!');window.close();</script>")
        response.end
		end if
	End Function
'判断浏览器是否支持cookies
    Public Function HX_CheckCookies()
	  NetOA=request.cookies(prefix&"Netcst")("NetcstCheck")
	  if NetOA="" or isnull(NetOA) then
	    response.cookies(prefix&"Netcst")("NetcstCheck")="netcst.com"
		response.cookies(prefix&"Netcst").Expires=date+365
	  end if
	  NetOA=request.cookies(prefix&"Netcst")("NetcstCheck")
	  if NetOA="" or isnull(NetOA) then
	    CheckCookies=False
	  else
	    CheckCookies=True
	  end if	
	  HX_CheckCookies=CheckCookies
    End Function
'选择记录方式	
    Sub HX_SelectCookiesORSession()
	  select case WS_S.HX_CheckCookies
	    case True
		  Response.Cookies(prefix)("LOGINUSERID")=WS_Uid
	      Response.Cookies(prefix)("LOGINUSERNAME")=WS_UserName		
          Response.Cookies(prefix)("LOGINPASSWORD")=HX_PassWord
		  Response.Cookies(prefix)("LOGAppointment")=WS_Appointment
		  Response.Cookies(prefix)("LOGdepartment")=WS_department
          Response.Cookies(prefix)("LoginCook")=HX_cook
		  if HX_cook>0 then
           Response.Cookies(prefix).Expires=date+HX_cook
         end if	
		case False
		   Session(prefix&"LOGINUSERID")=WS_Uid
	       Session(prefix&"LOGINUSERNAME")=WS_UserName		
           Session(prefix&"LOGINPASSWORD")=HX_PassWord
		   Session(prefix&"LOGAppointment")=WS_Appointment
		   Session(prefix&"LOGdepartment")=WS_department
	  end select	
    End Sub
'客户等级
    Sub HX_CustomInfoRank(Str)
	  if HX_ISNUM(Str) then
	     ColumnName="":tablename="HX_CustomRank":Orderby=" where WS_CRID="&Str
         set Ourtyrs=WS_S.HX_SetRSD(ColumnName,tablename,Orderby)
          if Ourtyrs.recordcount>0 then
		    WS_CustomRankName=Ourtyrs("WS_CustomRankName")
			WS_CustomRankPice=Ourtyrs("WS_CustomRankPice")
		  end if 
	   else
		    WS_CustomRankName=""
			WS_CustomRankPice=1
	   end if
	End Sub
'读取登录后记录
    Sub HX_LoginCheck()
	  select case WS_S.HX_CheckCookies
	    case True
		  LOGINUid=REQUEST.Cookies(prefix)("LOGINUSERID")
		  LOGINUSERNAME=REQUEST.Cookies(prefix)("LOGINUSERNAME")
          LOGINPASSWORD=REQUEST.Cookies(prefix)("LOGINPASSWORD")
          LogAppointment=REQUEST.Cookies(prefix)("LogAppointment")
		  LOGdepartment=REQUEST.Cookies(prefix)("LOGdepartment")
	    case False
		   LOGINUid=Session(prefix&"LOGINUSERID")
	       LOGINUSERNAME=Session(prefix&"LOGINUSERNAME")		
           LOGINPASSWORD=Session(prefix&"LOGINPASSWORD")
		   LogAppointment=Session(prefix&"LOGAppointment")
		   Logdepartment=Session(prefix&"LOGdepartment")
	  end select	  
	End Sub
	Function HX_OutAttendanceDuty(DutyType)
	   if HX_IsNUM(DutyType) then
	     select case DutyType
		   case 1
		     HX_OutAttendanceDuty="上班"
		   case 2
		     HX_OutAttendanceDuty="下班" 
		 end select	 
	   end if
	End Function
	Function HX_NotifyFlag(NotifyFlag)
	  if HX_ISNUM(NotifyFlag) then
	    select case NotifyFlag
		  case 0:HX_NotifyFlag="普通"
		  case 1:HX_NotifyFlag="重要"
		  case 2:HX_NotifyFlag="加急"
		end select  
	  end if
	End Function
	Function HX_OutWorkFlowType(FlowType)
	   if HX_IsNUM(FlowType) then
	     ColumnName="":tablename="HX_WorkFlowType":Orderby=" order by WS_WTID desc"
         set Ourtyrs=WS_S.HX_SetRSD(ColumnName,tablename,Orderby)
          if Ourtyrs.recordcount>0 then
		    HX_OutWorkFlowType=Ourtyrs("WS_WorkFlowTypeName")
		  end if      
	   end if
	End Function
    Sub HX_OutEnrolFlag(flag)
	   if HX_IsNUM(flag) then
	     select case flag
		   case 0
		     response.write "领导尚未批示"
		   case 1
		     response.write "领导已批准"
		   case 2
		     response.write "领导未批准" 
		 end select	 
	   end if
	End Sub'判断是否登录
    Function HX_ISLogin()
	    WS_S.HX_LoginCheck
	    HX_ISLogin=True
	    IF ISNULL(LOGINUSERNAME) OR LOGINUSERNAME="" OR ISNULL(LOGINPASSWORD) OR LOGINPASSWORD="" THEN
           HX_ISLogin=False
        ELSE
           LOGINPASSWORDMD5=MD5(LOGINPASSWORD)
           ORderby=" where WS_UserName='"&LOGINUSERNAME&"' and WS_PassWord='"&LOGINPASSWORDMD5&"'": HX_Conn dir
           SET RS=WS_S.HX_SetRSD("","HX_CompanyUser",ORderby)
           IF RS.RECORDCOUNT<=0 THEN
             HX_ISLogin=False
		   Else
		     HX_ISLogin=True	 
           END IF
         Call WS_S.HX_RSClose(RS)  
        END IF
	End Function	
'用户权限
    Sub HX_UserJurisdiction()
	
	End sub		
'注销登录	
	Sub HX_LoginOut()
	  if request("online")<>"wsoas" then
	    if HX_ISNUM(request.Cookies(prefix)("LOGINUSERID")) then
		  HX_conn dir
		  conn.execute("delete from HX_Online where WS_Userid="&request.Cookies(prefix)("LOGINUSERID"))
		end if
	  end if	
	    Response.Cookies(prefix)("LOGINUSERID")=""
       	Response.Cookies(prefix)("LOGINUSERNAME")=""
        Response.Cookies(prefix)("LOGINPASSWORD")=""
		Response.Cookies(prefix)("WS_Appointment")=""
		session.Abandon()	
	End Sub
	
'在线人员HX_OutOnline(type),stype为0时显示人数,1时显示具体人员
    Function HX_OutOnline(stype)
        if HX_isnum(stype) then
		  ColumnName="WS_Userid,WS_Name,WS_Viewip,WS_Lasttime,WS_Staus":tablename="HX_Online":Orderby=" order by WS_Lasttime desc"
		  set onliners=HX_SetRSD(ColumnName,tablename,Orderby)
		   select case stype
		      case 0			  
			    HX_OutOnline=onliners.recordcount
			  case 1
		        if onliners.recordcount<=0 then
				   response.write "<table width='85' border='0' cellspacing='1' cellpadding='3'><tr><td align=center>无人在线</td></tr></table>" 
				else 
				   response.write "<table width='85' border='0' cellspacing='1' cellpadding='3'>"
                     do until onliners.eof
					    HX_OutUserInfo(onliners("WS_Userid"))
						 if onliners("WS_Userid")=cint(loginuid)  then
			               myoutname="<font color=red title='自己' onclick=""if (confirm('你想自己给自己发消息吗？')) show('"&onliners("WS_Userid")&"');"">"&onliners("WS_Name")&"</font>"
			             else
			               myoutname=onliners("WS_Name")
			             end if
	                    response.write "<tr><td  class='face' onMouseDown=this.className='face-2' onMouseUp=this.className='face-1' onMouseOver=this.className='face-1' onMouseOut=this.className='face' style='CURSOR:hand;' onDblClick=""show('"&onliners("WS_Userid")&"');"" title=""双击给 ["&Outdepartment&" "&OutAppointment&" "&onliners("WS_Name")&"] 发短消息!!! &#10;目前状态："&HX_OutStaus(onliners("WS_Staus"))&"&#10;用户ＩＰ："&onliners("WS_Viewip")&"&#10;上线时间："&onliners("WS_Lasttime")&"""><img src='../hximages/websms/userface.gif' align='absmiddle' id='WSOA"&onliners("WS_Userid")&"' name='WSOA"&onliners("WS_Userid")&"'> "&myoutname&"</td></tr>"
                     onliners.movenext
                     loop
                   response.write "</table>" 
		        end if
			 case 2
			  ColumnName="WS_Staus":tablename="HX_Online":Orderby=" where WS_Userid="&loginuid
		      set onliners=HX_SetRSD(ColumnName,tablename,Orderby)
			  if onliners.recordcount>0 then  HX_OutOnline=onliners(0)  else  HX_OutOnline=0
		   end select 
		   HX_RSClose(onliners)  
		else
          HX_OutOnline=0
		end if
    End Function
	Function HX_OutStaus(str)
	  if HX_ISNUM(str) then
	    select case str
		  case 0:HX_OutStaus="联机"
		  case 1:HX_OutStaus="忙碌"
		  case 2:HX_OutStaus="离开"
		end select  	  
	  end if
	End Function
'全部人员HX_OutListMember
    Function HX_OutListMember()
	   ColumnName="":tablename="HX_CompanyUser":Orderby=" where WS_leave=False order by WS_Uid desc"
       set Ourusers=WS_S.HX_SetRSD(ColumnName,tablename,Orderby)
        if Ourusers.recordcount>0 then
	      response.write "<table width='85' border='0' cellspacing='1' cellpadding='3'>"
          do until Ourusers.eof
			HX_OutUserInfo(Ourusers("WS_Uid"))
			if Ourusers("WS_Uid")=cint(loginuid)  then
			  myoutname="<font color=red title='自己'>"&Ourusers("WS_Name")&"</font>"
			else
			  myoutname=Ourusers("WS_Name")
			end if
	        response.write "<tr><td  class='face' onMouseDown=this.className='face-2' onMouseUp=this.className='face-1' onMouseOver=this.className='face-1' onMouseOut=this.className='face' style='CURSOR:hand;' onDblClick=""show('"&Ourusers("WS_Uid")&"');"" title=""双击给 ["&Outdepartment&" "&OutAppointment&" "&Ourusers("WS_Name")&"] 发短消息!!! &#10;注册时间："&Ourusers("WS_addate")&"&#10;上次登录："&Ourusers("WS_logindate")&"""><img src='../hximages/websms/userface.gif' align='absmiddle'> "&myoutname&"</td></tr>"
          Ourusers.movenext
          loop
          response.write "</table>"
        end if
		HX_RSClose(Ourusers)
   End Function
'返回
    Sub HX_Redirect(url)
	   if url<>"" then
	      response.redirect url
		  response.end
	   else
	      response.write "<script>history.go(-1);</script>"
		  response.end
	   end if	
	End Sub	
'向地址中加入 ? 或 & (无用)
	Public Function JoinChar(strUrl)
		if strUrl="" then JoinChar="":Exit Function
		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
' 判断是否安全字符串,在注册登录等特殊字段中使用
	Public Function IsSafeStr(str)
		Dim s_BadStr, n, i
		s_BadStr = "'   &<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
		n = Len(s_BadStr)
		IsSafeStr = True
		For i = 1 To n
			If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then
				IsSafeStr = False
				Exit Function
			End If
		Next
	End Function
	'****************************************************************
'数据库连接地址函数DBPathAddress(DBPathStr)
'返回数据库连接地址
    Public Function DBPathAddress(DBPathStr)
       SELECT CASE DBPathStr
          CASE 0
             DBPath ="HXMYDATABASE/#HX_DATABASE2.5.MDB"
          CASE 1
	         DBPath ="../HXMYDATABASE/#HX_DATABASE2.5.MDB"
          CASE 2
	         DBPath ="../../HXMYDATABASE/#HX_DATABASE2.5.MDB"
		  CASE 3
		     DBPath ="HXMYDATABASE/HX_IPaddress.mdb"
		  CASE 4
		     DBPath ="../HXMYDATABASE/HX_IPaddress.mdb"
		  CASE 5
		     DBPath ="../../HXMYDATABASE/HX_IPaddress.mdb"	  
       END SELECT 
	   DBPathAddress=server.mappath(DbPath)
    End Function
''获取任何表任何字段信息函数
    Public Function HX_SetRSD(ColsStr,TaNameStr,OrderBystr)
	    If ColsStr="" then ColsStr="*"
         set HX_SetRSD=server.CreateObject("adodb.recordset")
		 'response.write "select "&ColsStr&" from "&TaNameStr&OrderBystr&"<br>"
		 'HX_SetRSD.open "select "&ColsStr&" from "&TaNameStr,conn,1,3
         HX_SetRSD.open "select "&ColsStr&" from "&TaNameStr&OrderBystr,conn,1,3			 	 
     End Function 
'写入任何表任何字段信息函数
	Public Sub InToColumn(TableName,ColumnName,ColumnValue)
		On Error Resume Next
		Execute("insert into ["&TableName&"] ("&ColumnName&") values ("&Replace(Replace(ColumnValue,"True","1"),"False","0")&")")
		If Err Then
			Response.Write "在数据库表"&TableName&"中添加记录失败！原因：<font color=red>" & Err.Description
			Err.Clear
			'Response.end
		End If
	End Sub
'显示从职位中显示部门
     Public Function HX_OutAppointment(Appointment)
	    If Appointment<>"" and Isnumeric(Appointment) Then
	    Set OutRs=WS_S.HX_SetRSD("WS_AppointmentName,WS_Did","HX_Appointment"," where WS_Aid="&Appointment)
		  If OutRs.recordcount>0 Then
		    Set Ders=WS_S.HX_SetRSD("WS_DepartmentName","HX_Department"," where WS_Did="&OutRs("WS_Did"))
			If Ders.recordcount>0 Then
			HX_OutAppointment=Ders(0)
			End If
			Call HX_RSClose(Ders)
		    HX_OutAppointment=HX_OutAppointment&OutRs(0)
		  Else
		    HX_OutAppointment="<font color=red>职位删除</font>"
		  End If
		Else
		  HX_OutAppointment="<font color=red>参数错误</font>"
		End If
		  Call HX_RSClose(OutRs)
	 End Function
'显示部门 
    Public Function HX_OutDepartment(Department)
	    If Department<>"" and Isnumeric(Department) Then
		    Set Ders=WS_S.HX_SetRSD("WS_DepartmentName","HX_Department"," where WS_Did="&Department)
			If Ders.recordcount>0 Then
			  HX_OutDepartment=Ders(0)
			End If
			Call HX_RSClose(Ders)
		end if	
	 End Function'显示用户名、姓名、部门、职位	
	 Sub HX_OutUserInfo(Userid)
	   if Userid<>"" and isnumeric(Userid) then
	     OutUserName="":OutName="":OutPhone="":OutAddress="":OutAppointmentID="":OutdepartmentID=""
	     Set Outrs=WS_S.HX_SetRSD("*","HX_CompanyUser"," where WS_Uid="&Userid)
		 if Outrs.recordcount>0 then
		   OutUserName=Outrs("WS_UserName") '用户名
		   OutName=Outrs("WS_Name") '姓名
		   OutPhone=Outrs("WS_Phone")'电话号码
		   OutAddress=Outrs("WS_Address")'住址
		   OutAppointmentID=Outrs("WS_Appointment")'职位
		   OutdepartmentID=Outrs("WS_department")'部门
		   if OutAppointmentID>0 then
		     OutAppointment=conn.execute("select * from HX_Appointment where WS_Aid="&OutAppointmentID)("WS_AppointmentName")
		   end if
		   if OutdepartmentID>0 then
		     Outdepartment=conn.execute("select * from HX_Department where WS_Did="&OutdepartmentID)("WS_DepartmentName")
		   end if
		     Call HX_RSClose(OutRs)
		 end if
	   end if
	 End Sub
'显示客户
  Sub HX_OutCustonInfo(Cid)
    if WS_S.HX_IsNUM(Cid) then
     set crs=WS_S.HX_SetRSD(ColumnName,"HX_CustomInfo"," where WS_CIID="&Cid)
      if crs.recordcount>0 then
        response.write crs("WS_CustomInfoName")
	  else
	    response.write "不属于客户"	
      end if
	else
	  response.write "不属于客户"	 
	end if 
  End Sub
'显示供应商
  Sub HX_OutSaleShop(SSID)
    if WS_S.HX_IsNUM(SSID) then
     set crs=WS_S.HX_SetRSD(ColumnName,"HX_SaleShop"," where WS_SSID="&SSID)
      if crs.recordcount>0 then
        response.write crs("WS_SaleShopName")
	  else
	    response.write "内部产品"	
      end if
	else
	  response.write "内部产品"	 
	end if 
  End Sub
'显示产品名称
  Sub HX_OutProduct(PTID)
    if WS_S.HX_IsNUM(PTID) then
     set crs=WS_S.HX_SetRSD(ColumnName,"HX_Product"," where WS_PTID="&PTID)
      if crs.recordcount>0 then
        response.write crs("WS_ProductName")
	  else
	    response.write "产品空缺"	
      end if
	else
	  response.write "产品空缺"	 
	end if 
  End Sub
'显示日程类别
  Function OutSchEduleSort(SchEduleID)
    if WS_S.HX_IsNum(SchEduleID) then
      set OutRs=WS_S.HX_SetRSD(ColumnName,"HX_SchEduleSort"," where WS_SEID="&SchEduleID)
	  if OutRs.recordcount>0 then
	    OutSchEduleSort=OutRs("WS_SchEduleSortName")
	  end if
	  Call HX_RSClose(OutRs)
	end if
  End Function	 
	 
'写日志	
	Public Sub SaveAdminLog(WS_UserName,WS_Appointment,RequestStr)
		'On Error Resume Next
		Path_Info		= Request.ServerVariables("PATH_INFO")
		Tmpstr			= Split(Path_Info,"/")
		ScriptName		= Lcase(Tmpstr(UBound(Tmpstr)))
		Err=0
	    if RequestStr="" then
			RequestStr=Left(request.form,200)
			RequestStr=CheckStr(URLDecode(RequestStr))
			end if
			SQL="Insert Into HX_ManageLog (WS_UserName,WS_Appointment,WS_UserIP,WS_ScriptName,WS_LogContent,WS_LogTime) values ('"&WS_UserName&"',"&WS_Appointment&",'"&Request.ServerVariables("REMOTE_ADDR")&"','"&ScriptName&"','"&RequestStr&"','"&Now&"')"
			conn.Execute(SQL)
		If Err Then
			Response.Write "添加管理事件记录失败！原因：" & Err.Description
			Err.Clear
		End If
		HX_ClosDB()		
	End Sub
'关闭表对象	     
	 Public Function HX_RSClose(RecordSetStr)
	   if isobject(RecordSetStr) then
         RecordSetStr.Close:Set RecordSetStr = Nothing
	   end if
     End Function
	'Server.URLEncode解码函数
	Public Function URLDecode(enStr)
		dim deStr, c, i, v
		deStr=""
		for i=1 to len(enStr)
			c=Mid(enStr,i,1)
			if c="%" then
				v=eval("&h"+Mid(enStr,i+1,2))
				if v<128 then
					deStr=deStr&chr(v)
					i=i+2
				else
					if IsValidHex(mid(enstr,i,3)) then
						if IsValidHex(mid(enstr,i+3,3)) then
						v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
						deStr=deStr&chr(v)
						i=i+5
						else
						v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
						deStr=deStr&chr(v)
						i=i+3 
						end if
					else
						destr=destr&c
					end if
				end if
			else
				if c="+" then
					deStr=deStr&" "
				else
					deStr=deStr&c
				end if
			end if
		next
		URLDecode=deStr
	End Function




	'显示"上一页 下一页":链接地址,总数,页数,是否显示总数,是否用下拉列表跳转,单位
	Public Function PageControl(iCount,pagecount,page,table_style,font_style,colspan)
'生成上一页下一页链接
    Dim query, a, x, temp
    action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")

    query = Split(Request.ServerVariables("QUERY_STRING"), "&")
    For Each x In query
        a = Split(x, "=")
        If StrComp(a(0), "page", vbTextCompare) <> 0 Then
            temp = temp & a(0) & "=" & a(1) & "&"
        End If
    Next
   if colspan=0 then
   Response.Write("<table " & Table_style & ">" & vbCrLf ) 
   end if      
    Response.Write("<TR><TD align=right bgcolor=FFFBE8 colspan="&colspan&" height=25>" & vbCrLf )
    Response.Write(font_style & vbCrLf )            
    if page<=1 then
        Response.Write ("首页 " & vbCrLf)        
        Response.Write ("上页 " & vbCrLf)
    else        
        Response.Write("<A HREF=" & action & "?" & temp & "Page=1>首页</A> " & vbCrLf)
        Response.Write("<A HREF=" & action & "?" & temp & "Page=" & (Page-1) & ">上页</A> " & vbCrLf)
    end if

    if page>=pagecount then
        Response.Write ("下页 " & vbCrLf)
        Response.Write ("尾页 " & vbCrLf)            
    else
        Response.Write("<A HREF=" & action & "?" & temp & "Page=" & (Page+1) & ">下页</A> " & vbCrLf)
        Response.Write("<A HREF=" & action & "?" & temp & "Page=" & pagecount & ">尾页</A> " & vbCrLf)            
    end if

    Response.Write(" 页次：" & page & "/" & pageCount & "页" &  vbCrLf)
    Response.Write(" 共有" & iCount & "条" &  vbCrLf)
    Response.Write("</TD>" & vbCrLf )                
    Response.Write("</TR>" & vbCrLf )        
    if colspan=0 then
	Response.Write("</table>" & vbCrLf )
	end if        
	End Function
	Public Function ChecKIPlock(ip)     
 	   num_ip=IpEncode(ip)		    
       set rs=WS_S.HX_SetRSD("WS_LOID","HX_lockip"," where int(WS_Startip)<="&num_ip&" and int(WS_Endip)>=" & num_ip)
	    if rs.recordcount>0 then
		  Call WS_S.HX_RSClose(rs)	    
	      Call HX_GoBack("你所在网段已被封锁。可能该网段有人捣乱，请联系管理员！","")
	    end if		
        Call WS_S.HX_RSClose(rs)
    end function
	function IpDecode(byval uip)
	 if trim(uip)="" or not isnumeric(uip) then
		IpDecode=0
	  else
		uip=Cdbl(uip)
		dim ary_ip(3)
        ary_ip(0)=fix(uip/16777216)
        ary_ip(1)=fix((uip-ary_ip(0)*16777216)/65536)
        ary_ip(2)=fix((uip-fix(uip/65536)*65536)/256)
        uip=uip-fix(uip/65536)*65536
        ary_ip(3)=fix(uip-fix(uip/256)*256)
        IpDecode=join(ary_ip,".")
	  end if
    end function

   function IpEncode(byval uip)
	 if isnull(uip) or uip="" then
		IpEncode=0
	  else
		dim ary_ip,n
		ary_ip=split(trim(uip),".")
		n=ubound(ary_ip)
		if n=3 then
			IpEncode=ary_ip(0)*256*256*256+ary_ip(1)*65536+ary_ip(2)*256+ary_ip(3)
		else
			IpEncode=0
		end if
	 end if
   end function
	'取得带端口的URL
	Public Function Get_ScriptNameUrl()
		If request.servervariables("SERVER_PORT")="80" Then
			Get_ScriptNameUrl="http://" & request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
		Else
			Get_ScriptNameUrl="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
		End If
	End Function
	' 转为根路径格式
	Public Function RelativePath2RootPath(url)
		Dim sTempUrl
		sTempUrl = url
		If Left(sTempUrl, 1) = "/" Then
			RelativePath2RootPath = sTempUrl
			Exit Function
		End If
		Dim sNowPath
		sNowPath = Request.ServerVariables("SCRIPT_NAME")
		sNowPath = Left(sNowPath, InstrRev(sNowPath, "/") - 1)
		Do While Left(sTempUrl, 3) = "../"
			sTempUrl = Mid(sTempUrl, 4)
			sNowPath = Left(sNowPath, InstrRev(sNowPath, "/") - 1)
		Loop
		RelativePath2RootPath = sNowPath & "/" & sTempUrl
	End Function
	' 根路径转为带域名全路径格式
	Public Function RootPath2DomainPath(url)
		Dim sHost, sPort
		sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
		sPort = Request.ServerVariables("SERVER_PORT")
		If sPort <> "80" Then sHost = sHost & ":" & sPort
		RootPath2DomainPath = sHost & url
	End Function

	Public Function GetSize(size,unit)
		if isEmpty(size) or Not Isnumeric(size) then Exit Function
		size=CheckUnit(size,unit)
 		if size>1024 then
 			size=(size/1024)
 			getsize=formatnumber(size,2) & " MB"
		else
		    if size>0 then
			getsize=formatnumber(size,2) & " KB"	
			else
			getsize="0.00 KB"
			end if		
			Exit Function
 		end if
 		if size>1024 then
 			size=(size/1024)
 			getsize=formatnumber(size,2) & " GB"
 		end if
	End Function
	Public Function CheckUnit(size,unit)
		Select Case Lcase(Unit)
		Case "b"
			CheckUnit = formatnumber(size/1024,2)
		Case "k"
			CheckUnit = size
		Case "m"
			CheckUnit = (size*1024)
		Case "g"
			CheckUnit = (size*1024*1024)
		Case Else
			CheckUnit = size
		End Select
	End Function
	Public Sub DelFiles(strFiles)
		if strFiles="" then Exit Sub
		dim fso,arrFiles,i
		On Error Resume Next
		Err=0
		Set fso = CreateObject("scripting.FileSystemObject")
			if fso.FileExists(server.MapPath(strFiles)) then
				fso.DeleteFile(server.MapPath(strFiles))
				if 0=Err then
					Response.write "<br>清除文件（"&strFiles&"）成功！"
				else
					Response.write "<br>清除文件（"&strFiles&"）失败！"
				end if
			end if
		Set fso = Nothing
		Err=0
	End Sub
	Public Sub DownloadFile(strFile,sReName)
		On error resume next
		Server.ScriptTimeOut=999999
		Dim S,fso,f,intFilelength,strFilename
		strFilename = server.MapPath(strFile)
		Response.Clear
		Set s = Server.CreateObject("Adodb." & "Str" & "eam") 
		s.Open
		s.Type = 1 
		Set fso = Server.CreateObject("scripting.FileSystemObject") 		
		If Not fso.FileExists(strFilename) Then
			Response.Write("<h1>错误: </h1><br>系统找不到指定文件！<a href='javascript:history.go(-1)'><font color=red>点此返回</font></a>吧！")
			Exit Sub		
		End If
		Set f = fso.GetFile(strFilename)
		intFilelength = f.size
		s.LoadFromFile(strFilename)
		If err Then
		 	Response.Write("<h1>错误: </h1>" & err.Description & "<p>")
			Response.End 
		End If
		Set fso=Nothing
		Dim Data
		Data=s.Read
		s.Close
		Set s=Nothing
		If Response.IsClientConnected Then 
			Response.AddHeader "Content-Disposition", "attachment; filename="&ReplaceBadChar(sReName)&"."&GetDownLoadFileExt(f.name)
			Response.AddHeader "Content-Length", intFilelength 
 			Response.CharSet = "UTF-8" 
			Response.ContentType = "application/octet-stream"
			Response.BinaryWrite Data
			Response.Flush
		End If
	End Sub
	Public Function GetDownLoadFileExt(strFile)
		GetDownLoadFileExt="rar"
		Dim strExt
		if Isnull(strFile) then Exit Function
		if Instr(strFile,".")<=0 then Exit Function
		strExt=Split(strFile,".")
		GetDownLoadFileExt=strExt(Ubound(strExt))
	End Function
    Public Function ReplaceBadChar(strChar)
		strChar=replace(replace(strChar," ",""),"'","")
		strChar=replace(replace(strChar,".",""),"<","")
		strChar=replace(replace(strChar,")",""),"(","")
		strChar=replace(replace(strChar,"?",""),"*","")
		strChar=replace(replace(strChar,"/",""),"\","")
		ReplaceBadChar=replace(strChar,Chr(0),"")
	End Function
	Public Function HTMLEncode(fString)
		If Not IsNull(fString) then
		fString = replace(fString, ">", "&gt;")
		fString = replace(fString, "<", "&lt;")
		fString = replace(fString, "&", "&amp;")
		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

	Public Function HTMLCode(fString)
		If Not IsNull(fString) then
		fString = replace(fString, "&gt;", ">")
		fString = replace(fString, "&lt;", "<")
		fString = Replace(fString,  "&nbsp;"," ")
		fString = Replace(fString, "&quot;", CHR(34))
		fString = Replace(fString, "&#39;", CHR(39))
		fString = Replace(fString, "</P><P> ",CHR(10) & CHR(10))
		fString = Replace(fString, "<BR> ", CHR(10))
		HTMLCode = fString
		End If
	End Function

	Public Function NoHtml(str)
		if not isnull(str) then
		dim re
		Set re=new RegExp
		re.IgnoreCase =true
		re.Global=True
		re.Pattern="(\<.[^\<]*\>)"
		str=re.replace(str," ")
		re.Pattern="(\<\/[^\<]*\>)"
		str=re.replace(str," ")
		NoHtml=str
		Set re=Nothing
		End if
	End Function

	'sContent（要转换的数据字符串）
	'sFilters（要过滤掉的格式集，用"|"分隔多个）
	Public Function DeCode(sContent, sFilters)
		Dim a_Filter, i, s_Result, s_Filters
		Decode = sContent
		If IsNull(sContent) or IsNull(sFilters) Then Exit Function
		If sContent = "" or sFilters = "" Then Exit Function
		s_Result  = sContent
		s_Filters = sFilters
		If InStr(s_Filters,"|")>0 then
			a_Filter = Split(s_Filters, "|")
			For i = 0 To UBound(a_Filter)
				s_Result = DecodeFilter(s_Result, a_Filter(i))
			Next
		Else
			s_Result = DecodeFilter(s_Result, s_Filters)
		End If
		DeCode = s_Result
	End Function

	Public Function DecodeFilter(sContent, sFilter)
		Dim regEx
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global	 = True
		Select Case Ucase(sFilter)
		Case "SCRIPT"'去除所有客户端脚本javascipt,vbscript,jscript,js,vbs,event,...
			regEx.Pattern	= "</?script[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "(javascript|jscript|vbscript|vbs):"
			sContent		= regEx.replace(sContent,"$1：")
			regEx.Pattern	= "on(mouse|exit|error|click|key)"
			sContent		= regEx.replace(sContent,"<I>on$1</I>")
		Case "OBJECT"'去除对象<object><param><embed></object>
			regEx.Pattern	= "</?object[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?param[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?embed[^>]*>"
			sContent		= regEx.replace(sContent,"")
		Case "TABLE"'去除表格<table><tr><td><th>
			regEx.Pattern	= "</?table[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?tr[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?th[^>]*>"
			sContent		= regEx.replace(sContent,"")
			regEx.Pattern	= "</?td[^>]*>"
			sContent		= regEx.replace(sContent,"")
		Case "CLASS"'去除样式类class=""
			regEx.Pattern	= "(<[^>]+) class=[^ |^>]*([^>]*>)"
			sContent		= regEx.replace(sContent,"$1 $2")
		Case "STYLE"'去除样式style=""
			regEx.Pattern	= "(<[^>]+) style=\""[^\""]*\""([^>]*>)"
			sContent		= regEx.replace(sContent,"")
		Case "XML"'去除XML<?xml>
			regEx.Pattern	= "<\\?xml[^>]*>"
			sContent		= regEx.replace(sContent,"")
		Case "NAMESPACE"'去除命名空间<o:p></o:p>
			regEx.Pattern	= "<\/?[a-z]+:[^>]*>"
			sContent		= regEx.replace(sContent,"")
		Case Else
			regEx.Pattern	= "</?" & s_Filter & "[^>]*>"
			sContent		= regEx.replace(sContent,"")
		End Select
		DecodeFilter = sContent
		Set regEx=nothing
	End Function

	Public Function UBBCode(strContent)
	on error resume next
	strContent = HTMLEncode(strContent)
	dim objRegExp
	Set objRegExp=new RegExp
	objRegExp.IgnoreCase =true
	objRegExp.Global=True

	objRegExp.Pattern="(\[URL\])(.*)(\[\/URL\])"
	strContent= objRegExp.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$2</A>")

	objRegExp.Pattern="(\[URL=(.*)\])(.*)(\[\/URL\])"
	strContent= objRegExp.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$3</A>")

	objRegExp.Pattern="(\[EMAIL\])(.*)(\[\/EMAIL\])"
	strContent= objRegExp.Replace(strContent,"<A HREF=""mailto:$2"">$2</A>")
	objRegExp.Pattern="(\[EMAIL=(.*)\])(.*)(\[\/EMAIL\])"
	strContent= objRegExp.Replace(strContent,"<A HREF=""mailto:$2"" TARGET=_blank>$3</A>")

	objRegExp.Pattern="(\[FLASH\])(.*)(\[\/FLASH\])"
	strContent= objRegExp.Replace(strContent,"<OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><PARAM NAME=movie VALUE=""$2""><PARAM NAME=quality VALUE=high><embed src=""$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$2</embed></OBJECT>")

	objRegExp.Pattern="(\[IMG\])(.*)(\[\/IMG\])"
	strContent=objRegExp.Replace(strContent,"<IMG SRC=""$2"" border=0>")

        objRegExp.Pattern="(\[HTML\])(.*)(\[\/HTML\])"
	strContent=objRegExp.Replace(strContent,"<SPAN><IMG src=pic/code.gif align=absBottom> HTML 代码片段如下:<BR><TEXTAREA style=""WIDTH: 94%; BACKGROUND-COLOR: #f7f7f7"" name=textfield rows=10>$2</TEXTAREA><BR><INPUT onclick=runEx() type=button value=运行此代码 name=Button> [Ctrl+A 全部选择   提示:你可先修改部分代码，再按运行]</SPAN><BR>")

	objRegExp.Pattern="(\[color=(.*)\])(.*)(\[\/color\])"
	strContent=objRegExp.Replace(strContent,"<font color=$2>$3</font>")
	objRegExp.Pattern="(\[face=(.*)\])(.*)(\[\/face\])"
	strContent=objRegExp.Replace(strContent,"<font face=$2>$3</font>")
	objRegExp.Pattern="(\[align=(.*)\])(.*)(\[\/align\])"
	strContent=objRegExp.Replace(strContent,"<div align=$2>$3</div>")

	objRegExp.Pattern="(\[QUOTE\])(.*)(\[\/QUOTE\])"
	strContent=objRegExp.Replace(strContent,"<BLOCKQUOTE><font size=1 face=""Verdana, Arial"">quote:</font><HR>$2<HR></BLOCKQUOTE>")
	objRegExp.Pattern="(\[fly\])(.*)(\[\/fly\])"
	strContent=objRegExp.Replace(strContent,"<marquee width=90% behavior=alternate scrollamount=3>$2</marquee>")
	objRegExp.Pattern="(\[move\])(.*)(\[\/move\])"
	strContent=objRegExp.Replace(strContent,"<MARQUEE scrollamount=3>$2</marquee>")
	objRegExp.Pattern="(\[glow=(.*),(.*),(.*)\])(.*)(\[\/glow\])"
	strContent=objRegExp.Replace(strContent,"<table width=$2 style=""filter:glow(color=$3, strength=$4)"">$5</table>")
	objRegExp.Pattern="(\[SHADOW=(.*),(.*),(.*)\])(.*)(\[\/SHADOW\])"
	strContent=objRegExp.Replace(strContent,"<table width=$2 style=""filter:shadow(color=$3, direction=$4)"">$5</table>")
    
	objRegExp.Pattern="(\[i\])(.*)(\[\/i\])"
	strContent=objRegExp.Replace(strContent,"<i>$2</i>")
	objRegExp.Pattern="(\[u\])(.*)(\[\/u\])"
	strContent=objRegExp.Replace(strContent,"<u>$2</u>")
	objRegExp.Pattern="(\[b\])(.*)(\[\/b\])"
	strContent=objRegExp.Replace(strContent,"<b>$2</b>")
	objRegExp.Pattern="(\[fly\])(.*)(\[\/fly\])"
	strContent=objRegExp.Replace(strContent,"<marquee>$2</marquee>")

	objRegExp.Pattern="(\[size=1\])(.*)(\[\/size\])"
	strContent=objRegExp.Replace(strContent,"<font size=1>$2</font>")
	objRegExp.Pattern="(\[size=2\])(.*)(\[\/size\])"
	strContent=objRegExp.Replace(strContent,"<font size=2>$2</font>")
	objRegExp.Pattern="(\[size=3\])(.*)(\[\/size\])"
	strContent=objRegExp.Replace(strContent,"<font size=3>$2</font>")
	objRegExp.Pattern="(\[size=4\])(.*)(\[\/size\])"
	strContent=objRegExp.Replace(strContent,"<font size=4>$2</font>")

	strContent = doCode(strContent, "[list]", "[/list]", "<ul>", "</ul>")
	strContent = doCode(strContent, "[list=1]", "[/list]", "<ol type=1>", "</ol id=1>")
	strContent = doCode(strContent, "[list=a]", "[/list]", "<ol type=a>", "</ol id=a>")
	strContent = doCode(strContent, "[*]", "[/*]", "<li>", "</li>")
	strContent = doCode(strContent, "[code]", "[/code]", "<pre id=code><font size=1 face=""Verdana, Arial"" id=code>", "</font id=code></pre id=code>")

	set objRegExp=Nothing
	UBBCode=strContent
	End Function

	Public Function ChkClng(ByVal str)
		If str<>"" and IsNumeric(str) Then
			ChkClng = CLng(str)
		Else
			ChkClng = 0
		End If
	End Function

	Public Function ChkCBool(ByVal str)
		If Not IsNull(str) Then
			ChkCBool = CBool(str)
		Else
			ChkCBool = False
		End If
	End Function

	Public Function ChkCDbl(ByVal str)
		If str<>"" and IsNumeric(str) Then
			ChkCDbl = CDbl(str)
		Else
			ChkCDbl = 0
		End If
	End Function

	Public Function ChkNull(ByVal str)
		If IsNull(str) Then
			ChkNull = ""
		Else
			ChkNull = str
		End If
	End Function
		
'检查文件后缀，如果与预定的匹配即返回TRUE
Function CheckExt(FileExt)
	If DimFileExt = "*" Then CheckExt = True
	Ext = Split(DimFileExt,",")
	For i = 0 To Ubound(Ext)
		If Lcase(FileExt) = Ext(i) Then 
			CheckExt = True
			Exit Function
		End If
	Next
End Function
'遍历处理path及其子目录所有文件
Sub HX_ShowAllFile(Path)
	Set FSO = CreateObject("Scripting.FileSystemObject")
	if not fso.FolderExists(path) then exit sub
	Set f = FSO.GetFolder(Path)
	Set fc2 = f.files
	For Each myfile in fc2
		If CheckExt(FSO.GetExtensionName(path&"\"&myfile.name)) Then 
		 SumFiles = SumFiles + 1
		 if HX_ScanFile(Path&"\"&myfile.name) then SumShell=SumShell+1
		end if 
	Next
	Set fc = f.SubFolders
	For Each f1 in fc
		HX_ShowAllFile path&"\"&f1.name
		SumFolders = SumFolders + 1
    Next
	Set FSO = Nothing
End Sub
'检测文件
Function HX_ScanFile(FilePath)
  HX_ScanFile=False
  dim FSOs,ofile,filetxt,DoMyBest,regEx,Matches,Match
	Set FSOs = CreateObject("Scripting.FileSystemObject")
	on error resume next
	set ofile = fsos.OpenTextFile(FilePath)
	filetxt = Lcase(ofile.readall())
	If err Then Exit Function
	if len(filetxt)>0 then
	'特征码检查
	   'Check "WScr"&DoMyBest&"ipt.Shell"
	    If instr( filetxt, Lcase("WScr"&DoMyBest&"ipt.Shell") ) or Instr( filetxt, Lcase("clsid:72C24DD5-D70A"&DoMyBest&"-438B-8A42-98424B88AFB8") ) then HX_ScanFile=True
	   'Check "She"&DoMyBest&"ll.Application"
	    If instr( filetxt, Lcase("She"&DoMyBest&"ll.Application") ) or Instr( filetxt, Lcase("clsid:13709620-C27"&DoMyBest&"9-11CE-A49E-444553540000") ) then HX_ScanFile=True
		if instr( filetxt,"输入马的内容")>0 or instr(filetxt,"保存文件的<font color=red>绝对路径(包括文件名:如D:\web\x.asp):</font>")>0 then ScanFile=True
		'Check .Encode
		 Set regEx = New RegExp
		 regEx.IgnoreCase = True
		 regEx.Global = True
		 regEx.Pattern = "@\s*LANGUAGE\s*=\s*[""]?\s*(vbscript|jscript|javascript).encode\b"
		 If regEx.Test(filetxt) Then HX_ScanFile=True
	    'Check my ASP backdoor :(
		 regEx.Pattern = "\bEv"&"al\b"
		 If regEx.Test(filetxt) Then HX_ScanFile=True
		'Check exe&cute backdoor
		 'regEx.Pattern = "[^.]\bExe"&"cute\b"
		 'If regEx.Test(filetxt) Then HX_ScanFile=True
		 'Set regEx = Nothing
		'Check include file
		 Set regEx = New RegExp
		 regEx.IgnoreCase = True
		 regEx.Global = True
		 regEx.Pattern = "<!--\s*#include\s*file\s*=\s*"".*"""
		 Set Matches = regEx.Execute(filetxt)
		 For Each Match in Matches
			tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","\")
			If Not CheckExt(FSOs.GetExtensionName(tFile)) Then
				Call HX_ScanFile( Mid(FilePath,1,InStrRev(FilePath,"\"))&tFile, replace(FilePath,server.MapPath("\")&"\","",1,1,1) )
				SumFiles = SumFiles + 1
			End If
		 Next
		Set Matches = Nothing
		Set regEx = Nothing
		'Check include virtual
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global = True
		regEx.Pattern = "<!--\s*#include\s*virtual\s*=\s*"".*"""
		Set Matches = regEx.Execute(filetxt)
		For Each Match in Matches
			tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","\")
			If Not CheckExt(FSOs.GetExtensionName(tFile)) Then
				Call HX_ScanFile( Server.MapPath("\")&"\"&tFile, replace(FilePath,server.MapPath("\")&"\","",1,1,1) )
				SumFiles = SumFiles + 1
			End If
		Next
		Set Matches = Nothing
		Set regEx = Nothing
		'Check Server&.Execute|Transfer
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global = True
		regEx.Pattern = "Server.(Exec"&"ute|Transfer)([ \t]*|\()"".*"""
		Set Matches = regEx.Execute(filetxt)
		For Each Match in Matches
			tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","\")
			If Not CheckExt(FSOs.GetExtensionName(tFile)) Then
				Call HX_ScanFile( Mid(FilePath,1,InStrRev(FilePath,"\"))&tFile, replace(FilePath,server.MapPath("\")&"\","",1,1,1) )
				SumFiles = SumFiles + 1
			End If
		Next
		Set Matches = Nothing
		Set regEx = Nothing
		
		'Check Server&.Execute|Transfer
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global = True
		regEx.Pattern = "Server.(Exec"&"ute|Transfer)([ \t]*|\()[^""]\)"
		If regEx.Test(filetxt) Then HX_ScanFile=True
		Set Matches = Nothing
		Set regEx = Nothing
		'Check Crea"&"teObject
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global = True
		regEx.Pattern = "CreateO"&"bject[ |\t]*\(.*\)"
		Set Matches = regEx.Execute(filetxt)
		For Each Match in Matches
			If Instr(Match.Value, "&") or Instr(Match.Value, "+") or Instr(Match.Value, """") = 0 or Instr(Match.Value, "(") <> InStrRev(Match.Value, "(") Then
				HX_ScanFile=True
				exit Function
			End If
		Next
		Set Matches = Nothing
		Set regEx = Nothing
	end if
	set ofile = nothing
	set fsos = nothing	
End Function

Public PrivateKey
Public PublicKey
Public Modulus

Public Function Crypt(pLngMessage, pLngKey)
  On Error Resume Next
  Dim lLngMod
  Dim lLngResult
  Dim lLngIndex
  If pLngKey Mod 2 = 0 Then
    lLngResult = 1
    For lLngIndex = 1 To pLngKey / 2
      lLngMod = (pLngMessage ^ 2) Mod Modulus
      lLngResult = (lLngMod * lLngResult) Mod Modulus
      If Err Then Exit Function
    Next
  Else
    lLngResult = pLngMessage
    For lLngIndex = 1 To pLngKey / 2
     lLngMod = (pLngMessage ^ 2) Mod Modulus
     On Error Resume Next
     lLngResult = (lLngMod * lLngResult) Mod Modulus
     If Err Then Exit Function
    Next
  End If
  Crypt = lLngResult
End Function

Public Function HX_Encode(ByVal pStrMessage)
  Dim lLngIndex
  Dim lLngMaxIndex
  Dim lBytAscii
  Dim lLngEncrypted
  lLngMaxIndex = Len(pStrMessage) 
  If lLngMaxIndex = 0 Then Exit Function 
    For lLngIndex = 1 To lLngMaxIndex 
      lBytAscii = Asc(Mid(pStrMessage, lLngIndex, 1)) 
      lLngEncrypted = Crypt(lBytAscii, PublicKey) 
      HX_Encode = HX_Encode & NumberToHex(lLngEncrypted, 4) 
    Next 
End Function

Public Function HX_Decode(ByVal pStrMessage) 
  Dim lBytAscii 
  Dim lLngIndex 
  Dim lLngMaxIndex 
  Dim lLngEncryptedData 
  HX_Decode = "" 
  lLngMaxIndex = Len(pStrMessage) 
  For lLngIndex = 1 To lLngMaxIndex Step 4 
    lLngEncryptedData = HexToNumber(Mid(pStrMessage, lLngIndex, 4)) 
    lBytAscii = Crypt(lLngEncryptedData, PrivateKey) 
    HX_Decode = HX_Decode & Chr(lBytAscii) 
  Next 
End Function 
     
Private Function NumberToHex(ByRef pLngNumber, ByRef pLngLength) 
  NumberToHex = Right(String(pLngLength, "0") & Hex(pLngNumber), pLngLength) 
End Function 

Private Function HexToNumber(ByRef pStrHex) 
  HexToNumber = CLng("&h" & pStrHex) 
End Function 

function Encryptstr(Message) 
Dim LngKeyE 
Dim LngKeyD 
Dim LngKeyN 
Dim StrMessage 
Dim ObjRSA 
    LngKeyE = "32823" 
    LngKeyD = "20643" 
    LngKeyN = "29893" 
    StrMessage = Message      
     PublicKey = LngKeyE 
     Modulus = LngKeyN 
     Encryptstr = HX_Encode(StrMessage) 
end function 

function decryptstr(Message) 
Dim LngKeyE 
Dim LngKeyD 
Dim LngKeyN 
Dim StrMessage 
Dim ObjRSA 
    LngKeyE = "32823" 
    LngKeyD = "20643" 
    LngKeyN = "29893" 
    StrMessage = Message 
        PrivateKey =LngKeyD 
        Modulus=LngKeyN 
        decryptstr=HX_Decode(StrMessage) 
end function 

END CLASS
%>