index.asp

来自「本程序系统完全实现了医院网站程序的全部功能的前台和后台程序」· ASP 代码 · 共 1,377 行 · 第 1/5 页

        Else
            ArticleID = PE_CLng(ArticleID)
        End If
        Call ArticlePass(ChannelID, ArticleID, StrRow(3), StrRow(4))
    Case "SoftPass"
        ArticleID = StrRow(2)
        If ArticleID = "" Then
            ArticleID = 0
        Else
            ArticleID = PE_CLng(ArticleID)
        End If
        Call SoftPass(ChannelID, ArticleID, StrRow(3), StrRow(4))
    Case "PhotoPass"
        ArticleID = StrRow(2)
        If ArticleID = "" Then
            ArticleID = 0
        Else
            ArticleID = PE_CLng(ArticleID)
        End If
        Call PhotoPass(ChannelID, ArticleID, StrRow(3), StrRow(4))
    Case "GuestPass"
        ArticleID = StrRow(2)
        If ArticleID = "" Then
            ArticleID = 0
        Else
            ArticleID = PE_CLng(ArticleID)
        End If
        Call GuestPass(ChannelID, ArticleID, StrRow(3), StrRow(4))
    Case "ProductPass"
        ArticleID = StrRow(2)
        If ArticleID = "" Then
            ArticleID = 0
        Else
            ArticleID = PE_CLng(ArticleID)
        End If
        Call ProductPass(ChannelID, ArticleID, StrRow(3), StrRow(4))
    End Select
End Sub


