hx_system.asp

带OA办公的动态源码网站

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<%
dim a125db_All
 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")