📄 powereasy.common.front.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 5 页
字号:
    If Trim(Author & "") = "" Then
        GetInfoList_GetStrAuthor_RSS = "本站原创"
    Else
        GetInfoList_GetStrAuthor_RSS = xml_nohtml(Author)
    End If
End Function

Function GetInfoList_GetStrRSS(strTitle, strLink, strContent, strAuthor, strClassName, strUpdateTime)
    XMLDOM.appendChild (XMLDOM.createElement("item"))
    Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("title"))
    Node.Text = xml_nohtml(strTitle)
    Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("link"))
    Node.Text = strLink
    Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("description"))
    Node.Text = strContent
    Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("author"))
    Node.Text = strAuthor
    Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("category"))
    Node.Text = strClassName
    Set Node = XMLDOM.documentElement.appendChild(XMLDOM.createElement("pubDate"))
    Node.Text = strUpdateTime
    GetInfoList_GetStrRSS = XMLDOM.documentElement.xml
End Function

'==================================================
'函数名：SlidePicJs
'功能：         全站通用幻灯片标签
'PicModuleType: 频道类型,文章频道--1,软件频道--2,图片频道--3,商城频道--5
'Elite          是否推荐,1--取出推荐文章,0--取出所有信息
'Ontop          是否置顶,1--取出置顶文章,0--取出所有信息
'Hits            热门文章,具体数字--调用点击数大于次数字的信息,0--取出所有信息 
'PicNum:        调用图片数量,可选范围是2到9个
'PicChannelID : 频道id,如果填0则调用所有同类频道
'TitleLength :  标题字数
'PicWid :       幻灯片宽度
'PicHei :       幻灯片高度
'TextHei:       文字高度
'==================================================
Function SlidePicJs(PicModuleType, Elite, Ontop, Hits, PicNum, PicChannelID, TitleLength, PicWid, PicHei, TextHei)
    Dim rsPic, strSlideTemp, sqlSlide, strTitle
    Dim AdID, AdUrl, AdTitle, AdPic, k, i, m
    TextHei = PE_Clng(Trim(TextHei))
    PicNum = PE_Clng(Trim(PicNum))
    PicWid = PE_Clng(PicWid)
    PicHei = PE_Clng(PicHei)
    PicChannelID = PE_Clng(Trim(PicChannelID))

    If LCase(Elite) = "true" or PE_Clng(Elite) = 1 then
        Elite = 1
    Else 
        Elite = 0
    End If
    If LCase(Ontop) = "true" or PE_Clng(Ontop) = 1 then
        Ontop = 1
    Else 
        Ontop = 0
    End If
    If LCase(Hits) = "true"  then
        Hits = 500
    Elseif PE_Clng(Hits)>0 then
        Hits = PE_Clng(Hits)
    End If
	
    If PicNum > 9 Or PicNum = 0 Then PicNum = 9
    If TextHei = 0 Then TextHei = 10
    If PicWid = 0 Then PicWid = 300
    If PicHei = 0 Then PicHei = 200
    If TitleLength < 0 Or TitleLength > 200 Then TitleLength = 50
    k = PicNum
    sqlSlide = "select "
    Select Case PE_Clng(PicModuleType)
    Case 1
        sqlSlide = sqlSlide & "top " & PicNum & " * from PE_Article M"
    Case 2
        sqlSlide = sqlSlide & "top " & PicNum & " * from PE_Soft M"
    Case 3
        sqlSlide = sqlSlide & "top " & PicNum & " * from PE_Photo M"
    Case 5
        sqlSlide = sqlSlide & "top " & PicNum & " * from PE_Product M"
    Case Else
        sqlSlide = sqlSlide & "top " & PicNum & " * from PE_Article M"
    End Select
    sqlSlide = sqlSlide & " Inner Join PE_Channel C On M.ChannelID = C.ChannelID Where Deleted=" & PE_False
    If  Elite = 1 then 
        Select Case PE_Clng(PicModuleType)
        Case 1,2,3
            sqlSlide = sqlSlide & " and Elite = " & PE_True 
        Case 5
            sqlSlide = sqlSlide & " and IsElite = " & PE_True 
        Case Else
        End Select	
    End If
    If  Ontop = 1 then 
        sqlSlide = sqlSlide & " and Ontop = " & PE_True 
    End If
    If  Hits > 0 then 
        Select Case PE_Clng(PicModuleType)
        Case 1,2,3
            sqlSlide = sqlSlide & " and Hits > " & Hits
        Case 5
            sqlSlide = sqlSlide & " and IsHot = " & PE_True 
        Case Else
        End Select	
    End If
    Select Case PE_Clng(PicModuleType)
    Case 1
        sqlSlide = sqlSlide & " and status=3 and M.DefaultPicUrl<>''"
    Case 2
        sqlSlide = sqlSlide & " and status=3 and M.SoftPicUrl<>''"
    Case 3
    Case 5
        sqlSlide = sqlSlide & " and M.ProductThumb<>''"
    Case Else
        sqlSlide = sqlSlide & " and status=3 and M.DefaultPicUrl<>''"
    End Select
    If PicChannelID > 0 Then
        sqlSlide = sqlSlide & " and M.ChannelID=" & PicChannelID
    End If
    Select Case PicModuleType
    Case 1
        sqlSlide = sqlSlide & " order by ArticleID desc"
    Case 2
        sqlSlide = sqlSlide & " order by SoftID desc"
    Case 3
        sqlSlide = sqlSlide & " order by PhotoID desc"
    Case 5
        sqlSlide = sqlSlide & " order by ProductID desc"
    Case Else
        sqlSlide = sqlSlide & " order by ArticleID desc"
    End Select
    Set rsPic = Server.CreateObject("Adodb.RecordSet")
    rsPic.Open sqlSlide, Conn, 1, 1
    i = 1
    k = rsPic.RecordCount
    strSlideTemp = strSlideTemp & "<script type='text/javascript'>" & vbCrLf
    Do While Not rsPic.EOF
        Select Case PicModuleType
        Case 1
            AdTitle = rsPic("Title")
            If TitleLength > 0 Then
                AdTitle = ReplaceText(GetSubStr(AdTitle, TitleLength, False), 2)
            End If
            AdPic = rsPic("DefaultPicUrl")
            AdUrl = InstallDir & GetInfoUrl(rsPic("ArticleID"), "Article", 1)
            strSlideTemp = strSlideTemp & "imgUrl" & i & "='" & InstallDir & rsPic("ChannelDir") & "/" & rsPic("UploadDir") & "/" & AdPic & "';" & vbCrLf
        Case 2
            AdTitle = rsPic("SoftName")
            If TitleLength > 0 Then
                AdTitle = ReplaceText(GetSubStr(AdTitle, TitleLength, False), 2)
            End If
            AdPic = rsPic("SoftPicUrl")
            AdUrl = InstallDir & GetInfoUrl(rsPic("SoftID"), "Soft", 1)
            strSlideTemp = strSlideTemp & "imgUrl" & i & "='" & InstallDir & rsPic("ChannelDir") & "/" & AdPic & "';" & vbCrLf
        Case 3
            AdTitle = rsPic("PhotoName")
            If TitleLength > 0 Then
                AdTitle = ReplaceText(GetSubStr(AdTitle, TitleLength, False), 2)
            End If
            AdPic = rsPic("PhotoThumb")
            AdUrl = InstallDir & GetInfoUrl(rsPic("PhotoID"), "Photo", 1)
            strSlideTemp = strSlideTemp & "imgUrl" & i & "='" & InstallDir & rsPic("ChannelDir") & "/" & rsPic("UploadDir") & "/" & AdPic & "';" & vbCrLf
        Case 5
            AdTitle = rsPic("ProductName")
            If TitleLength > 0 Then
                AdTitle = ReplaceText(GetSubStr(AdTitle, TitleLength, False), 2)
            End If
            AdPic = rsPic("ProductThumb")
            AdUrl = InstallDir & GetInfoUrl(rsPic("ProductID"), "Product", 1)
            strSlideTemp = strSlideTemp & "imgUrl" & i & "='" & InstallDir & rsPic("ChannelDir") & "/" & rsPic("UploadDir") & "/" & AdPic & "';" & vbCrLf
        Case Else
            AdTitle = rsPic("Title")
            If TitleLength > 0 Then
                AdTitle = ReplaceText(GetSubStr(AdTitle, TitleLength, False), 2)
            End If
            AdPic = rsPic("ProductThumb")
            AdUrl = InstallDir & GetInfoUrl(rsPic("ArticleID"), "Article", 1)
            strSlideTemp = strSlideTemp & "imgUrl" & i & "='" & InstallDir & rsPic("ChannelDir") & "/" & rsPic("UploadDir") & "/" & AdPic & "';" & vbCrLf
        End Select
        strSlideTemp = strSlideTemp & "imgtext" & i & "='" & AdTitle & "'" & vbCrLf
        strSlideTemp = strSlideTemp & "imgLink" & i & "='" & AdUrl & "'" & vbCrLf
        If i >= k Then Exit Do
        i = i + 1
        rsPic.movenext
    Loop
    strSlideTemp = strSlideTemp & "   var focus_width=" & PicWid & vbCrLf
    strSlideTemp = strSlideTemp & "   var focus_height=" & PicHei & vbCrLf
    strSlideTemp = strSlideTemp & "   var text_height=" & TextHei & vbCrLf
    strSlideTemp = strSlideTemp & "   var swf_height = focus_height+text_height" & vbCrLf
    strSlideTemp = strSlideTemp & "   var pics="
    For m = 1 To k
        If m < k Then
            strSlideTemp = strSlideTemp & "imgUrl" & m & "+'|'+"
        Else
            strSlideTemp = strSlideTemp & "imgUrl" & m & "" & vbCrLf
        End If
    Next
    strSlideTemp = strSlideTemp & "   var links="
    For m = 1 To k
        If m < k Then
            strSlideTemp = strSlideTemp & "imgLink" & m & "+'|'+"
        Else
            strSlideTemp = strSlideTemp & "imgLink" & m & "" & vbCrLf
        End If
    Next
    strSlideTemp = strSlideTemp & "   var texts="
    For m = 1 To k
        If m < k Then
            strSlideTemp = strSlideTemp & "imgtext" & m & "+'|'+"
        Else
            strSlideTemp = strSlideTemp & "imgtext" & m & "" & vbCrLf
        End If
    Next
    strSlideTemp = strSlideTemp & "   document.write('<object classid=clsid:d27cdb6e-ae6d-11cf-96b8-444553540000 codebase=http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0 width='+ focus_width +' height='+ swf_height +'>');" & vbCrLf
    strSlideTemp = strSlideTemp & "   document.write('<param name=allowScriptAccess value=sameDomain><param name=movie value=" & InstallDir & "images/xman.swf><param name=quality value=high><param name=bgcolor value=#F0F0F0>');" & vbCrLf
    strSlideTemp = strSlideTemp & "   document.write('<param name=menu value=false><param name=wmode value=opaque>');" & vbCrLf
    strSlideTemp = strSlideTemp & "   document.write('<param name=FlashVars value=pics='+pics+'&links='+links+'&texts='+texts+'&borderwidth='+focus_width+'&borderheight='+focus_height+'&textheight='+text_height+'>');" & vbCrLf
    strSlideTemp = strSlideTemp & "   document.write('<embed  height='+ swf_height +' src=" & InstallDir & "images/xman.swf  wmode=opaque FlashVars=pics='+pics+'&links='+links+'&texts='+texts+'&borderwidth='+focus_width+'&borderheight='+focus_height+'&textheight='+text_height+' menu=false bgcolor=#F0F0F0 quality=high width='+ focus_width +' height='+ focus_height +' allowScriptAccess=sameDomain type=application/x-shockwave-flash pluginspage=http://www.macromedia.com/go/getflashplayer />');" & vbCrLf
    strSlideTemp = strSlideTemp & "   document.write('</object>');" & vbCrLf
    strSlideTemp = strSlideTemp & "</script>"
    rsPic.Close
    Set rsPic = Nothing
    SlidePicJs = strSlideTemp
