📄 powereasy.supply.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 4 页
字号:
12 3 4 下一页
<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Dim SupplyID, rsSupply, SearchStyleFlag

Class Supply

Private OpenType

Public Sub Init()

    'ClassID = PE_CLng(Trim(Request("ClassID")))
    'SpecialID = PE_CLng(Trim(Request("SpecialID")))
    SupplyID = PE_CLng(Trim(Request("SupplyId")))
    
    If IsValidID(SupplyID) = False Then
        SupplyID = ""
    End If
    PrevChannelID = ChannelID
        
    If XmlDoc.Load(Server.MapPath(InstallDir & "Language/Gb2312_Channel_" & ChannelID & ".xml")) = False Then XmlDoc.Load (Server.MapPath(InstallDir & "Language/Gb2312.xml"))
     
    ChannelShortName = "供求信息"
    
    strNavPath = XmlText("BaseText", "Nav", "您现在的位置：") & "&nbsp;<a class='LinkPath' href='" & SiteUrl & "'>" & SiteName & "</a>"
    strPageTitle = SiteTitle
    
    Call GetChannel(ChannelID)
    
    If Trim(ChannelName) <> "" And ShowNameOnPath <> False Then
        strNavPath = strNavPath & "&nbsp;" & strNavLink & "&nbsp;<a class='LinkPath' href='" & ChannelUrl & "/Index.asp"
        strNavPath = strNavPath & "'>" & ChannelName & "</a>"
        strPageTitle = strPageTitle & " >> " & ChannelName
    End If
End Sub

'标签解析接口
Private Function getInfoListLable()
    regEx.Pattern = "\{\$SupplyInfoList\((.*?)\)\}"
    Set Matches = regEx.Execute(strHtml)
    For Each Match In Matches
        strHtml = Replace(strHtml, Match.value, ReplaceInfoListLabel(Match.SubMatches(0)))
    Next

    regEx.Pattern = "\{\$SupplyInfoType\((.*?)\)\}"
    Set Matches = regEx.Execute(strHtml)
    For Each Match In Matches
        strHtml = Replace(strHtml, Match.value, ReplaceSupplyInfoType(Match.SubMatches(0)))
    Next

    regEx.Pattern = "\{\$Navigation\((.*?)\)\}"
    Set Matches = regEx.Execute(strHtml)
    For Each Match In Matches
        strHtml = Replace(strHtml, Match.value, ReplaceNavigationLabel(Match.SubMatches(0)))
    Next

End Function

Private Function ReplaceSupplyInfoType(ByVal strTemp)
    Dim arrTemp
    arrTemp = Split(strTemp, ",")
    
    If PE_CLng(arrTemp(0)) > 4 Or PE_CLng(arrTemp(0)) < 0 Then
        arrTemp(0) = 0
    End If
    If UBound(arrTemp) <> 6 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>页面标签{$SupplyInfoType(...)}错误</li>"
        Exit Function
    End If
    If PE_CLng(arrTemp(1)) = 0 Then
        arrTemp(1) = 10
    End If
    Select Case PE_CLng(arrTemp(0))
        Case 0  ' 最新
            ReplaceSupplyInfoType = getLasterSupplyInfo(PE_CLng(arrTemp(2)), PE_CLng(arrTemp(3)), PE_CLng(arrTemp(4)))
        Case 1  '热门
            ReplaceSupplyInfoType = getHotSupplyInfo(PE_CLng(arrTemp(2)), PE_CLng(arrTemp(3)), PE_CLng(arrTemp(4)))
        Case 2  '推荐
            ReplaceSupplyInfoType = getCommandSupplyInfo(PE_CLng(arrTemp(1)), PE_CLng(arrTemp(2)), PE_CLng(arrTemp(3)), PE_CLng(arrTemp(4)))
        Case 3  '带图片的最新信息
            ReplaceSupplyInfoType = getPicLasterInfo(PE_CLng(arrTemp(2)), PE_CLng(arrTemp(3)), PE_CLng(arrTemp(4)), PE_CLng(arrTemp(5)), PE_CLng(arrTemp(6)))
    End Select
End Function

