<%
Dim Action, FoundErr, ErrMsg, ComeUrl
Dim strInstallDir
Dim Site_Sn   '定义系统识别码

'定义用户相关的变量
Dim UserLogined, GroupID, GroupName, GroupType, Discount_Member, IsOffer
Dim UserID, UserName, NickName, ClientNum, UserType, TrueName, Company, Department
Dim email, Homepage, QQ, ICQ, MSN, Yahoo, UC, Aim, OfficePhone, HomePhone, Fax, Mobile, Country, Province, City, Address, ZipCode
Dim Balance, UserPoint, UserExp, ChargeType, ValidNum, ValidDays, SpecialPermission, UserSetting
Dim UnsignedItems, UnreadMsg, arrClass_Input, arrClass_View
If Request("ComeUrl") = "" Then
    ComeUrl = Trim(Request.ServerVariables("HTTP_REFERER"))
Else
    ComeUrl = Trim(Request("ComeUrl"))
End If
Action = Trim(Request("Action"))
FoundErr = False
ErrMsg = ""
'If Right(InstallDir, 1) <> "/" Then
'    strInstallDir = InstallDir & "/"
'Else
'    strInstallDir = InstallDir
'End If
'Site_Sn = Replace(Replace(LCase(Request.ServerVariables("SERVER_NAME") & InstallDir), "/", ""), ".", "")

'**************************************************
'函数名：gotTopic
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       strlen ----截取长度
'返回值：截取后的字符串
'**************************************************
Function gotTopic(ByVal str, ByVal strlen)
    If str = "" Then
        gotTopic = ""
        Exit Function
    End If
    Dim l, t, c, i, strTemp
    str = Replace(Replace(Replace(Replace(str, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
    l = Len(str)
    t = 0
    strTemp = str
    strlen = CLng(strlen)
    For i = 1 To l
        c = Abs(Asc(Mid(str, i, 1)))
        If c > 255 Then
            t = t + 2
        Else
            t = t + 1
        End If
        If t >= strlen Then
            strTemp = Left(str, i)
            Exit For
        End If
    Next
    If strTemp <> str Then
        strTemp = strTemp & "…"
    End If
    gotTopic = Replace(Replace(Replace(Replace(strTemp, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
End Function

'**************************************************
'函数名：JoinChar
'作  用：向地址中加入 ? 或 &
'参  数：strUrl  ----网址
'返回值：加了 ? 或 & 的网址
'**************************************************
Function JoinChar(ByVal 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

'**************************************************
'函数名：ShowPage
'作  用：显示“上一页 下一页”等信息
'参  数：sFileName  ----链接地址
'       TotalNumber ----总数量
'       MaxPerPage  ----每页数量
'       ShowTotal   ----是否显示总数量
'       ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
'       strUnit     ----计数单位
'返回值：“上一页 下一页”等信息的HTML代码
'**************************************************
Function ShowPage(sFileName, TotalNumber, MaxPerPage, ShowTotal, ShowAllPages, strUnit)
    Dim TotalPage, strTemp, strUrl, i

    If TotalNumber = 0 Or MaxPerPage = 0 Or IsNull(MaxPerPage) Then
        ShowPage = ""
        Exit Function
    End If
    If TotalNumber Mod MaxPerPage = 0 Then
        TotalPage = TotalNumber \ MaxPerPage
    Else
        TotalPage = TotalNumber \ MaxPerPage + 1
    End If
    If CurrentPage > TotalPage Then CurrentPage = TotalPage
        
    strTemp = "<table align='center'><tr><td>"
    If ShowTotal = True Then
        strTemp = strTemp & "共 <b>" & TotalNumber & "</b> " & strUnit & "&nbsp;&nbsp;"
    End If
    strUrl = JoinChar(sFileName)
    If CurrentPage < 2 Then
        strTemp = strTemp & "首页 上一页&nbsp;"
    Else
        strTemp = strTemp & "<a href='" & strUrl & "page=1'>首页</a>&nbsp;"
        strTemp = strTemp & "<a href='" & strUrl & "page=" & (CurrentPage - 1) & "'>上一页</a>&nbsp;"
    End If

    If CurrentPage >= TotalPage Then
        strTemp = strTemp & "下一页 尾页"
    Else
        strTemp = strTemp & "<a href='" & strUrl & "page=" & (CurrentPage + 1) & "'>下一页</a>&nbsp;"
        strTemp = strTemp & "<a href='" & strUrl & "page=" & TotalPage & "'>尾页</a>"
    End If
    strTemp = strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & TotalPage & "</strong>页 "
    strTemp = strTemp & "&nbsp;<b>" & MaxPerPage & "</b>" & strUnit & "/页"
    If ShowAllPages = True Then
        strTemp = strTemp & "&nbsp;&nbsp;转到第<input type='text' name='page' size='3' maxlength='5' value='" & CurrentPage & "' onKeyPress=""If (event.keyCode==13);window.location='" & strUrl & "page=" & "'+this.value;""'>页"
        'strTemp=strTemp & "&nbsp;转到：<select name='page' size='1' onchange=""javascript:window.location='" & strUrl & "page=" & "'+this.options[this.selectedIndex].value;"">"
        'for i = 1 to TotalPage
        '   strTemp=strTemp & "<option value='" & i & "'"
        '   If cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
        '   strTemp=strTemp & ">第" & i & "页</option>"
        'next
        'strTemp=strTemp & "</select>"
    End If
    strTemp = strTemp & "</td></tr></table>"
    ShowPage = strTemp
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


'**************************************************
'函数：FoundInArr
'作  用：检查一个数组中所有元素是否包含指定字符串
'参  数：strArr     ----存储数据数据的字串
'       strToFind    ----要查找的字符串
'       strSplit    ----数组的分隔符
'返回值：True,False
'**************************************************
Function FoundInArr(strArr, strToFind, strSplit)
    Dim arrTemp, i
    FoundInArr = False
    If InStr(strArr, strSplit) > 0 Then
        arrTemp = Split(strArr, strSplit)
        For i = 0 To UBound(arrTemp)
        If LCase(Trim(arrTemp(i))) = LCase(Trim(strToFind)) Then
            FoundInArr = True
            Exit For
        End If
        Next
    Else
        If LCase(Trim(strArr)) = LCase(Trim(strToFind)) Then
        FoundInArr = True
        End If
    End If
End Function

'**************************************************
'过程名：WriteErrMsg
'作  用：显示错误提示信息
'参  数：无
'**************************************************
Sub WriteErrMsg(ErrMsg)
    Dim strErr
	ComeUrl=Request.ServerVariables("HTTP_REFERER")
	strErr = strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
    strErr = strErr & "</head><body>" & vbCrLf
    strErr = strErr & "<table border='1' width='400' align='center' cellpadding='2' cellspacing='0' bordercolor='#A0D3FE' bgcolor='#EEF9FD' style='BORDER-COLLAPSE: collapse'>" & vbCrLf
    strErr = strErr & "  <tr align='center'><td height='22' class='title'><strong>错误信息</strong></td></tr>" & vbCrLf
    strErr = strErr & "  <tr><td height='100' valign='top'><b>产生错误的可能原因：</b><br>" & ErrMsg & "</td></tr>" & vbCrLf
	IF instr(ComeUrl,"login.asp?action=chk")>0 	then
	ComeUrl=Replace(ComeUrl,"login.asp?action=chk","")
	strErr = strErr & "  <tr><td height='18'><a href='"&ComeUrl&"'>&lt;&lt; 【返回上一页】</a>"
	Else
	strErr = strErr & "  <tr><td height='18'><a href='javascript:history.go(-1)'>&lt;&lt; 【返回上一页】</a>"
	End IF
	strErr = strErr & "   <a href='javascript:window.close();'>【关闭】</a></td></tr>"
    strErr = strErr & "</table>" & vbCrLf
    strErr = strErr & "</body></html>" & vbCrLf
    Response.Write strErr
End Sub

'**************************************************
'过程名：WriteSuccessMsg
'作  用：显示成功提示信息
'参  数：无
'**************************************************
Sub WriteSuccessMsg(SuccessMsg)
    Dim strSuccess
    strSuccess = strSuccess & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
    strSuccess = strSuccess & "<link href='Admin/Admin_Style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbCrLf
    strSuccess = strSuccess & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
    strSuccess = strSuccess & "  <tr align='center' class='title'><td height='22'><strong>恭喜你！</strong></td></tr>" & vbCrLf
    strSuccess = strSuccess & "  <tr class='tdbg'><td height='100' valign='top'><br>" & SuccessMsg & "</td></tr>" & vbCrLf
    strSuccess = strSuccess & "  <tr align='center' class='tdbg'><td>"
    If ComeUrl <> "" Then
        strSuccess = strSuccess & "<a href='" & ComeUrl & "'>&lt;&lt; 返回上一页</a>"
    Else
        strSuccess = strSuccess & "<a href='javascript:window.close();'>【关闭】</a>"
    End If
    strSuccess = strSuccess & "</td></tr>" & vbCrLf
    strSuccess = strSuccess & "</table>" & vbCrLf
    strSuccess = strSuccess & "</body></html>" & vbCrLf
    Response.Write strSuccess
End Sub

'**************************************************
'函数名：ReplaceBadChar
'作  用：过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        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
    ReplaceBadChar = tempChar
End Function

Function PE_CLng(ByVal str1)
    If IsNumeric(str1) Then
        PE_CLng = CLng(str1)
    Else
        PE_CLng = 0
    End If
End Function

Function PE_CDbl(ByVal str1)
    If IsNumeric(str1) Then
        PE_CDbl = CDbl(str1)
    Else
        PE_CDbl = 0
    End If
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 And i <> 4 Then
       IsValidEmail = False
       Exit Function
    End If
    If InStr(email, "..") > 0 Then
       IsValidEmail = False
    End If
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 TempDays
    If iValidNum = -1 Then
        ChkValidDays = 99999
    Else
        If iValidUnit = 1 Then
            TempDays = iValidNum
        ElseIf iValidUnit = 2 Then
            TempDays = iValidNum * 30
        ElseIf iValidUnit = 3 Then
            TempDays = iValidNum * 365
        End If
        ChkValidDays = TempDays - DateDiff("D", iBeginTime, Now())
    End If
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 CheckUserLogined()
Dim hl_user,UserID
Dim rsUser, sqlUser
hl_user=session("hl_user")
If hl_user="" Then
        CheckUserLogined = False
        Exit Function
End If
sqlUser="select * from hl_user where username='"&hl_user&"'"
Set rsUser = Conn.Execute(sqlUser)
If rsUser.EOF And rsUser.bof Then
     CheckUserLogined = False
Else
	 CheckUserLogined = True
     UserID=rsUser("id")
	 End If
Set rsUser = Nothing
End Function
%>