'**************************************************
'前台浏览部分开始
'**************************************************
Sub ShowWap(ByVal iChannelID, ByVal iClassID, ByVal iHot, ByVal iElite)
    Dim sqlChannel, rsChannel, sqlArticle, rsArticle, ModuleType, HitsOfHot
    strHTML = strHTML & "<card id=""main"" title=""" & SiteName & """>" & vbCrLf
    
    If iChannelID = 0 Then '如果是显示首页
        sqlChannel = "select ChannelID,OrderID,ChannelName,ChannelDir,ModuleType,ChannelType,Disabled from PE_Channel where Disabled = " & PE_False & " and ChannelType<2 order by OrderID"
        Set rsChannel = Conn.Execute(sqlChannel)
        If rsChannel.BOF And rsChannel.EOF Then
            strHTML = strHTML & "<p align=""center"">" & XmlText("BaseText", "ChannelErr", "找不到频道！")
        Else
            strHTML = strHTML & "<p align=""center"">" & SiteLogo & vbCrLf
            Do While Not rsChannel.EOF
                If rsChannel("ModuleType") = 1 Or rsChannel("ModuleType") = 2 Or rsChannel("ModuleType") = 3 Or rsChannel("ModuleType") = 5 Then
                    If rsChannel("ModuleType") = 5 Then
                        strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=ChannelList|" & rsChannel("ChannelID") & """>" & rsChannel("ChannelName") & "</a>" & vbCrLf
                    Else
                        strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=ChannelList|" & rsChannel("ChannelID") & """>" & rsChannel("ChannelName") & "</a>" & vbCrLf
                    End If
                End If
                rsChannel.MoveNext
            Loop
            If ShowWapManage = True Then strHTML = strHTML & "<br/>-----<br/><a href=""" & WapDomain & "?Source=ManageLogin|1|none|none"">" & XmlText("Wap", "ManageLogin", "-管理登录-") & "</a>" & vbCrLf
        End If
        strHTML = strHTML & "</p>" & vbCrLf
        rsChannel.Close
        Set rsChannel = Nothing
    Else
        strHTML = strHTML & "<p>" & XmlText("Wap", "News", "-最新更新-") & vbCrLf
        Set rsChannel = Conn.Execute("select ChannelName,ChannelDir,ModuleType,HitsOfHot,UploadDir from PE_Channel where ChannelID=" & iChannelID & " and Disabled = " & PE_False & " and ChannelType<2 order by OrderID")
        ChannelName = rsChannel("ChannelName")
        ChannelDir = rsChannel("ChannelDir")
        ModuleType = rsChannel("ModuleType")
        HitsOfHot = rsChannel("HitsOfHot")
        UploadDir = rsChannel("UploadDir")
        rsChannel.Close
        Set rsChannel = Nothing
        Select Case ModuleType
        Case 1
            sqlArticle = "select top 12 A.ArticleID,A.ChannelID,A.ClassID,A.Title,A.Hits,A.UpdateTime,A.Elite,A.Status,A.IncludePic,A.LinkUrl,A.Deleted,C.ClassPurview from PE_Article A inner join PE_Class C on A.ClassID=C.ClassID Where A.ChannelID=" & iChannelID & " and C.ClassPurview<2"
            If iClassID <> 0 Then sqlArticle = sqlArticle & " and A.ClassID=" & iClassID
            sqlArticle = sqlArticle & " and A.Status=3 and A.Deleted=" & PE_False
            If iHot = 1 Then
                sqlArticle = sqlArticle & " order by A.Hits Desc"
            ElseIf iElite = 1 Then
                sqlArticle = sqlArticle & " order by A.Elite " & PE_OrderType & ",A.UpdateTime Desc"
            Else
                sqlArticle = sqlArticle & " order by A.UpdateTime Desc"
            End If
            Set rsArticle = Conn.Execute(sqlArticle)
            If Not (rsArticle.BOF And rsArticle.EOF) Then
                Do While Not rsArticle.EOF
                    If rsArticle(9) = "" Then
                        strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=ShowArticle|" & iChannelID & "|" & rsArticle(0) & "|0"">" & ReplaceText(GetSubStr(xml_nohtml(rsArticle(3)), 20, False), 2) & "</a>"
                        If rsArticle(8) > 0 Then strHTML = strHTML & "-图" & vbCrLf
                        If rsArticle(4) > HitsOfHot Then strHTML = strHTML & "-热" & vbCrLf
                        If rsArticle(6) = True Then strHTML = strHTML & "-荐" & vbCrLf
                    End If
                    rsArticle.MoveNext
                Loop
            Else
                strHTML = strHTML & "无文章" & vbCrLf
            End If
            rsArticle.Close
        Case 2
                sqlArticle = "select top 12 A.SoftID,A.ChannelID,A.ClassID,A.SoftName,A.Hits,A.UpdateTime,A.Elite,A.Status,A.Deleted,C.ClassPurview from PE_Soft A inner join PE_Class C on A.ClassID=C.ClassID Where A.ChannelID=" & iChannelID & " and C.ClassPurview<2"
                If iClassID <> 0 Then sqlArticle = sqlArticle & " and A.ClassID=" & iClassID
                sqlArticle = sqlArticle & " and A.Status=3 and A.Deleted=" & PE_False
                If iHot = 1 Then
                    sqlArticle = sqlArticle & " order by A.Hits Desc"
                ElseIf iElite = 1 Then
                    sqlArticle = sqlArticle & " order by A.Elite " & PE_OrderType & ",A.UpdateTime Desc"
                Else
                    sqlArticle = sqlArticle & " order by A.UpdateTime Desc"
                End If
                Set rsArticle = Conn.Execute(sqlArticle)
                If Not (rsArticle.BOF And rsArticle.EOF) Then
                    Do While Not rsArticle.EOF
                        strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=ShowSoft|" & iChannelID & "|" & rsArticle(0) & """>" & GetSubStr(xml_nohtml(rsArticle(3)), 20, False) & "</a>"
                        If rsArticle(6) = True Then strHTML = strHTML & "-荐" & vbCrLf
                        If rsArticle(4) > HitsOfHot Then strHTML = strHTML & "-热" & vbCrLf
                        rsArticle.MoveNext
                    Loop
                Else
                    strHTML = strHTML & "无下载" & vbCrLf
                End If
                rsArticle.Close
        Case 3
                sqlArticle = "select top 12 A.PhotoID,A.ChannelID,A.ClassID,A.PhotoName,A.Hits,A.UpdateTime,A.Elite,A.Status,A.Deleted,C.ClassPurview from PE_Photo A inner join PE_Class C on A.ClassID=C.ClassID Where A.ChannelID=" & iChannelID & " and C.ClassPurview<2"
                If iClassID <> 0 Then sqlArticle = sqlArticle & " and A.ClassID=" & iClassID
                sqlArticle = sqlArticle & " and A.Status=3 and A.Deleted=" & PE_False
                If iHot = 1 Then
                    sqlArticle = sqlArticle & " order by A.Hits Desc"
                ElseIf iElite = 1 Then
                    sqlArticle = sqlArticle & " order by A.Elite " & PE_OrderType & ",A.UpdateTime Desc"
                Else
                    sqlArticle = sqlArticle & " order by A.UpdateTime Desc"
                End If
                Set rsArticle = Conn.Execute(sqlArticle)
                If Not (rsArticle.BOF And rsArticle.EOF) Then
                    Do While Not rsArticle.EOF
                        strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=ShowPhoto|" & iChannelID & "|" & rsArticle(0) & """>" & GetSubStr(xml_nohtml(rsArticle(3)), 20, False) & "</a>"
                        If rsArticle(6) = True Then strHTML = strHTML & "-荐" & vbCrLf
                        If rsArticle(4) > HitsOfHot Then strHTML = strHTML & "-热" & vbCrLf
                        rsArticle.MoveNext
                    Loop
                Else
                    strHTML = strHTML & "无图片" & vbCrLf
                End If
                rsArticle.Close
        Case 5
                sqlArticle = "select top 12 ProductID,ChannelID,ClassID,ProductName,IsHot,IsElite,UpdateTime,Hits,Deleted from PE_Product Where ChannelID=" & iChannelID
                If iClassID <> 0 Then sqlArticle = sqlArticle & " and ClassID=" & iClassID
                sqlArticle = sqlArticle & " and Deleted=" & PE_False
                If iHot = 1 Then
                    sqlArticle = sqlArticle & " order by Hits Desc"
                ElseIf iElite = 1 Then
                    sqlArticle = sqlArticle & " order by IsElite " & PE_OrderType & ",UpdateTime Desc"
                Else
                    sqlArticle = sqlArticle & " order by UpdateTime Desc"
                End If
                Set rsArticle = Conn.Execute(sqlArticle)
                If Not (rsArticle.BOF And rsArticle.EOF) Then
                    Do While Not rsArticle.EOF
                        strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=ShowProduct|" & iChannelID & "|" & rsArticle(0) & """>" & GetSubStr(xml_nohtml(rsArticle(3)), 20, False) & "</a>"
                        If rsArticle(4) = True Then strHTML = strHTML & "-热" & vbCrLf
                        If rsArticle(5) = True Then strHTML = strHTML & "-荐" & vbCrLf
                        rsArticle.MoveNext
                    Loop
                Else
                    strHTML = strHTML & "无商品" & vbCrLf
                End If
                rsArticle.Close
        End Select
        Set rsArticle = Nothing
        strHTML = strHTML & "</p>" & vbCrLf
        strHTML = strHTML & GetChildClass(iChannelID, iClassID)
    End If
    strHTML = strHTML & "</card>" & vbCrLf
End Sub

Function GetChildClass(ByVal iChannelID, ByVal iClassID)
    Dim rsClass, strtmp
    strtmp = "<p>-子栏目-" & vbCrLf
    If iClassID = 0 Then
        Set rsClass = Conn.Execute("select ClassID,ClassName,Child from PE_Class where ChannelID=" & iChannelID & " and ClassType=1 and ParentID =0")
        If Not (rsClass.BOF And rsClass.EOF) Then
            Do While Not rsClass.EOF
                strtmp = strtmp & "<br/>[<a href=""" & WapDomain & "?Source=ClassList|" & iChannelID & "|" & rsClass("ClassID") & """>" & rsClass("ClassName") & "</a>]" & vbCrLf
                rsClass.MoveNext
            Loop
        End If
        strtmp = strtmp & "<br/>[<a href=""" & WapDomain & """>首页</a>]" & vbCrLf
    Else
        Set rsClass = Conn.Execute("select ClassID,ClassName,Child from PE_Class where ParentID=" & iClassID & " and ClassType=1 order by OrderID")
        If rsClass.BOF And rsClass.EOF Then
            strtmp = strtmp & "<br/>[<a href=""" & WapDomain & """>首页</a>]" & vbCrLf
        Else
            Do While Not rsClass.EOF
                strtmp = strtmp & "<br/>[<a href=""" & WapDomain & "?Source=ClassList|" & iChannelID & "|" & rsClass("ClassID") & """>" & rsClass("ClassName") & "</a>]" & vbCrLf
                rsClass.MoveNext
            Loop
            strtmp = strtmp & "<br/>[<a href=""" & WapDomain & """>首页</a>]" & vbCrLf
        End If
    End If
    rsClass.Close
    Set rsClass = Nothing
    GetChildClass = strtmp & "</p>" & vbCrLf
End Function

'**************************************************
'函数名：ShowArticle
'作  用：显示文章内容
'**************************************************
Sub ShowArticle(ByVal iChannelID, ByVal iArticleID, ByVal iPage)
    Dim sqlArticle, rsArticle
    strHTML = strHTML & "<card id=""main"" title=""" & SiteName & """>" & vbCrLf
    If iArticleID = 0 Then
        strHTML = strHTML & "<p>无此文章！</p>" & vbCrLf
    Else
        sqlArticle = "select * from PE_Article Where ArticleID=" & iArticleID & " and Status=3 and Deleted=" & PE_False & " and InfoPoint=0"
        Set rsArticle = Conn.Execute(sqlArticle)
        If rsArticle.BOF And rsArticle.EOF Then
            strHTML = strHTML & "<p>收费文章，请登录网站浏览！" & vbCrLf
            strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=ChannelList|" & iChannelID & """>返回</a></p>" & vbCrLf
        Else
            strHTML = strHTML & "<p>" & getpage(iChannelID, iArticleID, ReplaceText(Replace(xml_nohtml(rsArticle("Content")), "[NextPage]", ""), 1), iPage) & vbCrLf
            If EnableWapPl = True Then strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=AComment|" & rsArticle("ChannelID") & "|1|" & rsArticle("ClassID") & "|" & iArticleID & """>评论</a>" & vbCrLf
            If ShowWapAppendix = True Then
                If rsArticle("IncludePic") > 0 Then strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=AFuJian|" & iChannelID & "|" & iArticleID & """>图片</a>" & vbCrLf
            End If
            strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=ChannelList|" & iChannelID & """>返回</a></p>" & vbCrLf
        End If
        rsArticle.Close
        Set rsArticle = Nothing
    End If
    strHTML = strHTML & "</card>" & vbCrLf