'根据标签参数，来替换不同的函数
Private Function ReplaceInfoListLabel(ByVal strTemp)    '0,0,1,100,0,True
    Dim arrTemp
    arrTemp = Split(strTemp, ",")
    If UBound(arrTemp) = 10 Then
        strTemp = strTemp & ",0,True"
    End If
    If CheckSupplyLabel(strTemp) Then
        Exit Function
    End If
    arrTemp = Split(strTemp, ",")
    If PE_CLng(arrTemp(5)) > 3 Or PE_CLng(arrTemp(5)) < 0 Then
        arrTemp(5) = 0
    End If
    If ClassID > 0 Then
        arrTemp(1) = ClassID
    End If
    Select Case PE_CLng(arrTemp(5))
        Case 0
            ReplaceInfoListLabel = getInfoList(PE_CLng(arrTemp(0)), PE_CLng(arrTemp(1)), PE_CLng(arrTemp(2)), PE_CLng(arrTemp(3)), PE_CLng(arrTemp(4)), PE_CBool(arrTemp(6)), PE_CBool(arrTemp(7)), PE_CLng(arrTemp(8)), PE_CLng(arrTemp(9)), PE_CLng(arrTemp(10)), PE_CLng(arrTemp(11)), PE_CBool(arrTemp(12))) '一行多列
        Case 1
            ReplaceInfoListLabel = getDetailInfoList(PE_CLng(arrTemp(0)), PE_CLng(arrTemp(1)), PE_CLng(arrTemp(2)), PE_CLng(arrTemp(3)), PE_CLng(arrTemp(4)), PE_CBool(arrTemp(6)), PE_CBool(arrTemp(7)), PE_CLng(arrTemp(8)), PE_CLng(arrTemp(9)), PE_CLng(arrTemp(10)), PE_CLng(arrTemp(11)), PE_CBool(arrTemp(12))) '一行
        Case 2
            ReplaceInfoListLabel = getListPicInfoList(PE_CLng(arrTemp(0)), PE_CLng(arrTemp(1)), PE_CLng(arrTemp(2)), PE_CLng(arrTemp(3)), PE_CLng(arrTemp(4)), PE_CBool(arrTemp(6)), PE_CBool(arrTemp(7)), PE_CLng(arrTemp(8)), PE_CLng(arrTemp(9)), PE_CLng(arrTemp(10)), PE_CLng(arrTemp(11)), PE_CBool(arrTemp(12))) '图片样式一
        Case 3
            ReplaceInfoListLabel = getPicInfoList(PE_CLng(arrTemp(0)), PE_CLng(arrTemp(1)), PE_CLng(arrTemp(2)), PE_CLng(arrTemp(3)), PE_CLng(arrTemp(4)), PE_CBool(arrTemp(6)), PE_CBool(arrTemp(7)), PE_CLng(arrTemp(8)), PE_CLng(arrTemp(9)), PE_CLng(arrTemp(10)), PE_CLng(arrTemp(11)), PE_CBool(arrTemp(12))) '图片样式二
    End Select
End Function

Private Function CheckSupplyLabel(ByVal strTemp)
    Dim arrTemp
    arrTemp = Split(strTemp, ",")
    CheckSupplyLabel = False
    
    If UBound(arrTemp) <> 12 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>页面标签{$SupplyInfoList(...)}参数太多或者太少错误</li>"
        CheckSupplyLabel = True
    Else
        If PE_CLng(arrTemp(11)) > PE_CLng(getSupplyTypeNum("//SupplyType/Type")) Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>页面标签{$SupplyInfoList(...)}的第12个参数错误</li>"
            CheckSupplyLabel = True
        End If
    End If
End Function

Private Function getSupplyTypeNum(ByVal NodeName)
    Dim LangRoot, strTemp, XmlDoc, ShowLength
    Set XmlDoc = CreateObject("Microsoft.XMLDOM")
    XmlDoc.async = False
    XmlDoc.Load (Server.MapPath(InstallDir & "Language/Gb2312.xml"))
    Set LangRoot = XmlDoc.selectNodes(NodeName)
    getSupplyTypeNum = LangRoot.Length
End Function

Private Function ReplaceNavigationLabel(ByVal strTemp)
    Dim arrTemp
    arrTemp = Split(strTemp, ",")
    ReplaceNavigationLabel = GetClass_Navigation(2, PE_CLng(arrTemp(0)), PE_CLng(arrTemp(1)))
End Function

Public Function ReplaceSearchCondition(ByVal strTemp)
    Dim arrTemp
    arrTemp = Split(strTemp, ",")
    ReplaceSearchCondition = ShowSearchCondition(PE_CLng(arrTemp(0)), PE_CLng(arrTemp(1)))
End Function

Private Function getClassInfoNum(ByVal ClassID)
    Dim strSql
    strSql = "Select Count(*) From PE_Supply Where ClassId IN (" & ClassID & ")"
    getClassInfoNum = PE_CLng(Conn.Execute(strSql)(0))
End Function


Public Sub GetHtml_Supply()
    If PrevChannelID <> ChannelID Then
        Call GetChannel(ChannelID)
    End If
    strHtml = PE_Replace(strHtml, "{$SupplyID}", SupplyID)
    Call ReplaceCommon
    strHtml = PE_Replace(strHtml, "{$ClassUrl}", GetClassUrl(ClassID))
    strHtml = Replace(strHtml, "{$SupplyAction}", GetSupplyAction())
    strPageTitle = rsSupply("SupplyTitle")
    strHtml = Replace(strHtml, "{$SupplyInfoType}", GetSupplyInfoType(rsSupply("SupplyType"), "//SupplyType/Type"))
    strHtml = Replace(strHtml, "{$SupplyInfoTitle}", rsSupply("SupplyTitle"))
    strHtml = Replace(strHtml, "{$TradeType}", GetSupplyInfoType(rsSupply("TradeType"), "//TradeType/Type"))
    strHtml = PE_Replace(strHtml, "{$SupplyName}", rsSupply("SupplyName"))
    strHtml = PE_Replace(strHtml, "{$PriceIntro}", rsSupply("PriceIntro"))
    strHtml = PE_Replace(strHtml, "{$UpdateTime}", rsSupply("UpdateTime"))
    If rsSupply("SupplyPeriod") <> -1 Then
        strHtml = PE_Replace(strHtml, "{$EndTime}", DateAdd("d", rsSupply("SupplyPeriod"), rsSupply("UpdateTime")))
    Else
        strHtml = PE_Replace(strHtml, "{$EndTime}", "长期有效")
    End If
    strHtml = Replace(strHtml, "{$SupplyIntro}", Replace(Replace(rsSupply("SupplyIntro"), "[InstallDir_ChannelDir]", strInstallDir & ChannelDir & "/"), "{$UploadDir}", UploadDir))
    strHtml = PE_Replace(strHtml, "{$UserName}", rsSupply("UserName"))
    strHtml = PE_Replace(strHtml, "{$Province}", rsSupply("Province"))
    strHtml = PE_Replace(strHtml, "{$City}", rsSupply("City"))
    strHtml = PE_Replace(strHtml, "{$Address}", rsSupply("Address"))
    strHtml = PE_Replace(strHtml, "{$ZipCode}", rsSupply("ZipCode"))
    strHtml = PE_Replace(strHtml, "{$Email}", rsSupply("Email"))
    strHtml = PE_Replace(strHtml, "{$CompanyName}", rsSupply("Company"))
    strHtml = PE_Replace(strHtml, "{$Department}", rsSupply("Department"))
    strHtml = PE_Replace(strHtml, "{$CompanyAddress}", rsSupply("CompanyAddress")) '公司地址
    strHtml = PE_Replace(strHtml, "{$RealName}", rsSupply("TrueName")) '真实姓名
    strHtml = PE_Replace(strHtml, "{$Sex}", getUserSex(rsSupply("Sex"))) '性别
    strHtml = PE_Replace(strHtml, "{$Position}", rsSupply("Position")) '职务
    strHtml = PE_Replace(strHtml, "{$Operation}", rsSupply("Operation")) '负责的业务
    strHtml = PE_Replace(strHtml, "{$OfficePhone}", rsSupply("OfficePhone")) '办公室电话
    strHtml = PE_Replace(strHtml, "{$Fax}", rsSupply("Fax"))  '传真
    strHtml = PE_Replace(strHtml, "{$Mobile}", rsSupply("Mobile")) '移动电话
    strHtml = PE_Replace(strHtml, "{$QQ}", rsSupply("QQ")) 'qq
    strHtml = PE_Replace(strHtml, "{$Msn}", rsSupply("Msn")) 'msn
    strHtml = PE_Replace(strHtml, "{$Homepage}", rsSupply("Homepage")) '网址A.LoginTimes,A.LastLoginTime
    strHtml = PE_Replace(strHtml, "{$LoginTimes}", rsSupply("LoginTimes")) '登陆测试
    strHtml = PE_Replace(strHtml, "{$LastLoginTime}", rsSupply("LastLoginTime")) '最近登陆时间
    strHtml = PE_Replace(strHtml, "{$UserType}", getUserType(rsSupply("UserType"))) '会员类型
End Sub


