📄 powereasy.common.all.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
        strTemp = strTemp & "FirstPage PreviousPage&nbsp;"
    Else
        strTemp = strTemp & "<a href='" & strUrl & "page=1'>FirstPage</a>&nbsp;"
        strTemp = strTemp & "<a href='" & strUrl & "page=" & (CurrentPage - 1) & "'>PreviousPage</a>&nbsp;"
    End If

    If CurrentPage >= TotalPage Then
        strTemp = strTemp & "NextPage LastPage"
    Else
        strTemp = strTemp & "<a href='" & strUrl & "page=" & (CurrentPage + 1) & "'>NextPage</a>&nbsp;"
        strTemp = strTemp & "<a href='" & strUrl & "page=" & TotalPage & "'>LastPage</a>"
    End If
    strTemp = strTemp & " CurrentPage: <strong><font color=red>" & CurrentPage & "</font>/" & TotalPage & "</strong> "
    If ShowMaxPerPage = True Then
        strTemp = strTemp & " <Input type='text' name='MaxPerPage' size='3' maxlength='4' value='" & MaxPerPage & "' onKeyPress=""if (event.keyCode==13) window.location='" & JoinChar(sfilename) & "page=" & CurrentPage & "&MaxPerPage=" & "'+this.value;"">" & strUnit & "/Page"
    Else
        strTemp = strTemp & " <b>" & MaxPerPage & "</b>" & strUnit & "/Page"
    End If
    If ShowAllPages = True Then
        If TotalPage > 20 Then
            strTemp = strTemp & "&nbsp;&nbsp;GoTo Page:<Input type='text' name='page' size='3' maxlength='5' value='" & CurrentPage & "' onKeyPress=""if (event.keyCode==13) window.location='" & strUrl & "page=" & "'+this.value;"">"
        Else
            strTemp = strTemp & "&nbsp;GoTo:<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 PE_CLng(CurrentPage) = PE_CLng(i) Then strTemp = strTemp & " selected "
               strTemp = strTemp & ">Page" & i & "</option>"
            Next
            strTemp = strTemp & "</select>"
        End If
    End If
    strTemp = strTemp & "</div>"
    ShowPage_en = strTemp
End Function



'**************************************************
'函数名：IsObjInstalled
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'        False ----没有安装
'**************************************************
Function IsObjInstalled(strClassString)
    On Error Resume Next
    IsObjInstalled = False
    Err = 0
    Dim xTestObj
    Set xTestObj = CreateObject(strClassString)
    If Err.Number = 0 Then IsObjInstalled = True
    Set xTestObj = Nothing
    Err = 0
End Function


'**************************************************
'过程名：WriteErrMsg
'作  用：显示错误提示信息
'参  数：无
'**************************************************
Sub WriteErrMsg(sErrMsg, sComeUrl)
    Response.Write "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
    Response.Write "<link href='" & strInstallDir & "images/Style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbCrLf
    Response.Write "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
    Response.Write "  <tr align='center' class='title'><td height='22'><strong>错误信息</strong></td></tr>" & vbCrLf
    Response.Write "  <tr class='tdbg'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & sErrMsg & "</td></tr>" & vbCrLf
    Response.Write "  <tr align='center' class='tdbg'><td>"
    If sComeUrl <> "" Then
        Response.Write "<a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a>"
    Else
        Response.Write "<a href='javascript:window.close();'>【关闭】</a>"
    End If
    Response.Write "</td></tr>" & vbCrLf
    Response.Write "</table>" & vbCrLf
    Response.Write "</body></html>" & vbCrLf
End Sub

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

'**************************************************
'函数名：FoundInArr
'作  用：检测数组中是否有指定的数值
'参  数：strArr ----- 调入的数组
'        strItem  ----- 检测的字符
'        strSplit  ----- 分割字符
'返回值：True  ----有
'        False ----没有
'**************************************************
Function FoundInArr(strArr, strItem, strSplit)
    Dim arrTemp, arrTemp2, i, j
    FoundInArr = False
    If IsNull(strArr) Or IsNull(strItem) Or Trim(strArr) = "" Or Trim(strItem) = "" Then
        Exit Function
    End If
    If IsNull(strSplit) Or strSplit = "" Then
        strSplit = ","
    End If
    If InStr(Trim(strArr), strSplit) > 0 Then
        If InStr(Trim(strItem), strSplit) > 0 Then
            arrTemp = Split(strArr, strSplit)
            arrTemp2 = Split(strItem, strSplit)
            For i = 0 To UBound(arrTemp)
                For j = 0 To UBound(arrTemp2)
                    If LCase(Trim(arrTemp2(j))) <> "" And LCase(Trim(arrTemp(i))) <> "" And LCase(Trim(arrTemp2(j))) = LCase(Trim(arrTemp(i))) Then
                        FoundInArr = True
                        Exit Function
                    End If
                Next
            Next
        Else
            arrTemp = Split(strArr, strSplit)
            For i = 0 To UBound(arrTemp)
                If LCase(Trim(arrTemp(i))) = LCase(Trim(strItem)) Then
                    FoundInArr = True
                    Exit Function
                End If
            Next
        End If
    Else
        If LCase(Trim(strArr)) = LCase(Trim(strItem)) Then
            FoundInArr = True
        End If
    End If
End Function

'**************************************************
'函数名：GetRndPassword
'作  用：得到指定位数的随机数密码
'参  数：PasswordLen ---- 位数
'返回值：密码字符串
'**************************************************
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

