⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 page

📁 WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品
💻
字号:
Public ID, Count, Size, Total
Public DataType, Table, Column, Where, Sort, SortType, Index
Private xmlDoc, xmlRoot, xmlPage, xmlRows

Private Sub Class_Initialize()
    Set xmlDoc = xml.cloneNode(True)
    xmlDoc.appendChild xmlDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""utf-8""")
    Set xmlRoot = xmlDoc.appendChild(xmlDoc.createElement("root"))
    Set xmlPage = xmlRoot.appendChild(xmlDoc.createElement("page"))
    Column = "*"
    Total = 0
End Sub

Private Sub Class_Terminate()
    Set xmlRows = Nothing
    Set xmlPage = Nothing
    Set xmlRoot = Nothing
    Set xmlDoc = Nothing
End Sub

Public Property Get Page()
    Set Page = xmlPage
End Property

Public Property Get Rows()
    Set Rows = xmlRows
End Property

Public Sub Build(ByVal strParent, ByVal strChild)
    Dim xmlTemp, lngMove, lngFlag
    Dim rs, strSQL
    If ID < 1 Then ID = 1
    Total = (Count \ Size) + IIf(Count Mod Size = 0, 0, 1)
    If Total < 1 Then Total = 1
    If ID > Total Then ID = Total
    If Count = 0 Then
        lngMove = 0
        lngFlag = 0
    ElseIf ID * Size >= Count Then
        lngMove = IIf(Count Mod Size = 0, Size, Count Mod Size)
        lngFlag = IIf(Count Mod Size = 0, Count - Size, Count - (Count Mod Size))
    Else
        lngMove = Size
        lngFlag = (ID - 1) * Size
    End If
    If Where <> "" Then Where = " WHERE " & Where
    If Sort <> "" Then Sort = " ORDER BY " & Sort
    Set xmlTemp = Nothing
    If Count = 0 Then
        'pass
    ElseIf DataType = adAccess Then
        strSQL = "SELECT $(Column) FROM $(Table)$(Where)$(Sort)"
        strSQL = Replace(strSQL, "$(Table)", Table)
        strSQL = Replace(strSQL, "$(Column)", Column)
        strSQL = Replace(strSQL, "$(Sort)", Sort)
        strSQL = Replace(strSQL, "$(Where)", Where)
        Set rs = MyKernel.DB.Exec3(strSQL, adOpenKeyset, adLockReadOnly, adCmdText)
        If Not rs.EOF Then
            rs.Move lngFlag
            Set xmlTemp = RecordToXML(rs, Size, strParent, strChild)
        End If
        rs.Close
        Set rs = Nothing
    Else
        Select Case DataType
        Case adSQLServer
            If lngFlag > 0 Then
                strSQL = "SELECT TOP $(Move) $(Column) FROM $(Table)$(Where)$(WhereOrAnd)$(Index)$(Operator)(SELECT $(MinMax)($(Index)) FROM (SELECT TOP $(Flag) $(Index) FROM $(Table)$(Where)$(Sort)) X)$(Sort)"
                strSQL = Replace(strSQL, "$(WhereOrAnd)", IIf(Where = "", " WHERE ", " AND "))
                strSQL = Replace(strSQL, "$(Index)", Index)
                strSQL = Replace(strSQL, "$(Operator)", IIf(SortType = 0, ">", "<"))
                strSQL = Replace(strSQL, "$(MinMax)", IIf(SortType = 0, "MAX", "MIN"))
            Else
                strSQL = "SELECT TOP $(Move) $(Column) FROM $(Table)$(Where)$(Sort)"
            End If
        Case adOracle
            strSQL = "SELECT $(Column),ROWNO FROM (SELECT $(Column),ROWNUM ROWNO FROM (SELECT $(Column) FROM $(Table)$(Where)$(Sort))) WHERE ROWNO BETWEEN $(Flag) AND $(Flag) + $(Move)"
        Case adMySQL
            strSQL = "SELECT $(Column) FROM $(Table)$(Where)$(Sort) LIMIT $(Flag),$(Move)"
        Case Else
            Err.Raise vbObjectError + 1, "Page.Build", "Unable database type: " & DataType
        End Select
        strSQL = Replace(strSQL, "$(Table)", Table)
        strSQL = Replace(strSQL, "$(Column)", Column)
        strSQL = Replace(strSQL, "$(Move)", lngMove)
        strSQL = Replace(strSQL, "$(Flag)", lngFlag)
        strSQL = Replace(strSQL, "$(Sort)", Sort)
        strSQL = Replace(strSQL, "$(Where)", Where)
        Set rs = MyKernel.DB.Exec2(strSQL)
        If Not rs.EOF Then
            Set xmlTemp = RecordToXML(rs, adGetRowsRest, strParent, strChild)
        End If
        rs.Close
        Set rs = Nothing
    End If
    xmlPage.setAttribute "id", ID
    xmlPage.setAttribute "count", Count
    xmlPage.setAttribute "size", Size
    xmlPage.setAttribute "total", Total
    If Not xmlTemp Is Nothing Then
        Set xmlRows = xmlRoot.appendChild(xmlTemp.documentElement.cloneNode(True))
    Else
        Set xmlRows = xmlRoot.appendChild(xmlDoc.createElement(strParent))
    End If
    Set xmlTemp = Nothing
End Sub

⌨️ 快捷键说明

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