function.asp

江西旅行网整站源码下载 希望对大家有用 经过测试 安全可用

    End If
    i = Len(names(1)) - InStrRev(names(1), ".")
    If i <> 2 And i <> 3 And i <> 4 Then
       IsValidEmail = False
       Exit Function
    End If
    If InStr(email, "..") > 0 Then
       IsValidEmail = False
    End If
End Function



'得到数组中某个元素的值
Public Function GetArrItem(ByVal arrTemp, ByVal ItemIndex)
    If Not IsArray(arrTemp) Then
        GetArrItem = ""
        Exit Function
    End If
    ItemIndex = PE_CLng(ItemIndex)
    If ItemIndex < 0 Or ItemIndex > UBound(arrTemp) Then
        GetArrItem = ""
        Exit Function
    End If
    Dim strTemp
    strTemp = arrTemp(ItemIndex)
    If InStr(strTemp, "|") > 0 Then
        GetArrItem = Left(strTemp, InStr(strTemp, "|") - 1)
    Else
        GetArrItem = strTemp
    End If
End Function

'把数组变成下拉列表项目
Public Function Array2Option(ByVal arrTemp, ByVal ID)
    Dim strOption, i, arrValue
    strOption = "<option value='-1'> </option>"
    ID = PE_CLng(ID)
    For i = 0 To UBound(arrTemp)
        arrValue = Split(arrTemp(i), "|")
        If CLng(arrValue(1)) = 1 Then
            If ID > -1 Then
                If i = ID Then
                    strOption = strOption & "<option value='" & i & "' selected>" & arrValue(0) & "</option>"
                Else
                    strOption = strOption & "<option value='" & i & "'>" & arrValue(0) & "</option>"
                End If
            Else
                If CLng(arrValue(2)) = 1 Then
                    strOption = strOption & "<option value='" & i & "' selected>" & arrValue(0) & "</option>"
                Else
                    strOption = strOption & "<option value='" & i & "'>" & arrValue(0) & "</option>"
                End If
            End If
        End If
    Next
    Array2Option = strOption
End Function

Function GetRndPassword(PasswordLen)
    Dim Ran, i, strPassword
    strPassword = ""
    For i = 1 To PasswordLen
        Randomize
        Ran = CInt(Rnd * 2)
        Randomize
        If Ran = 0 Then
            Ran = CInt(Rnd * 25) + 97
            strPassword = strPassword & UCase(Chr(Ran))
        ElseIf Ran = 1 Then
            Ran = CInt(Rnd * 9)
            strPassword = strPassword & Ran
        ElseIf Ran = 2 Then
            Ran = CInt(Rnd * 25) + 97
            strPassword = strPassword & Chr(Ran)
        End If
    Next
    GetRndPassword = strPassword
End Function

Function GetScriptPath(ByVal ScriptName, ParentLevel)
    Dim i
    GetScriptPath = "/"
    If ScriptName = "" Or IsNull(ScriptName) Then Exit Function
    If ParentLevel > 1 Then ParentLevel = 1
    If ParentLevel = 0 Then
        GetScriptPath = Left(ScriptName, InStrRev(ScriptName, "/"))
    ElseIf ParentLevel = 1 Then
        i = InStrRev(ScriptName, "/") - 1
        If i < 1 Then i = 1
        GetScriptPath = Left(ScriptName, InStrRev(ScriptName, "/", i))
    End If
    If Right(GetScriptPath, 1) <> "/" Then GetScriptPath = GetScriptPath & "/"
End Function

'判断当前访问者是否已经登录，若已登录，则读取数据并做必要赋值
Function CheckUserLogined()
    Dim UserPassword, LastPassword
    Dim rsUser, sqlUser
    Dim rsConfig

    UserName = ReplaceBadChar(Trim(Request.Cookies(Site_Sn)("UserName")))
    UserPassword = ReplaceBadChar(Trim(Request.Cookies(Site_Sn)("UserPassword")))
    LastPassword = ReplaceBadChar(Trim(Request.Cookies(Site_Sn)("LastPassword")))
    UserID = 0
    ClientID = 0
    CompanyID = 0
    ContacterID = 0
    UserType = 0
    GroupID = 0
    GroupType = 0
    GroupName = "游客"
    Discount_Member = 100
    Balance = 0
    UserPoint = 0
    UserExp = 0
    IsOffer = "否"
    
    If (UserName = "" Or UserPassword = "" Or LastPassword = "") Then
        CheckUserLogined = False
        Exit Function
    End If

    sqlUser = "SELECT U.*,G.GroupName,G.GroupType,G.GroupSetting,G.arrClass_Input as G_arrClass_Input,G.arrClass_View as G_arrClass_View FROM PE_User U inner join PE_UserGroup G on U.GroupID=G.GroupID WHERE"
    sqlUser = sqlUser & " U.UserName='" & UserName & "' AND U.UserPassword='" & UserPassword & "' AND U.LastPassword='" & LastPassword & "' and IsLocked=" & PE_False & ""
    Set rsUser = Conn.Execute(sqlUser)
    If rsUser.EOF And rsUser.BOF Then
        CheckUserLogined = False
    Else
        CheckUserLogined = True
        UserID = rsUser("UserID")
        ClientID = rsUser("ClientID")
        CompanyID = rsUser("CompanyID")
        ContacterID = rsUser("ContacterID")
        UserType = rsUser("UserType")
        UserName = rsUser("UserName")
        UserPassword = rsUser("UserPassword")
        LastPassword = rsUser("LastPassword")
        email = rsUser("Email")
        Balance = PE_CDbl(rsUser("Balance"))
        UserPoint = PE_CLng(rsUser("UserPoint"))
        UserExp = PE_CLng(rsUser("UserExp"))
        ValidNum = rsUser("ValidNum")
        LoginTimes = rsUser("LoginTimes")
        ValidDays = ChkValidDays(rsUser("ValidNum"), rsUser("ValidUnit"), rsUser("BeginTime"))
        GroupID = rsUser("GroupID")
        GroupName = rsUser("GroupName")
        GroupType = rsUser("GroupType")
        SpecialPermission = rsUser("SpecialPermission")
        If SpecialPermission = True Then
            UserSetting = Split(rsUser("UserSetting") & ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0", ",")
            arrClass_Input = rsUser("arrClass_Input")
            arrClass_View = rsUser("arrClass_View")
        Else
            UserSetting = Split(rsUser("GroupSetting") & ",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0", ",")
            arrClass_Input = rsUser("G_arrClass_Input")
            arrClass_View = rsUser("G_arrClass_View")
        End If
        Discount_Member = PE_CDbl(UserSetting(11))
        If PE_CLng(UserSetting(12)) = 1 Then
            IsOffer = "是"
        Else
            IsOffer = "否"
        End If
        ChargeType = PE_CLng(UserSetting(14))
        UnsignedItems = rsUser("UnsignedItems")
        UnreadMsg = PE_CLng(rsUser("UnreadMsg"))
        RegTime = rsUser("RegTime")
        JoinTime = rsUser("JoinTime")
        LoginTimes = rsUser("LoginTimes")
        LastLoginTime = rsUser("LastLoginTime")
        LastLoginIP = rsUser("LastLoginIP")

        If PresentExpPerLogin > 0 Then
            If DateDiff("D", rsUser("LastPresentTime"), Now()) > 0 Then
                Conn.Execute ("update PE_User set UserExp=UserExp+" & PresentExpPerLogin & ",LastPresentTime=" & PE_Now & " where UserID=" & UserID & "")
            End If
        End If
        If PE_CLng(Session("UserID")) = 0 Then
            UserTrueIP=ReplaceBadChar(UserTrueIP)
            Conn.Execute ("update PE_User set LastLoginIP='" & UserTrueIP & "',LastLoginTime=" & PE_Now & ",LoginTimes=LoginTimes+1 where UserID=" & UserID & "")
            Session("UserID") = UserID
        End If
    End If
    Set rsUser = Nothing
    DefaultTemplateProjectName = GetDefaultTemplateProjectName()

End Function

Function GetDefaultTemplateProjectName()
    Dim rsProject, strProjectName
    Set rsProject = Conn.Execute("select TemplateProjectName from PE_TemplateProject where IsDefault=" & PE_True)
    If Not rsProject.EOF Then
        strProjectName = rsProject("TemplateProjectName")
    Else
        strProjectName = "动易2006海蓝方案"
    End If
    Set rsProject = Nothing
    GetDefaultTemplateProjectName = strProjectName
End Function

Function GetClientName(ClientID)
    If ClientID <= 0 Then
        GetClientName = ""
        Exit Function
    End If
    Dim rsClient
    Set rsClient = Conn.Execute("select ClientName from PE_Client where ClientID=" & ClientID & "")
    If rsClient.BOF And rsClient.EOF Then
        GetClientName = ""
    Else
        GetClientName = rsClient(0)
    End If
    rsClient.Close
    Set rsClient = Nothing
End Function


Function GetGroupName(iGroupID)
    Dim rsGroup
    Set rsGroup = Conn.Execute("select GroupName from PE_UserGroup where GroupID=" & iGroupID & "")
    If rsGroup.BOF And rsGroup.EOF Then
        GetGroupName = "未知"
    Else
        GetGroupName = rsGroup(0)
    End If
    Set rsGroup = Nothing
End Function

Function CheckBadChar(strChar)
    Dim strBadChar, arrBadChar, i
    strBadChar = "@@,+,',--,%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & ""
    arrBadChar = Split(strBadChar, ",")
    If strChar = "" Then
        CheckBadChar = False
    Else
        For i = 0 To UBound(arrBadChar)
            If InStr(strChar, arrBadChar(i)) > 0 Then
                CheckBadChar = False
                Exit Function
            End If
        Next
    End If
    CheckBadChar = True
End Function

Function ReplaceUrlBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceUrlBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "+,',--,(,),<,>,[,],{,},\,;," & Chr(34) & "," & Chr(0) & ""
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    tempChar = Replace(tempChar, "@@", "@")
    ReplaceUrlBadChar = tempChar
End Function

Function GetNewID(SheetName, FieldName)
    Dim mrs
    Set mrs = Conn.Execute("select max(" & FieldName & ") from " & SheetName & "")
    If IsNull(mrs(0)) Then
        GetNewID = 1
    Else
        GetNewID = mrs(0) + 1
    End If
    Set mrs = Nothing
End Function

Function GetArrFromDictionary(strTableName, strFieldName)
    Dim rsDictionary
    Set rsDictionary = Conn.Execute("select FieldValue from PE_Dictionary where TableName='" & strTableName & "' and FieldName='" & strFieldName & "'")
    If rsDictionary.BOF And rsDictionary.EOF Then
        GetArrFromDictionary = ""
    Else
        GetArrFromDictionary = rsDictionary(0)
    End If
    Set rsDictionary = Nothing
End Function

Function ChkValidDays(iValidNum, iValidUnit, iBeginTime)
    If (iValidNum = "" Or IsNumeric(iValidNum) = False Or iValidUnit = "" Or IsNumeric(iValidUnit) = False Or iBeginTime = "" Or IsDate(iBeginTime) = False) Then
        ChkValidDays = 0
        Exit Function
    End If
    Dim tmpDate, arrInterval
    arrInterval = Array("h", "D", "m", "yyyy")
    If iValidNum = -1 Then
        ChkValidDays = 99999
    Else
        tmpDate = DateAdd(arrInterval(iValidUnit), iValidNum, iBeginTime)
        ChkValidDays = DateDiff("D", Date, tmpDate)
    End If
End Function
'**************************************************
'函数名：PE_ServerHTMLEncode
'作  用：显示HTML代码
'参  数：Content ---- 要输出HTML的字符串
'返回值：处理后的字符串
'**************************************************
Function PE_ServerHTMLEncode(ByVal Content)
    If IsNull(Content) Then
        PE_ServerHTMLEncode = ""
    Else
        PE_ServerHTMLEncode = Server.HTMLEncode(Content)
    End If
End Function
'**************************************************
'函数名：nohtml
'作  用：过滤html 元素
'参  数：str ---- 要过滤字符
'返回值：没有html 的字符
'**************************************************
Public Function nohtml(ByVal str)
    If IsNull(str) Or Trim(str) = "" Then
        nohtml = ""
        Exit Function
    End If
    Dim re
    Set re = New RegExp
    re.IgnoreCase = True
    re.Global = True
    re.Pattern = "(\<.[^\<]*\>)"
    str = re.Replace(str, " ")
    re.Pattern = "(\<\/[^\<]*\>)"
    str = re.Replace(str, " ")
    Set re = Nothing
    
    str = Replace(str, "'", "")
    str = Replace(str, Chr(34), "")
    nohtml = str
End Function
'=================================================
'函数名：ReplaceBadUrl
'作  用：过滤非法Url地址函数
'=================================================
Public Function ReplaceBadUrl(ByVal strContent)
    Dim  regEx,Matches,Match

    Set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    
    regEx.Pattern = "(a|%61|%41)(d|%64|%44)(m|%6D|4D)(i|%69|%49)(n|%6E|%4E)(\_|%5F)(.*?)(.|%2E)(a|%61|%41)(s|%73|%53)(p|%70|%50)"
    Set Matches = regEx.Execute(strContent)
    For Each Match In Matches
        strContent = Replace(strContent, Match.Value, "")
    Next
    regEx.Pattern = "(u|%75|%55)(s|%73|%53)(e|%65|%45)(r|%72|%52)(\_|%5F)(.*?)(.|%2E)(a|%61|%41)(s|%73|%53)(p|%70|%50)"
    Set Matches = regEx.Execute(strContent)
    For Each Match In Matches
        strContent = Replace(strContent, Match.Value, "")
    Next

    Set regEx = Nothing
    ReplaceBadUrl = strContent
End Function

%>