Public Sub GetHtml_Special()
    strHtml = PE_Replace(strHtml, "{$SpecialID}", SpecialID)
    Call ReplaceCommon
    strHtml = PE_Replace(strHtml, "{$Readme}", ReadMe)
    strHtml = PE_Replace(strHtml, "{$SpecialName}", SpecialName)
    strHtml = PE_Replace(strHtml, "{$SpecialPicUrl}", SpecialPicUrl)

    Dim strPath
    strPath = ChannelUrl & "/Special/" & SpecialDir
    Call getInfoListLable
    If InStr(strHtml, "{$ShowPage}") > 0 Then strHtml = Replace(strHtml, "{$ShowPage}", ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, ChannelItemUnit & ChannelShortName, False))
    If InStr(strHtml, "{$ShowPage_en}") > 0 Then strHtml = Replace(strHtml, "{$ShowPage_en}", ShowPage_en(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, ChannelItemUnit & ChannelShortName, False))
End Sub


Public Sub GetHtml_Class()
    Dim strTemp, iCols, iClassID
    If Child > 0 And ClassShowType <> 2 Then
        strHtml = arrTemplate(0)
    Else
        strHtml = arrTemplate(1)
    End If
    strHtml = PE_Replace(strHtml, "{$ClassID}", ClassID)
    Call ReplaceCommon
    strHtml = PE_Replace(strHtml, "{$ClassPicUrl}", ClassPicUrl)
    strHtml = PE_Replace(strHtml, "{$Meta_Keywords_Class}", Meta_Keywords_Class)
    strHtml = PE_Replace(strHtml, "{$Meta_Description_Class}", Meta_Description_Class)
    strHtml = Replace(strHtml, "{$ClassUrl}", GetClassUrl(ClassID))
    strHtml = Replace(strHtml, "{$ClassListUrl}", GetClass_1Url(ClassID))
    
    Dim ArticleList_CurrentClass, ArticleList_CurrentClass2, ArticleList_ChildClass, ArticleList_ChildClass2
    If Child > 0 And ClassShowType <> 2 Then    '如果当前栏目有子栏目
        If InStr(strHtml, "{$ShowChildClass}") > 0 Then strHtml = Replace(strHtml, "{$ShowChildClass}", GetChildClass(0, 0, 3, 3, 0, True))
        
        Dim strChildClass, arrTemp
        regEx.Pattern = "\{\$ShowChildClass\((.*?)\)\}"
        Set Matches = regEx.Execute(strHtml)
        For Each Match In Matches
            arrTemp = Split(Match.SubMatches(0), ",")
            strChildClass = GetChildClass(PE_CLng(arrTemp(0)), PE_CLng(arrTemp(1)))
            strHtml = Replace(strHtml, Match.value, strChildClass)
        Next
        
        ItemCount = PE_CLng(Conn.Execute("select Count(*) from PE_Supply where ClassID=" & ClassID & "")(0))
        If ItemCount <= 0 Then     '如果当前栏目没有内容
            strHtml = regEx.Replace(strHtml, "") '再去掉显示当前栏目的只属于本栏目的内容列表
        Else      '如果当前栏目有子栏目并且当前栏目有内容，则需要显示出来。
            strTemp = ArticleList_CurrentClass
            strTemp = Replace(strTemp, "{$rsClass_ClassUrl}", GetClassUrl(ClassID))
            strTemp = PE_Replace(strTemp, "{$rsClass_Readme}", ReadMe)
            strTemp = PE_Replace(strTemp, "{$rsClass_ClassName}", ClassName)
            strTemp = PE_Replace(strTemp, "{$rsClass_ClassID}", ClassID)
        End If
     
        '得到每行显示的列数
        iCols = 1
        regEx.Pattern = "【Cols=(\d{1,2})】"
        Set Matches = regEx.Execute(ArticleList_ChildClass)
        ArticleList_ChildClass = regEx.Replace(ArticleList_ChildClass, "")
        For Each Match In Matches
            If Match.SubMatches(0) > 1 Then iCols = Match.SubMatches(0)
        Next
        '开始循环，得到所有子栏目列表的HTML代码
        iClassID = 0
        Dim rsClass
        Set rsClass = Conn.Execute("select * from PE_Class where ChannelID=" & ChannelID & " and ClassType=1 and ParentID=" & ClassID & " and IsElite=" & PE_True & " and ClassType=1 order by RootID,OrderID")
        Do While Not rsClass.EOF
            strTemp = ArticleList_ChildClass
            strTemp = Replace(strTemp, "{$rsClass_ClassUrl}", GetClassUrl(rsClass("ClassID")))
            strTemp = PE_Replace(strTemp, "{$rsClass_Readme}", rsClass("Readme"))
            strTemp = PE_Replace(strTemp, "{$rsClass_ClassName}", rsClass("ClassName"))
            strTemp = Replace(strTemp, "{$ShowClassAD}", "")
12 3 4 下一页
💿 文件大小 7095 K
👤 上传用户 foreverlovely
📂 所属分类家庭/个人应用
🏷️ 相关标签

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

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