'**************************************************
'函数名：GetRndNum
'作  用：产生制定位数的随机数
'参  数：iLength ---- 随即数的位数
'返回值：随机数
'**************************************************
Function GetRndNum(iLength)
    Dim i, str1
    For i = 1 To (iLength \ 5 + 1)
        Randomize
        str1 = str1 & CStr(CLng(Rnd * 90000) + 10000)
    Next
    GetRndNum = Left(str1, iLength)
End Function

'**************************************************
'函数名：GetIDByDefault
'作  用：获取ID值，如果ID为0，则使用缺省值
'参  数：ItemID ---- 项目ID值
'        DefaultID ---- 缺省ID值
'**************************************************
Function GetIDByDefault(ItemID, DefaultID)
    Dim iItemID
    iItemID = ItemID
    If iItemID = 0 Then iItemID = DefaultID
    If IsNull(iItemID) Then iItemID = 0
    GetIDByDefault = iItemID
End Function




'**************************************************
'函数名：FillInArrStr
'作  用：使用一个用逗号分隔的字符串来填充另外一个逗号分隔的字符串，使其达到指定的项目数
'参  数：strSource ---- 原字符串
'        strFill ---- 填充字符串
'        ItemNum ---- 指定填充后的项目数
'返回值：填充后的字符串
'**************************************************
Function FillInArrStr(ByVal strSource, ByVal strFill, ItemNum)
    Dim arrSource, arrFill, SourceItemNum, FillItemNum, i
    If IsNull(strSource) Or IsNull(strFill) Then
        FillInArrStr = ""
        Exit Function
    End If
    arrSource = Split(strSource, ",")
    arrFill = Split(strFill, ",")
    SourceItemNum = UBound(arrSource) + 1
    FillItemNum = UBound(arrFill) + 1
    If SourceItemNum < ItemNum And SourceItemNum + FillItemNum >= ItemNum Then
        For i = 0 To ItemNum - SourceItemNum - 1
            strSource = strSource & "," & arrFill(SourceItemNum + FillItemNum - ItemNum + i)
        Next
    End If
    FillInArrStr = strSource
End Function

'**************************************************
'函数名：XmlText
'作  用：从语言包中读取指定节点的值
'参  数：iBigNode ---- 大节点
'        iSmallNode ---- 小节点
'        DefChar ---- 默认值
'返回值：语言包中指定节点的值
'**************************************************
Function XmlText(ByVal iBigNode, ByVal iSmallNode, ByVal DefChar)
    Dim LangRoot, LangSub
    If IsNull(iBigNode) Or IsNull(iSmallNode) Then
        XmlText = DefChar
    Else
        Set LangRoot = XmlDoc.getElementsByTagName(iBigNode)
        If LangRoot.Length = 0 Then
            XmlText = DefChar
        Else
            Set LangSub = LangRoot(0).getElementsByTagName(iSmallNode)
            If LangSub.Length = 0 Then
                XmlText = DefChar
            Else
                XmlText = LangSub(0).text
            End If
        End If
        Set LangRoot = Nothing
    End If
End Function


'**************************************************
'函数名：GetFirstSeparatorToEnd
'作  用：截取从第一个分隔符到结尾的字符串
'参  数：str   ----原字符串
'        separator ----分隔符
'返回值：截取后的字符串
'**************************************************
Function GetFirstSeparatorToEnd(ByVal str, separator)
    GetFirstSeparatorToEnd = Right(str, Len(str) - InStr(str, separator))
End Function

'**************************************************
'函数名：ChkValidDays
'作  用：有效期的函数
'参  数：iValidNum ----有效期
'        iValidUnit ----有效期单位
'        iBeginTime ---- 开始计算日期
'返回值：剩余的有效天数
'**************************************************
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

'**************************************************
'函数名：GetNumString
'作  用：获得项目随即数
'返回值：随机无重复的数字(用于上传,生成)
'**************************************************
Function GetNumString()
    Dim v_ymd, v_hms, v_mmm
    v_ymd = Year(Now) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2)
    v_hms = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
    Randomize
    v_mmm = Right("0" & CStr(CLng(99 * Rnd) + 1), 2)
    GetNumString = v_ymd & v_hms & v_mmm
End Function

'**************************************************
'函数名：GetMinID
'作  用：取某一表某一字段中的最大值
'参  数：SheetName ----查询表
'        FieldName ----查询字段
'返回值：该字段最小值
'**************************************************
Function GetMinID(SheetName, FieldName)
    Dim mrs
    Set mrs = Conn.Execute("select min(" & FieldName & ") from " & SheetName & "")
    If IsNull(mrs(0)) Then
        GetMinID = 1
    Else
        GetMinID = mrs(0)
    End If
    Set mrs = Nothing
End Function

'**************************************************
'函数名：GetNewID
'作  用：取某一表某一字段中的最大值+1
'参  数：SheetName ----查询表
'        FieldName ----查询字段
'返回值：该字段最大值+1
'**************************************************
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

'**************************************************
'函数名：PE_Replace
'作  用：容错替换
'参  数：expression ---- 主数据
'        find ---- 被替换的字符
'        replacewith ---- 替换后的字符
'返回值：容错后的替换字符串,如果 replacewith 空字符,被替换的字符 替换成空
'**************************************************
Function PE_Replace(ByVal expression, ByVal find, ByVal replacewith)
    If IsNull(expression) Or IsNull(find) Then
        PE_Replace = expression
    ElseIf IsNull(replacewith) Then
        PE_Replace = Replace(expression, find, "")
    Else
        PE_Replace = Replace(expression, find, replacewith)
    End If
End Function

%>
上一页 12
💿 文件大小 7095 K
👤 上传用户 foreverlovely
📂 所属分类家庭/个人应用
🏷️ 相关标签

#网站 #比较
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -