📄 titleb.asp
字号:
end if
if lm1<>"0" then
set fun_lmpath_rs = Server.CreateObject("ADODB.RecordSet")
fun_lmpath_rs.Open "select * from [lm] where id="&lm1&" order by id desc",conn,1,1
if fun_lmpath_rs.recordcount<>0 then
lmname=fun_lmpath_rs("lm")
lmpath="<a href="&list_html_url(fun_lmpath_rs("id"))&">"&lmname&"</a> - "&lmpath
end if
fun_lmpath_rs.close
set fun_lmpath_rs=nothing
end if
end function
'*************************************************************************************
'函数名:newsx()，pl()，config(zd)
'作 用:定义config表的字段的变量
'*************************************************************************************
function newsx()
set rsnewsx = Server.CreateObject("ADODB.RecordSet")
rsnewsx.Open "select * from [config]",conn,1,1
newsx=int(rsnewsx("newsx"))
rsnewsx.close
set rsnewsx=nothing
end function
function config(zd)
Dim configrs
set configrs = Server.CreateObject("ADODB.RecordSet")
configrs.Open "select ["&zd&"] from [config]",conn,1,1
config=configrs(""&zd&"")
'config=replace(config,"admin/","") '2007.12.27解决“path”路径问题
configrs.close
set configrs=nothing
end function
function setting(table)
Dim settingrs
set settingrs = Server.CreateObject("ADODB.RecordSet")
settingrs.Open "select ["&table&"] from setting",conn,1,1
setting=settingrs(""&table&"")
settingrs.close
set settingrs=nothing
end function
'*************************************************************************************
'函数名:chkhtm(stra)
'作 用:字符过滤
'*************************************************************************************
function chkhtm(stra)
stra=replace(stra,"<","<")
stra=replace(stra,">",">")
stra=replace(stra,"'","")
stra=replace(stra,"(","（")
stra=replace(stra,")","）")
stra=replace(stra,";","；")
stra=replace(stra,",","，")
stra=replace(stra,"%","％")
stra=replace(stra,"+","＋")
chkhtm=stra
end function
'**************************************************
'功能:字符串过滤函数
'参数:fString:字符串内容
'**************************************************
Public Function HTMLEncode(fString)
If Not IsNull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = replace(fString, "&", "&")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
HTMLEncode = fString
End If
End Function
'*************************************************************************************
'函数名:glhtml
'作 用:标题字符过滤
'*************************************************************************************
Function glhtml(title)
title=replace(title," "," ")
title=replace(title," ","")
title=replace(title,chr(32),"")
title=replace(title,chr(13),"")
title=replace(title,chr(10),"")
title=replace(title,chr(9),"")
title=replace(title," ","")
title=replace(title,"""","")
title=replace(title,"'","")
set reg=new regexp
reg.IgnoreCase=true
reg.Global=true
reg.Pattern="(\<.*?\>)"
glhtml=reg.Replace(title,"")
set reg=nothing
End Function
'**************************************************
'函数名：IsObjInstalled
'作 用：检查组件是否已经安装
'参 数：strClassString ----组件名
'返回值：True ----已经安装
' False ----没有安装
'**************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'------------------检查某一目录是否存在-------------------
Function CheckDir(FolderPath)
dim fso
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso1 = Server.CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(FolderPath) then
'存在
CheckDir = True
Else
'不存在
CheckDir = False
End if
Set fso = nothing
End Function
'-------------根据指定名称生成目录---------
Function MakeNewsDir(foldername)
dim fso,f
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(foldername)
MakeNewsDir = True
Set fso = nothing
End Function
'**************************************************
'函数名：JoinChar
'作 用：向地址中加入 ? 或 &
'参 数：strUrl ----网址
'返回值：加了 ? 或 & 的网址
'**************************************************
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")<len(strUrl) then
if InStr(strUrl,"?")>1 then
if InStr(strUrl,"&")<len(strUrl) then
JoinChar=strUrl & "&"
else
JoinChar=strUrl
end if
else
JoinChar=strUrl & "?"
end if
else
JoinChar=strUrl
end if
end function
'*************************************************************************************
'函数名:checktxt
'作 用:非法字符过滤
'*************************************************************************************
function checktxt(txt)
chrtxt="33|34|35|36|37|38|39|40|41|42|43|44|47|58|59|60|61|62|63|91|92|93|94|96|123|124|125|126|128"
chrtext=split(chrtxt,"|")
for c=0 to ubound(chrtext)
txt=replace(txt,chr(chrtext(c)),"")
next
checktxt=txt
end function
function lleft(content,lef)
for le=1 to len(content)
if asc(mid(content,le,1))<0 then
lef=lef-2
else
lef=lef-1
end if
if lef<=0 then exit for
next
lleft=left(content,le)
end function
'*************************************************************************************
'函数名:Error_Msg,ReturnError(msg),Succeed(msg,Url)
'作 用:提示信息
'*************************************************************************************
sub Error_Msg(ErrMsg)
response.write "<TITLE>错误报告！</TITLE>"& vbCrLf
response.write "<META http-equiv=Content-Type content=""text/html; charset=gb2312"">"& vbCrLf
response.write "<LINK href=""style.css"" type=text/css rel=stylesheet>"& vbCrLf
response.write "<BR><BR>"& vbCrLf
response.write " <TABLE align=center bgColor=#DEDFDE cellpadding=""2"" cellspacing=""0"" border=0 style=""border: outset 2px;width:65%;"">"& vbCrLf
response.write " <TR> "& vbCrLf
response.write " <TD height=18 style=""FILTER: progid:DXImageTransform.Microsoft.Gradient(startColorStr='#294184', endColorStr='#A5CBF7', gradientType='1')""><b><font color=#FFFFFF>错误报告！ Error Information</FONT></b></td>"& vbCrLf
response.write " <TD align=right bgColor=#A5CBF7><a href=javascript:window.close()><img src=""images/close.gif"" width=""18"" height=""15"" border=0 align=""absmiddle""></a></td>"& vbCrLf
response.write " </tr>"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " <TD colSpan=2>"& vbCrLf
response.write " <FIELDSET><LEGEND accessKey=F align=left>产生错误的可能原因：</LEGEND>"& vbCrLf
response.write " <TABLE align=center cellSpacing=2 cellPadding=2 width=""90%"" border=0>"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " <TD>"&ErrMsg&"</TD>"& vbCrLf
response.write " </TD></TR>"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " <TD height=25 align=middle colSpan=2><BR><INPUT onclick=javascript:history.go(-1) type=submit value="" 确 定 "" name=submit></TD></TR></TABLE></FIELDSET> "& vbCrLf
response.write " </TD></TR></TABLE></TD></TR></TABLE>"& vbCrLf
response.end
end sub
Sub ReturnError(msg)
Response.Write "<p> </p>" & vbCrLf
Response.Write "<table align=""center"" border=""0"" cellpadding=""3"" cellspacing=""1"" class=""table2"">" & vbCrLf
Response.Write " <tr> " & vbCrLf
Response.Write " <th colspan=""2"" align=""left"" class=""th_table""> 错误提示信息!</th>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr><td align=""center"" width=""20%"" class=""tableline1""><img src=""" & config("path") & "images/admin/err.gif"" width=""95"" height=""97"" border=""0""></td><td width=""80%"" class=""tableline1"">"
Response.Write " <b style=""color:blue"">产生错误的可能原因：</b><br>"
Response.Write msg & "</td></tr>" & vbCrLf
Response.Write " <tr><td colspan=""2"" align=""center"" height=""25"" class=""tableline2""><a href=""javascript:history.go(-1)"">返回上一页...</a></td></tr>" & vbCrLf
Response.Write " </table><p> </p>" & vbCrLf
End Sub
Sub Succeed(msg,Url)
Response.Write "<meta http-equiv=""refresh"" content=""5;url=" & Url & """>"
Response.Write "<p> </p>" & vbCrLf
Response.Write "<table align=""center"" border=""0"" cellpadding=""3"" cellspacing=""1"" class=""table2"">" & vbCrLf
Response.Write " <tr> " & vbCrLf
Response.Write " <th colspan=""2"" align=""left"" class=""th_table""> 成功提示信息!</th>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr><td align=""center"" width=""20%"" class=""tableline1""><img src=""../images/admin/suc.gif"" width=""95"" height=""97"" border=""0""></td><td width=""80%"" class=""tableline1"">"
Response.Write " <b style=""color:blue""><span id=""jump"">5</span> 秒钟后系统将自动返回</b><br>"
Response.Write msg & "</td></tr>" & vbCrLf
Response.Write " <tr><td colspan=""2"" align=""center"" height=""25"" class=""tableline2""><a href=""" & Url & """>返回上一页...</a></td></tr>" & vbCrLf
Response.Write " </table><p> </p>" & vbCrLf
Response.Write "<script>function countDown(secs){jump.innerText=secs;if(--secs>0)setTimeout(""countDown(""+secs+"")"",1000);}countDown(5);</script>"
End Sub
Sub AdminPageEnd()
Response.Write "<div style=""text-align:center;color:#003300"">-----------------------------------------------------------------------------------------------------------</div>"
Response.Write "<div style=""height:30px;text-align:center"">Art2008 CMS , Copyright (c) 2006-2008 <a href='http://www.art2008cms.com/' target=""_blank""><font color=#cc6600>Art2008 CMS</font></a>. All Rights Reserved . </div>"
End Sub
'*************************************************************************************
'函数名:ChkClng(ByVal str)
'作 用:检查是否是数字 ，并转换为长整型
'*************************************************************************************
Function ChkClng(ByVal str)
On error resume next
If IsNumeric(str) Then
ChkClng = CLng(str)
Else
ChkClng = 0
End If
If Err Then ChkClng=0
End Function
'*************************************************************************************
'函数名:SplitNewsPage，AutoSplitPage，AutoSplitPageTF
'作 用:文章自动分页
'*************************************************************************************
Function SplitNewsPage(Content,MaxPerChar)
nextpage_string=config("nextpage")
SplitNewsPage=AutoSplitPage(Content,nextpage_string,ChkClng(MaxPerChar))
End Function
'文章自动分页
'参数：Content-文章内容 SplitPageStr-文章分隔线 maxPagesize-每页大约字符数
Function AutoSplitPage(Content,SplitPageStr,maxPagesize)
Dim sContent,ss,i,IsCount,c,iCount,strTemp,Temp_String,Temp_Array
sContent=Content
If maxPagesize<100 Or Len(sContent)<maxPagesize+100 Then
AutoSplitPage=sContent
End If
sContent=Replace(sContent, SplitPageStr, "")
sContent=Replace(sContent, " ", "< >")
sContent=Replace(sContent, ">", "<>>")
sContent=Replace(sContent, "<", "<<>")
sContent=Replace(sContent, """, "<">")
sContent=Replace(sContent, "'", "<'>")
If sContent<>"" and maxPagesize<>0 and InStr(1,sContent,SplitPageStr)=0 then
IsCount=True:Temp_String=""
For i= 1 To Len(sContent)
c=Mid(sContent,i,1)
If c="<" Then
IsCount=False
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -