powereasy.common.front.asp
来自「本程序系统完全实现了医院网站程序的全部功能的前台和后台程序」· ASP 代码 · 共 1,217 行 · 第 1/5 页
ASP
1,217 行
Function GetInfoList_GetStrUpdateTime_Xml(ShowDateType, strUpdateTime)
If ShowDateType > 0 Then
GetInfoList_GetStrUpdateTime_Xml = Replace(Character_Date, "{$Text}", strUpdateTime)
Else
GetInfoList_GetStrUpdateTime_Xml = ""
End If
End Function
Function GetInfoList_GetStrHits_Xml(ShowHits, strHits)
If ShowHits = True Then
GetInfoList_GetStrHits_Xml = Replace(Character_Hits, "{$Text}", strHits)
Else
GetInfoList_GetStrHits_Xml = ""
End If
End Function
Function GetInfoList_GetStrAuthor_RSS(Author)
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
'==================================================
'函数名：ShowPath
'作 用：显示“你现在所有位置”导航信息
'参 数：无
'==================================================
Function ShowPath()
If PageTitle <> "" Then
strNavPath = strNavPath & " " & strNavLink & " " & PageTitle
End If
ShowPath = strNavPath
End Function
'==================================================
'函数名：GetLogo
'作 用：得到显示网站LOGO的HTML代码
'参 数：无
'==================================================
Function GetLogo(LogoWidth, LogoHeight)
Dim strLogo, strLogoUrl
If LogoUrl <> "" Then
If LCase(Left(LogoUrl, 7)) = "http://" Or Left(LogoUrl, 1) = "/" Then
strLogoUrl = LogoUrl
Else
strLogoUrl = strInstallDir & LogoUrl
End If
If LCase(Right(strLogoUrl, 3)) = "swf" Then
strLogo = "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,0,0'"
If LogoWidth > 0 Then strLogo = strLogo & " width='" & LogoWidth & "'"
If LogoHeight > 0 Then strLogo = strLogo & " height='" & LogoHeight & "'"
strLogo = strLogo & "><param name='movie' value='" & strLogoUrl & "'>"
strLogo = strLogo & "<param name='wmode' value='transparent'>"
strLogo = strLogo & "<param name='quality' value='autohigh'>"
strLogo = strLogo & "<embed"
If LogoWidth > 0 Then strLogo = strLogo & " width='" & LogoWidth & "'"
If LogoHeight > 0 Then strLogo = strLogo & " height='" & LogoHeight & "'"
strLogo = strLogo & " src='" & strLogoUrl & "'"
strLogo = strLogo & " wmode='transparent'"
strLogo = strLogo & " quality='autohigh'"
strLogo = strLogo & "pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash'></embed>"
strLogo = strLogo & "</object>"
Else
strLogo = "<a href='" & SiteUrl & "' title='" & SiteName & "' target='_blank'>"
strLogo = strLogo & "<img src='" & strLogoUrl & "'"
If LogoWidth > 0 Then strLogo = strLogo & " width='" & LogoWidth & "'"
If LogoHeight > 0 Then strLogo = strLogo & " height='" & LogoHeight & "'"
strLogo = strLogo & " border='0'>"
strLogo = strLogo & "</a>"
End If
End If
GetLogo = strLogo
End Function
'==================================================
'过程名：GetBanner
'作 用：得到网站Banner的HTML代码
'参 数：无
'==================================================
Function GetBanner(BannerWidth, BannerHeight)
Dim strBanner
If BannerUrl <> "" Then
If LCase(Right(BannerUrl, 3)) = "swf" Then
If LCase(Left(BannerUrl, 7)) = "http://" Then
strBanner = "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' width='" & BannerWidth & "' height='" & BannerHeight & "'><param name='movie' value='" & BannerUrl & "'><param name='wmode' value='transparent'><param name='quality' value='high'><embed src='" & BannerUrl & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='" & BannerWidth & "' height='" & BannerHeight & "'></embed></object>"
Else
strBanner = "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0' width='" & BannerWidth & "' height='" & BannerHeight & "'><param name='movie' value='" & strInstallDir & BannerUrl & "'><param name='wmode' value='transparent'><param name='quality' value='high'><embed src='" & strInstallDir & BannerUrl & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='" & BannerWidth & "' height='" & BannerHeight & "'></embed></object>"
End If
Else
If LCase(Left(BannerUrl, 7)) = "http://" Then
strBanner = "<a href='" & SiteUrl & "' title='" & SiteName & "'><img src='" & BannerUrl & "' width='" & BannerWidth & "' height='" & BannerHeight & "' border='0'></a>"
Else
strBanner = "<a href='" & SiteUrl & "' title='" & SiteName & "'><img src='" & strInstallDir & BannerUrl & "' width='" & BannerWidth & "' height='" & BannerHeight & "' border='0'></a>"
End If
End If
End If
GetBanner = strBanner
End Function
Function GetChannelList(NumNewLine)
If ShowSiteChannel = False Then
GetChannelList = ""
Exit Function
End If
Dim tmpCacheName
tmpCacheName = "ChannelListHtml_" & ChannelID & "_" & NumNewLine
If PE_Cache.CacheIsEmpty(tmpCacheName) Then
Dim rsChannel, strChannel, ChannelLink, ChannelUrl, LineNum
LineNum = 1
ChannelLink = XmlText("BaseText", "ChannelLink", " | ")
If ChannelID = 0 Then
strChannel = ChannelLink & "<a class='Channel2' href='" & strInstallDir & FileName_SiteIndex & "'>" & XmlText("BaseText", "FirstPage", "网站首页") & "</a>" & ChannelLink
Else
strChannel = ChannelLink & "<a class='Channel' href='" & strInstallDir & FileName_SiteIndex & "'>" & XmlText("BaseText", "FirstPage", "网站首页") & "</a>" & ChannelLink
End If
Set rsChannel = Conn.Execute("select * from PE_Channel order by OrderID")
Do While Not rsChannel.EOF
If rsChannel("Disabled") <> True And (rsChannel("ShowName") <> False Or rsChannel("ChannelType") = 2) Then
If NumNewLine > 0 And LineNum = NumNewLine Then
LineNum = 0
strChannel = strChannel & "<br>" & ChannelLink
End If
'只使用绝对地址时，才使用频道子域名
If IsNull(rsChannel("LinkUrl")) Or Trim(rsChannel("LinkUrl")) = "" Or Left(strInstallDir, 7) <> "http://" Then
ChannelUrl = strInstallDir & rsChannel("ChannelDir")
Else
ChannelUrl = rsChannel("LinkUrl")
End If
If rsChannel("ChannelID") = ChannelID Then
strChannel = strChannel & "<a class='Channel2' "
Else
strChannel = strChannel & "<a class='Channel' "
End If
If rsChannel("ChannelType") <= 1 Then
If rsChannel("UseCreateHTML") > 0 Then
strChannel = strChannel & " href='" & ChannelUrl & "/Index" & arrFileExt(rsChannel("FileExt_Index")) & "'"
Else
strChannel = strChannel & " href='" & ChannelUrl & "/Index.asp'"
End If
Else
strChannel = strChannel & " href='" & rsChannel("LinkUrl") & "'"
End If
If rsChannel("OpenType") = 0 Then
strChannel = strChannel & " target='_self'"
Else
strChannel = strChannel & " target='_blank'"
End If
strChannel = strChannel & " title='" & Trim(nohtml(rsChannel("ReadMe"))) & "'"
If rsChannel("ChannelPicUrl") = "" Or IsNull(rsChannel("ChannelPicUrl")) = True Then
strChannel = strChannel & ">" & rsChannel("ChannelName") & "</a>" & ChannelLink
Else
strChannel = strChannel & "><img src='" & rsChannel("ChannelPicUrl") & "' border=0 alt='" & rsChannel("ChannelName") & "'></a>" & ChannelLink
End If
If NumNewLine > 0 Then
LineNum = LineNum + 1
End If
End If
rsChannel.MoveNext
Loop
rsChannel.Close
Set rsChannel = Nothing
PE_Cache.SetValue tmpCacheName, strChannel
Else
strChannel = PE_Cache.GetValue(tmpCacheName)
End If
GetChannelList = strChannel
End Function
'=================================================
'函数名：GetChildClass
'作 用：显示当前栏目的下一级子栏目
'参 数：
'1 theClassID ---- 栏目ID,0为本栏目
'2 ClassNum ---- 栏目数，若大于0，则只查询前几个栏目
'3 ShowPropertyType ---- 显示栏目前的小图标，0为不显示，1为符号，其他为小图片：/images/article_common*.gif
'4 OpenType ---- 栏目打开方式，0为在原窗口打开，1为在新窗口打开，3为根据栏目设置
'5 Cols ---- 每行的列数。超过此列数就换行。
'6 ShowChildNum ---- 是否显示子栏目个数，有子栏目时才显示，
'=================================================
Function GetChildClass(theClassID, ClassNum, ShowPropertyType, OpenType, Cols, ShowChildNum)
Dim sqlChild, rsChild, i, strChild, tOpenType
If Cols = 0 Then Cols = 1
sqlChild = "select"
If ClassNum > 0 Then
sqlChild = sqlChild & " top " & ClassNum
End If
sqlChild = sqlChild & " ClassID,ClassName,Depth,ParentPath,NextID,ClassType,Child,ParentDir,ClassDir,OpenType,LinkUrl,ClassPurview from PE_Class where ChannelID=" & ChannelID & " "
If theClassID <> 0 Then
sqlChild = sqlChild & " and ParentID=" & theClassID
Else
sqlChild = sqlChild & " and ParentID=" & ClassID
End If
sqlChild = sqlChild & " and IsElite=" & PE_True & " order by OrderID"
Set rsChild = Conn.Execute(sqlChild)
If rsChild.BOF And rsChild.EOF Then
strChild = "没有任何子栏目"
Else
i = 0
Do While Not rsChild.EOF
If i > 0 Then
If i Mod Cols = 0 Then
strChild = strChild & "<br>"
Else
strChild = strChild & " "
End If
End If
If ShowPropertyType = 0 Then
strChild = strChild & ""
ElseIf ShowPropertyType = 1 Then
strChild = strChild & "·"
Else
strChild = strChild & "<img src='" & ChannelUrl & "/images/" & ModuleName & "_common" & ShowPropertyType & ".gif' border='0'>"
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?