End Sub

'**************************************************
'函数名：ShowSoft
'作  用：显示下载内容
'**************************************************
Sub ShowSoft(ByVal iSize, ByVal iChannelID, ByVal iSoftID)
    Dim sqlSoft, rsSoft
    strHTML = strHTML & "<card id=""main"" title=""" & SiteName & """>" & vbCrLf
    If iSoftID = 0 Then
        strHTML = strHTML & "<p>无此下载！</p>" & vbCrLf
    Else
        sqlSoft = "select * from PE_Soft Where SoftID=" & iSoftID & " and Status=3 and Deleted=" & PE_False & " and InfoPoint=0"
        Set rsSoft = Conn.Execute(sqlSoft)
        If rsSoft.BOF And rsSoft.EOF Then
            strHTML = strHTML & "<p>收费软件，请登录网站下载！</p>" & vbCrLf
        Else
            strHTML = strHTML & "<p>名称:" & GetSubStr2(xml_nohtml(rsSoft("SoftName")), iSize) & "<br/>" & vbCrLf
            If Not IsNull(rsSoft("SoftVersion")) Then strHTML = strHTML & "版本:" & GetSubStr2(xml_nohtml(rsSoft("SoftVersion")), iSize) & "<br/>" & vbCrLf
            If Not IsNull(rsSoft("SoftIntro")) Then strHTML = strHTML & "简介:" & GetSubStr2(xml_nohtml(rsSoft("SoftIntro")), 80) & "<br/>" & vbCrLf
            strHTML = strHTML & GetDownloadUrlList(rsSoft("DownloadUrl"))
            If EnableWapPl = True Then strHTML = strHTML & "<a href=""" & WapDomain & "?Source=AComment|" & rsSoft("ChannelID") & "|2|" & rsSoft("ClassID") & "|" & iSoftID & """>评论</a>" & vbCrLf
            strHTML = strHTML & "<br/><a href=""" & WapDomain & "?Source=ChannelList|" & iChannelID & """>返回</a></p>" & vbCrLf
        End If
        rsSoft.Close
        Set rsSoft = Nothing
    End If
    strHTML = strHTML & "</card>" & vbCrLf
End Sub

'**************************************************
'函数名：ShowPhoto
'作  用：显示图片内容
'**************************************************
Sub ShowPhoto(ByVal iSize, ByVal iChannelID, ByVal iPhotoID)
    Dim sqlPhoto, rsPhoto
    strHTML = strHTML & "<card id=""main"" title=""" & SiteName & """>" & vbCrLf