End Function

'==================================================
'函数名：IsLogin
'功能： 判断当前用户是否登录,是的话返回第一个参数,否则返回第二个参数
'==================================================

Function IsLogin(str,Tips)
    If CheckUserLogined() = True Then
        IsLogin = str
    Else
        IsLogin = Tips
    End If
End Function

'==================================================
'函数名：GetUserName
'功能： 取得当前登录的会员的用户名,如果是游客,则用户名为空
'==================================================
Function GetUserName()
    If CheckUserLogined() = True Then
        GetUserName = UserName
	Else
	    GetUserName = ""	
    End If
End Function

'==================================================
'函数名：YN

'功能：     条件判断函数,可以根据条件运算参数的运算来输出相应的结果
'condition: 条件运算参数,根据运行结果,如果是真则输出Fir,否则输出Sec
'Fir:       条件成立的时候输出Fir的内容
'Sec :      条件不成立的时候输出Sec的内容
'==================================================

Function YN(Condition, Fir, Sec)
    If Condition = "" Or IsNull(Condition) Then '条件判断参数为空,则返回Sec的内容
        YN = Sec
	Elseif LCase(Condition)="true" Then
💿 文件大小 7095 K
👤 上传用户 foreverlovely
📂 所属分类家庭/个人应用
🏷️ 相关标签

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

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