<%
Function createTextFile(Byval content,Byval fileDir,Byval code)
dim fileobj,fileCode : fileDir=replace(fileDir, "\", "/")
if isNul(code) then fileCode="utf-8" else fileCode=code
call createfolder(fileDir,"filedir")
on error resume next:err.clear
set fileobj=objFso.CreateTextFile(server.mappath(fileDir),True)
fileobj.Write(content)
set fileobj=nothing
if Err or not isNul(code) or fileCode="utf-8" then
err.clear
With objStream
.Charset=fileCode:.Type=2:.Mode=3:.Open:.Position=0
.WriteText content:.SaveToFile Server.MapPath(fileDir), 2
.Close
End With
end if
if Err Then createTextFile=false : errid=err.number:errdes=err.description:Err.Clear : echoErr err_09,errid,errdes else createTextFile=true
End Function
'關鍵詞替換
function replacekey(Tcontent)
if Tcontent="" then exit function
dim sql,rs
sql="select Keywords,url,Color,Keywordsa from {prefix}KeySetting where KStatus=1 order by OrderNum desc"
set rs=conn.exec(sql,"r1")
if not rs.eof then
do while not rs.eof
Tcontent= replace(Tcontent,trim(rs(0)),""&trim(rs(0))&"",1,1)
rs.movenext
loop
end if
replacekey=Tcontent
End Function
Function createStreamFile(Byval stream,Byval fileDir)
dim errid,errdes
fileDir=replace(fileDir, "\", "/")
call createfolder(fileDir,"filedir")
on error resume next
With objStream
.Type =1
.Mode=3
.Open
.write stream
.SaveToFile server.mappath(fileDir),2
.close
End With
if Err Then error.clear:createStreamFile=false else createStreamFile=true
End Function
Function createFolder(Byval dir,Byval dirType)
dim subPathArray,lenSubPathArray, pathDeep, i
on error resume next
dir=replace(dir, "\", "/")
dir=replace(server.mappath(dir), server.mappath("/"), "")
subPathArray=split(dir, "\")
pathDeep=pathDeep&server.mappath("/")
select case dirType
case "filedir"
lenSubPathArray=ubound(subPathArray) - 1
case "folderdir"
lenSubPathArray=ubound(subPathArray)
end select
for i=0 to lenSubPathArray
pathDeep=pathDeep&"\"&subPathArray(i)
if not objFso.FolderExists(pathDeep) then objFso.CreateFolder pathDeep
next
if Err Then createFolder=false : errid=err.number:errdes=err.description:Err.Clear : echoErr err_10,errid,errdes else createFolder=true
End Function
Function isExistFile(Byval fileDir)
on error resume next
If (objFso.FileExists(server.MapPath(fileDir))) Then isExistFile=True Else isExistFile=False
if err then err.clear:isExistFile=False
End Function
Function isExistFolder(Byval folderDir)
on error resume next
If objFso.FolderExists(server.MapPath(folderDir)) Then isExistFolder=True Else isExistFolder=False
if err then err.clear:isExistFolder=False
End Function
Function delFolder(Byval folderDir)
on error resume next
If isExistFolder(folderDir)=True Then
objFso.DeleteFolder(server.mappath(folderDir))
if Err Then delFolder=false : errid=err.number : errdes=err.description:Err.Clear : echoErr err_11,errid,errdes else delFolder=true
else
delFolder=false : die(err_13)
end if
End Function
Function delFile(Byval fileDir)
on error resume next
If isExistFile(fileDir)=True Then objFso.DeleteFile(server.mappath(fileDir))
if Err Then delFile=false : errid=err.number : errdes=err.description:Err.Clear : echoErr err_12,errid,errdes else delFile=true
End Function
Function initAllObjects()
dim errid,errdes
on error resume next
if not isobject(objFso) then set objFso=server.createobject(FSO_OBJ_NAME)
If Err Then errid=err.number:errdes=err.description:Err.Clear:echoErr err_05,errid,errdes
if not isobject(objStream) then Set objStream=Server.CreateObject(STREAM_OBJ_NAME)
If Err Then errid=err.number:errdes=err.description:Err.Clear:echoErr err_04,errid,errdes
End Function
Function terminateAllObjects()
on error resume next
if conn.isConnect then conn.close
if isobject(conn) then : set conn=nothing
if isobject(objFso) then set objFso=nothing
if isobject(objStream) then set objStream=nothing
if isObject(gXmlHttpObj) then SET gXmlHttpObj=Nothing
End Function
Function moveFolder(oldFolder,newFolder)
dim voldFolder,vnewFolder
voldFolder=oldFolder
vnewFolder=newFolder
on error resume next
if voldFolder <> vnewFolder then
voldFolder=server.mappath(oldFolder)
vnewFolder=server.mappath(newFolder)
if not objFso.FolderExists(vnewFolder) then createFolder newFolder,"folderdir"
if objFso.FolderExists(voldFolder) then objFso.CopyFolder voldFolder,vnewFolder : objFso.DeleteFolder(voldFolder)
if Err Then moveFolder=false : errid=err.number : errdes=err.description:Err.Clear : echoErr err_14,errid,errdes else moveFolder=true
end if
End Function
Function moveFile(ByVal src,ByVal target,Byval operType)
dim srcPath,targetPath
srcPath=Server.MapPath(src)
targetPath=Server.MapPath(target)
if isExistFile(src) then
objFso.Copyfile srcPath,targetPath
if operType="del" then delFile src
moveFile=true
else
moveFile=false
end if
End Function
Function getFolderList(Byval cDir)
dim filePath,objFolder,objSubFolder,objSubFolders,i
i=0
redim folderList(0)
filePath=server.mapPath(cDir)
set objFolder=objFso.GetFolder(filePath)
set objSubFolders=objFolder.Subfolders
for each objSubFolder in objSubFolders
ReDim Preserve folderList(i)
With objSubFolder
folderList(i)=.name&",文件夾,"&.size/1000&"KB,"&.DateLastModified&","&cDir&"/"&.name
End With
i=i + 1
next
set objFolder=nothing
set objSubFolders=nothing
getFolderList=folderList
End Function
Function getFileList(Byval cDir)
dim filePath,objFolder,objFile,objFiles,i,fileList
i=0
redim fileList(0)
filePath=server.mapPath(cDir)
set objFolder=objFso.GetFolder(filePath)
set objFiles=objFolder.Files
for each objFile in objFiles
ReDim Preserve fileList(i)
With objFile
fileList(i)=.name&","&Mid(.name, InStrRev(.name, ".") + 1)&","&.size/1000&"KB,"&.DateLastModified&","&cDir&"/"&.name
End With
i=i + 1
next
set objFiles=nothing
set objFolder=nothing
getFileList=fileList
End Function
'讀取文件內容
Function loadFile(ByVal filePath)
dim errid,errdes
On Error Resume Next
With objStream
.Type=2
.Mode=3
.Open
.Charset="utf-8"
'echo Server.MapPath(filePath)&" "
.LoadFromFile Server.MapPath(filePath)
If Err Then errid=err.number:errdes=err.description:Err.Clear:echoErr err_06,errid,errdes
'die "A"
.Position=0
loadFile=.ReadText
.Close
End With
End Function
'彈出對話框
'str 提示信息
'url 跳轉地址
Sub alertMsgAndGo(str,url)
dim urlstr
if url<>"" then urlstr="location.href='"&url&"';"
if url="-1" then urlstr="history.go(-1);"
if not isNul(str) then str ="alert('"&str&"');"
echo("")
response.End()
End Sub
'輸出信息
'
'
Sub echoMsgAndGo(str,timenum)
echo str&",稍後將自動返回 進入網站"&str_01&""
response.End()
End Sub
'選擇跳轉
'str 提示信息
'url1
'url2
Sub selectMsg(str,url1,url2)
echo("")
End Sub
'輸出
Sub echo(str)
response.write(str)
response.Flush()
End Sub
'輸出後停止，調試用
Sub die(str)
if not isNul(str) then
echo str
end if
response.End()
End Sub
'讀cookies
Function rCookie(cookieName)
rCookie=request.cookies(cookieName)
End Function
'寫cookies
Sub wCookie(cookieName,cookieValue)
response.cookies(cookieName)=cookieValue
End Sub
'寫cookies寫義過期時間
Sub wCookieInTime(cookieName,cookieValue,dateType,dateNum)
Response.Cookies(cookieName).Expires=DateAdd(dateType,dateNum,now())
response.cookies(cookieName)=cookieValue
End Sub
'是否為空
Function isNul(str)
if isnull(str) or str="" then isNul=true else isNul=false
End Function
'是否為數字
Function isNum(str)
if not isNul(str) then isNum=isnumeric(str) else isNum=false
End Function
'是否為URL
Function isUrl(str)
isUrl=false
if not isNul(str) and left(str,7)="http://" then isUrl=true
End Function
'獲取擴展名
Function getFileFormat(str)
dim ext : str=trim(""&str) : ext=""
if str<>"" then
if instr(" "&str,"?")>0 then:str=mid(str,1,instr(str,"?")-1):end if
if instrRev(str,".")>0 then:ext=mid(str,instrRev(str,".")):end if
end if
getFileFormat=ext
End Function
'全角轉換成半角
Function convertString(Str)
Dim strChar,intAsc,strTmp,i
For i = 1 To Len(Str)
strChar = Mid(Str, i, 1)
intAsc = Asc(strChar)
If (intAsc>=-23648 And intAsc<=-23553) Then
strTmp = strTmp & Chr(intAsc+23680)
Else
strTmp = strTmp & strChar
End if
Next
ConvertString=strTmp
End Function
Sub echoErr(byval str,byval id, byval des)
dim errstr,cssstr
cssstr=""
errstr=cssstr&"
"
cssstr=""
die(errstr)
End Sub
'獲取參數值
Function getForm(element,ftype)
Select case ftype
case "get"
getForm=trim(request.QueryString(element))
case "post"
getForm=trim(request.Form(element))
case "both"
if isNul(request.QueryString(element)) then getForm=trim(request.Form(element)) else getForm=trim(request.QueryString(element))
End Select
getForm=replace(getForm,CHR(34),""")
getForm=replace(getForm,CHR(39),"'")
End Function
'是否為已安裝對象
Function isInstallObj(objname)
dim isInstall,obj
On Error Resume Next
set obj=server.CreateObject(objname)
if Err then
isInstallObj=false : err.clear
else
isInstallObj=true:set obj=nothing
end if
End Function
Sub setStartTime()
startTime=timer()
End Sub
Sub echoRunTime()
endTime=timer()
echo pageRunStr(0)&FormatNumber((endTime-startTime),4,-1)&pageRunStr(1)&conn.queryCount&pageRunStr(2)
End Sub
Function replaceStr(Byval str,Byval finStr,Byval repStr)
on error resume next
if isNull(repStr) then repStr=""
replaceStr=replace(str,finStr,repStr)
if err then replaceStr="" : err.clear
End Function
Function getArrayElementID(Byval parray,Byval itemid,Byval compareValue)
dim i
for i=0 to ubound(parray,2)
if trim(parray(itemid,i))=trim(compareValue) then
getArrayElementID=i
Exit Function
end if
next
End Function
Function trimOuter(Byval str)
dim vstr : vstr=str
if left(vstr,1)=chr(32) then vstr=right(vstr,len(vstr)-1)
if right(vstr,1)=chr(32) then vstr=left(vstr,len(vstr)-1)
trimOuter=vstr
End Function
Function trimOuterStr(Byval str,Byval flag)
dim vstr,m : vstr=str : m=len(flag)
if left(vstr,m)=flag then vstr=right(vstr,len(vstr)-m)
if right(vstr,m)=flag then vstr=left(vstr,len(vstr)-m)
trimOuterStr=vstr
End Function
Function getPageSize(Byval str,Byval ptype)
dim regObj,matchChannel,matchesChannel,sizeValue
set regObj=New RegExp
regObj.Pattern="\{aspcms:"&ptype&"list[\s\S]*size=([\d]+)[\s\S]*\}"
set matchesChannel=regObj.Execute(str)
for each matchChannel in matchesChannel
sizeValue=matchChannel.SubMatches(0) : if isNul(sizeValue) then sizeValue=10
set regObj=nothing
set matchesChannel=nothing
getPageSize=sizeValue
Exit Function
next
End Function
Function dropHtml(Byval strHTML)
Dim objRegExp, Match, Matches
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
'取閉合的<>
objRegExp.Pattern = "<.+?>"
'進行匹配
Set Matches = objRegExp.Execute(strHTML)
' 遍歷匹配集合，並替換掉匹配的項目
For Each Match in Matches
strHtml=Replace(strHTML,Match.Value,"")
Next
dropHtml=strHTML
Set objRegExp = Nothing
End Function
Function filterStr(Byval str,Byval filtertype)
if isNul(str) then filterStr="" : Exit Function
dim regObj, outstr,rulestr : set regObj=New Regexp
regObj.IgnoreCase=true : regObj.Global=true
Select case filtertype
case "html"
rulestr="(<[a-zA-Z].*?>)|(<[\/][a-zA-Z].*?>)"
case "jsiframe"
rulestr="(<(script|iframe).*?>)|(<[\/](script|iframe).*?>)"
end Select
regObj.Pattern=rulestr
outstr=regObj.Replace(str, "")
set regObj=Nothing : filterStr=outstr
End Function
Function getAgent()
getAgent=request.ServerVariables("HTTP_USER_AGENT")
End Function
Function getRefer()
getRefer=request.ServerVariables("HTTP_REFERER")
End Function
Function getServername()
getServername=request.ServerVariables("server_name")
End Function
Function isOutSubmit()
dim server1, server2
server1=getRefer
server2=getServername
if Mid(server1, 8, len(server2)) <> server2 then
isOutSubmit=true
else
isOutSubmit=false
end if
End Function
Function getIp()
dim forwardFor
getIp=request.servervariables("Http_X_Forwarded_For")
if getIp="" then getIp=request.servervariables("Remote_Addr")
getIp=replace(getIp, chr(39), "")
End Function
Function urlDecode(ByVal sUrl)
Dim i,c,ts,b,lc,t,n:ts="":b=false:lc=""
for i=1 to len(sUrl)
c=mid(sUrl,i,1)
if c="+" then
ts=ts & " "
elseif c="%" then
t=mid(sUrl,i+1,2):n=cint("&H" & t)
if b then
b=false:ts=ts & chr(cint("&H" & lc & t))
else
if abs(n)<=127 then
ts=ts & chr(n)
else
b=true:lc=t
end if
end if
i=i+2
else
ts=ts & c
end if
next
urldecode=ts
End Function
Function urlEncode(ByVal sUrl)
if InStr(" "&sUrl,"?")>0 then
dim ts,i,l,s:ts=Split(Mid(sUrl,InStr(sUrl,"?")+1),"&"):l=UBound(ts)
for i=0 to l
if InStr(" "&ts(i),"=")>0 then
s=Split(ts(i),"=")
if s(1)<>"" then
if InStr(" "&s(1),"%") then:s(1)=urldecode(s(1)):end if
s(1)=Server.urlencode(s(1)):ts(i)=Join(s,"=")
end if
end if
next
urlencode=Mid(sUrl,1,InStr(sUrl,"?"))&Join(ts,"&")
else
urlencode=sUrl
end if
End Function
dim gXmlHttpVer
Function getXmlHttpVer()
dim i,xmlHttpVersions,xmlHttpVersion
getXmlHttpVer=false
xmlHttpVersions=Array("Microsoft.XMLHTTP", "MSXML2.XMLHTTP", "MSXML2.XMLHTTP.3.0","MSXML2.XMLHTTP.4.0","MSXML2.XMLHTTP.5.0")
for i=0 to ubound(xmlHttpVersions)
xmlHttpVersion=xmlHttpVersions(i)
if isInstallObj(xmlHttpVersion) then getXmlHttpVer=xmlHttpVersion:gXmlHttpVer=xmlHttpVersion: Exit Function
next
End Function
Function tryXmlHttp()
dim i,ah:ah=array("MSXML2.ServerXMLHTTP.5.0","MSXML2.ServerXMLHTTP","MSXML2.ServerXMLHTTP.2.0","MSXML2.ServerXMLHTTP.3.0","MSXML2.ServerXMLHTTP.4.0","MSXML2.ServerXMLHTTP.6.0","Microsoft.XMLHTTP", "MSXML2.XMLHTTP", "MSXML2.XMLHTTP.3.0","MSXML2.XMLHTTP.4.0","MSXML2.XMLHTTP.5.0")
On Error Resume Next
for i=0 to UBound(ah)
SET tryXmlHttp=Server.CreateObject(ah(i))
if err.number=0 then:gXmlHttpVer=ah(i):tryXmlHttp.setTimeouts 2000,20000,20000,180000:err.clear:Exit Function:else:err.clear:end if
next
End Function
dim gXmlHttpObj
Function getRemoteContent(Byval url,Byval returnType)
if not isObject(gXmlHttpObj) then:set gXmlHttpObj=tryXmlHttp():end if
url=urlencode(url):gXmlHttpObj.open "GET",url,False
On error resume next
gXmlHttpObj.send()
if err.number = -2147012894 then
dim des
select case gXmlHttpObj.readyState
Case 1:des="解析域名或連接遠程服務器"
Case 2:des="發送請求"
Case 3:des="接收數據"
Case else:des="未知階段"
end select
die gXmlHttpVer&"組件 在請求 “"&url&"”時 發生" + des + " 超時錯誤,請重試.如果問題還沒解決，請聯系你的服務商"
else
select case returnType
case "text"
getRemoteContent=gXmlHttpObj.responseText
case "body"
getRemoteContent=gXmlHttpObj.responseBody
end select
end if
End Function
Function bytesToStr(Byval responseBody,Byval strCharSet)
with objStream
.Type=1
.Mode =3
.Open
.Write responseBody
.Position=0
.Type=2
.Charset=strCharSet
bytesToStr=objstream.ReadText
objstream.Close
End With
End Function
Function computeStrLen(Byval str)
dim strlen,charCount,i,an
str=trim(str)
charCount=len(str)
strlen=0
for i=1 to charCount
an=asc(mid(str,i,1))
if an < 0 or an >255 then
strlen=strlen + 2
else
strlen=strlen + 1
end if
next
computeStrLen=strlen
End Function
Function getStrByLen(Byval str, Byval strlen)
dim vStrlen,charCount,i,an
str=trim(str)
if isNul(str) then Exit Function
charCount=len(str)
vStrlen=0
for i=1 to charCount
an=asc(mid(str,i,1))
if an < 0 or an >255 then
vStrlen=vStrlen + 2
else
vStrlen=vStrlen + 1
end if
if vStrlen >= strlen then getStrByLen=left(str,i):Exit Function
next
getStrByLen=str
End Function
Function encodeHtml(Byval str)
IF len(str)=0 OR Trim(str)="" then exit function
str=replace(str,"<","<")
str=replace(str,">",">")
str=replace(str,CHR(34),""")
str=replace(str,CHR(39),"'")
encodeHtml=str
End Function
Function decodeHtml(Byval str)
IF len(str)=0 OR Trim(str)="" or isNull(str) then exit function
str=replace(str,"<","<")
str=replace(str,">",">")
str=replace(str,""",CHR(34))
str=replace(str,"'",CHR(39))
decodeHtml=str
End Function
Function decode(str)
if isnul(str) then exit function
dim strdecode
strdecode=replace(str," ",chr(13)&chr(10))
decode=replace(strdecode," ",chr(32))
End Function
Function encode(str)
dim strdecode
strdecode=replace(replace(str,chr(10),""),chr(13)," ")
encode=replace(strdecode,chr(32)," ")
End Function
Function filterDirty(content)
dim dirtyStrArray,i
dirtyStrArray=split(unescape(dirtyStr)," ")
for i=0 to ubound(dirtyStrArray)
content=replace(content,dirtyStrArray(i),"***",1,-1,1)
next
filterDirty=content
End Function
Function timeToStr(Byval t)
t=Replace(Replace(Replace(Replace(t,"-",""),":","")," ",""),"/","") : timeToStr=t
End Function
'分頁中部
Function makePageNumber(Byval currentPage,Byval pageListLen,Byval totalPages,Byval linkType,Byval sortid, Byval showType)
dim beforePages,pagenumber,page
dim beginPage,endPage,strPageNumber
if pageListLen mod 2 = 0 then beforePages = pagelistLen / 2 else beforePages = clng(pagelistLen / 2) - 1
if currentPage < 1 then currentPage = 1 else if currentPage > totalPages then currentPage = totalPages
if pageListLen > totalPages then pageListLen=totalPages
if currentPage - beforePages < 1 then
beginPage = 1 : endPage = pageListLen
elseif currentPage - beforePages + pageListLen > totalPages then
beginPage = totalPages - pageListLen + 1 : endPage = totalPages
else
beginPage = currentPage - beforePages : endPage = currentPage - beforePages + pageListLen - 1
end if
' die currentPage
for pagenumber = beginPage to endPage
if pagenumber=1 then page = "" else page = pagenumber
if pagenumber=currentPage then
if linkType="commentlist" then
strPageNumber=strPageNumber&""&pagenumber&""
else
strPageNumber=strPageNumber&""&pagenumber&""
end if
else
if showType="tags" then
strPageNumber=strPageNumber&""&pagenumber&""
elseif showType="taglist" then
dim tag
tag=filterPara(getForm("tag","get"))
strPageNumber=strPageNumber&""&pagenumber&""
elseif linkType="list" then
if runMode=1 then
if pagenumber>1 then
strPageNumber=strPageNumber&""&pagenumber&""
else
strPageNumber=strPageNumber&""&pagenumber&""
end if
else
if pagenumber>1 then
strPageNumber=strPageNumber&""&pagenumber&""
else
strPageNumber=strPageNumber&""&pagenumber&""
end if
end if
elseif linkType="userbuylist" then
strPageNumber=strPageNumber&""&pagenumber&""
elseif linkType="about" then
if runMode=1 then
if pagenumber>1 then
strPageNumber=strPageNumber&""&pagenumber&""
else
strPageNumber=strPageNumber&""&pagenumber&""
end if
else
if pagenumber>1 then
strPageNumber=strPageNumber&""&pagenumber&""
else
strPageNumber=strPageNumber&""&pagenumber&""
end if
end if
elseif linkType="gbooklist" then
strPageNumber=strPageNumber&""&pagenumber&""
elseif linkType="searchlist" then
dim searchtype,keys
searchtype=filterPara(getForm("searchtype","get"))
keys=filterPara(getForm("keys","get"))
strPageNumber=strPageNumber&""&pagenumber&""
elseif linkType="commentlist" then
strPageNumber=strPageNumber&""&pagenumber&""
else
if sortid="" then
strPageNumber=strPageNumber&""&pagenumber&""
else
if pagenumber>1 then
strPageNumber=strPageNumber&""&pagenumber&""
else
strPageNumber=strPageNumber&""&pagenumber&""
end if
end if
end if
end if
next
makePageNumber=strPageNumber
End Function
'分頁中部 後臺使用
Function makePageNumber_(Byval currentPage,Byval pageListLen,Byval totalPages,Byval linkType,Byval sortid, Byval order, Byval keyword)
dim beforePages,pagenumber,page
dim beginPage,endPage,strPageNumber
if pageListLen mod 2 = 0 then beforePages = pagelistLen / 2 else beforePages = clng(pagelistLen / 2) - 1
if currentPage < 1 then currentPage = 1 else if currentPage > totalPages then currentPage = totalPages
if pageListLen > totalPages then pageListLen=totalPages
if currentPage - beforePages < 1 then
beginPage = 1 : endPage = pageListLen
elseif currentPage - beforePages + pageListLen > totalPages then
beginPage = totalPages - pageListLen + 1 : endPage = totalPages
else
beginPage = currentPage - beforePages : endPage = currentPage - beforePages + pageListLen - 1
end if
' die currentPage
for pagenumber = beginPage to endPage
if pagenumber=1 then page = "" else page = pagenumber
if pagenumber=currentPage then
strPageNumber=strPageNumber&""&pagenumber&""
else
if linkType="newslist" then
'if runMode="0" then
strPageNumber=strPageNumber&""&pagenumber&""
'elseif runMode="1" then
' if pagenumber>1 then strPageNumber=strPageNumber&""&pagenumber&" " : else strPageNumber=strPageNumber&""&pagenumber&" "
'end if
elseif linkType="guestlist" then
strPageNumber=strPageNumber&""&pagenumber&""
else
if sortid="" then
strPageNumber=strPageNumber&""&pagenumber&""
else
strPageNumber=strPageNumber&""&pagenumber&""
end if
end if
end if
next
makePageNumber_=strPageNumber
End Function
'分頁兩側
Function pageNumberLinkInfo(Byval currentPage,Byval pageListLen,Byval totalPages,Byval linkType,Byval sortid, Byval showType)
dim pageNumber,pagesStr,i,pageNumberInfo,firstPageLink,lastPagelink,nextPagelink,finalPageLink
pageNumber=makePageNumber(currentPage,pageListLen,totalPages,linkType,sortid,showType)
dim searchtype,keys,tag
searchtype=filterPara(getForm("searchtype","get"))
keys=filterPara(getForm("keys","get"))
tag=filterPara(getForm("tag","get"))
if currentPage=1 then
firstPageLink=""&str_01&"" : lastPagelink=""&str_03&""
else
if linkType="gbooklist" then
firstPageLink=""&str_01&"" : lastPagelink=""&str_03&""
elseif linkType="userbuylist" then
firstPageLink=""&str_01&"" : lastPagelink=""&str_03&""
elseif linkType="searchlist" then
firstPageLink=""&str_01&"" : lastPagelink=""&str_03&""
elseif showType="tags" then
firstPageLink=""&str_01&"" : lastPagelink=""&str_03&""
elseif showType="taglist" then
firstPageLink=""&str_01&"" : lastPagelink=""&str_03&""
else
if runMode=0 then
firstPageLink=""&str_01&"" : if currentPage>2 then lastPagelink=""&str_03&"" : else lastPagelink=""&str_03&""
else
firstPageLink=""&str_01&"" : if currentPage>2 then lastPagelink=""&str_03&"" : else lastPagelink=""&str_03&""
end if
end if
end if
if currentPage=totalPages then
nextPagelink=""&str_04&"" : finalPageLink=""&str_02&""
else
if linkType="gbooklist" then
nextPagelink=""&str_04&"" : finalPageLink=""&str_02&""
elseif linkType="searchlist" then
nextPagelink=""&str_04&"" : finalPageLink=""&str_02&""
elseif linkType="userbuylist" then
nextPagelink=""&str_04&"" : finalPageLink=""&str_02&""
elseif showType="tags" then
nextPagelink=""&str_04&"" : finalPageLink=""&str_02&""
elseif showType="taglist" then
nextPagelink=""&str_04&"" : finalPageLink=""&str_02&""
else
if runMode=0 then
nextPagelink=""&str_04&"" : finalPageLink=""&str_02&""
else
nextPagelink=""&str_04&"" : finalPageLink=""&str_02&""
end if
end if
end if
pageNumberInfo=""&firstPageLink&lastPagelink&pageNumber&""&nextPagelink&""&finalPagelink
pageNumberLinkInfo=pageNumberInfo
End Function
'在str中是否存在findstr
Function isExistStr(str,findstr)
if isNul(str) or isNul(findstr) then isExistStr=false:Exit Function
if instr(str,findstr)>0 then isExistStr=true else isExistStr=false
End Function
Function getSubStrByFromAndEnd(str,startStr,endStr,operType)
dim location1,location2
select case operType
case "start"
location1=instr(str,startStr)+len(startStr):location2=len(str)+1
case "end"
location1=1:location2=instr(location1,str,endStr)
case else
location1=instr(str,startStr)+len(startStr):location2=instr(location1,str,endStr)
end select
getSubStrByFromAndEnd=mid(str,location1,location2-location1)
End Function
'轉換時間
Function formatDate(Byval t,Byval ftype)
dim y, m, d, h, mi, s
formatDate=""
If IsDate(t)=False Then Exit Function
y=cstr(year(t))
m=cstr(month(t))
If len(m)=1 Then m="0" & m
d=cstr(day(t))
If len(d)=1 Then d="0" & d
h = cstr(hour(t))
If len(h)=1 Then h="0" & h
mi = cstr(minute(t))
If len(mi)=1 Then mi="0" & mi
s = cstr(second(t))
If len(s)=1 Then s="0" & s
select case cint(ftype)
case 1
' yyyy-mm-dd
formatDate=y & "-" & m & "-" & d
case 2
' yy-mm-dd
formatDate=right(y,2) & "-" & m & "-" & d
case 3
' mm-dd
formatDate=m & "-" & d
case 4
' yyyy-mm-dd hh:mm:ss
formatDate=y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
case 5
' hh:mm:ss
formatDate=h & ":" & mi & ":" & s
case 6
' yyyy年mm月dd日
formatDate=y & "年" & m & "月" & d & "日"
case 7
' yyyymmdd
formatDate=y & m & d
case 8
'yyyymmddhhmmss
formatDate=y & m & d & h & mi & s
end select
End Function
'過濾參數
Function filterPara(byVal Para)
filterPara=preventSqlin(Checkxss(Para))
End Function
Function preventSqlin(content)
dim sqlStr,sqlArray,i,speStr
sqlStr="<|>|%|%27|'|''|;|*|and|exec|dbcc|alter|drop|insert|select|update|delete|count|master|truncate|char|declare|where|set|declare|mid|chr"
if isNul(content) then Exit Function
sqlArray=split(sqlStr,"|")
for i=lbound(sqlArray) to ubound(sqlArray)
if instr(lcase(content),sqlArray(i))<>0 then
select case sqlArray(i)
case "<":speStr="<"
case ">":speStr=">"
case "'","""":speStr="""
'case ";":speStr="；"
case else:speStr=""
end select
content=replace(content,sqlArray(i),speStr,1,-1,1)
end if
next
preventSqlin=content
End Function
'過濾xss註入
Function checkxss(byVal ChkStr)
dim Str,re
Str = ChkStr
if IsNull(Str) then Checkxss = "" : Exit Function
Str = Replace(Str, "&", "&") : Str = Replace(Str, "'", "´") : Str = Replace(Str, """", """) : Str = Replace(Str, "<", "<") : Str = Replace(Str, ">", ">") : Str = Replace(Str, "/", "/") : Str = Replace(Str, "*", "*")
Set re = New RegExp
re.IgnoreCase = True : re.Global = True
re.Pattern = "(w)(here)" : Str = re.Replace(Str, "$1here")
re.Pattern = "(s)(elect)" : Str = re.Replace(Str, "$1elect")
re.Pattern = "(i)(nsert)" : Str = re.Replace(Str, "$1nsert")
re.Pattern = "(c)(reate)" : Str = re.Replace(Str, "$1reate")
re.Pattern = "(d)(rop)" : Str = re.Replace(Str, "$1rop")
re.Pattern = "(a)(lter)" : Str = re.Replace(Str, "$1lter")
re.Pattern = "(d)(elete)" : Str = re.Replace(Str, "$1elete")
re.Pattern = "(u)(pdate)" : Str = re.Replace(Str, "$1pdate")
re.Pattern = "(\s)(or)" : Str = re.Replace(Str, "$1or")
re.Pattern = "(java)(script)" : Str = re.Replace(Str, "$1script")
re.Pattern = "(j)(script)" : Str = re.Replace(Str, "$1script")
re.Pattern = "(vb)(script)" : Str = re.Replace(Str, "$1script")
If Instr(Str, "expression") > 0 Then Str = Replace(Str, "expression", "expression", 1, -1, 0)
Set re = Nothing
Checkxss = Str
End Function
'獲取SortID分類的頂級分類ID
Function getTopId(byval SortID)
dim sqlStr,rsObj,ChildArray,i
sqlStr= "select SortID,SortPath from {prefix}Sort where ParentID=0"
set rsObj = conn.Exec(sqlStr,"r1")
do while not rsObj.eof
ChildArray=split(rsObj(1),",")
for i=0 to ubound (ChildArray)
if cint(ChildArray(i))=cint(SortID) then GetTopId=rsObj(0) : exit for : exit do
next
rsObj.movenext
loop
rsObj.close
set rsObj = nothing
End Function
'前臺類別
Function makeqtType(topId,separateStr,classname)
dim sqlStr,rsObj,selectedStr,qtstr,qtspan
sqlStr= "select SortID,SortName,SortStyle from {prefix}Sort where SortStatus and ParentID="&topId&" order by SortID asc"
set rsObj = conn.Exec(sqlStr,"r1")
do while not rsObj.eof
if runMode="0" then
qtstr = qtstr + "
"
end if
qtspan=qtspan&separateStr
makeqtType rsObj("SortID"),separateStr,classname
rsObj.movenext
loop
if not isNul(qtspan) then qtspan = left(qtspan,len(qtspan)-len(separateStr))
rsObj.close
set rsObj = nothing
makeqtType=qtstr
End Function
'所有類別
Sub makeTypeOption(topId,separateStr,compareValue,sortid)
dim sqlStr,rsObj,selectedStr
sqlStr= "select ID,SortName from {prefix}Sort where ParentID="&topId&" and IsOut=0 order by ID asc"
set rsObj = conn.Exec(sqlStr,"r1")
do while not rsObj.eof
if rsObj("ID")=compareValue then selectedStr=" selected" else selectedStr=""
print ""
span=span&separateStr
makeTypeOption rsObj("ID"),separateStr,compareValue,sortid
rsObj.movenext
loop
if not isNul(span) then span = left(span,len(span)-len(separateStr))
rsObj.close
set rsObj = nothing
End Sub
'判斷一個類別是否有子類
Function hasChild(TableName,ClassID)
Dim HasChild_SQL : HasChild_SQL="SELECT COUNT(*) FROM ["&TableName&"] WHERE [ParentID]="&ClassID
Dim HasChild_Rs : Set HasChild_Rs=conn.Exec(HasChild_SQL,"r1")
Dim Has
IF HasChild_Rs(0)>0 Then
Has=True
Else
Has=False
End IF
HasChild_Rs.Close : Set HasChild_Rs=Nothing
HasChild=Has
End Function
'獲取某個類別表的某個類別的最小子類列表
Function getSmallestChild(TableName,ClassID)
Dim Str
IF HasChild(TableName,ClassID) Then
Str=GetSmallestChild_Sub(TableName,ClassID,"")
Else
Str=ClassID&","
End IF
GetSmallestChild=Left(Str,Len(Str)-1)
End Function
'獲取某個類別表的某個類別的最小子類列表,GetSmallestChild函數調用的遞歸函數
Function getSmallestChild_Sub(TableName,ClassID,TmpStr)
IF HasChild(TableName,ClassID) Then
Dim GetSmallestChild_Sub_SQL : GetSmallestChild_Sub_SQL="SELECT [SortID] FROM ["&TableName&"] WHERE [ParentID]="&ClassID
Dim GetSmallestChild_Sub_Rs : Set GetSmallestChild_Sub_Rs=conn.Exec(GetSmallestChild_Sub_SQL,"r1")
While Not (GetSmallestChild_Sub_Rs.Eof Or GetSmallestChild_Sub_Rs.Bof)
Dim TmpClassID : TmpClassID=GetSmallestChild_Sub_Rs(0)
IF HasChild(TableName,TmpClassID) Then
TmpStr=GetSmallestChild_Sub(TableName,TmpClassID,TmpStr)
Else
TmpStr=TmpStr&TmpClassID&","
End IF
GetSmallestChild_Sub_Rs.MoveNext
Wend
Else
TmpStr=TmpStr&ClassID&","
End IF
GetSmallestChild_Sub=TmpStr
End Function
'獲取當前類下所有子類 allsub 1帶父級，0所有最小類
Function getSubSort(sortID, allsub)
dim rs, sql
sql="select (select count(*) from {prefix}Sort where ParentID in ("&sortID&")), * from {prefix}Sort where ParentID in("&sortID&")"
set rs=conn.exec(sql, "exe")
'echo sql &" "
if rs.eof then
getSubSort=sortID&","
else
if allsub=1 then getSubSort=sortID&","
do while not rs.eof
getSubSort=getSubSort&getSubSort(rs("sortID"), allsub)
rs.movenext
loop
end if
End Function
'獲取checkbox的值,選中為1，選為0
function getCheck(cValue)
if isnul(cValue) then
getCheck=0
elseif cValue="1" then
getCheck=1
end if
end function
'將null替換成空
Function repnull(str)
'echo str
'echo " "
repnull=str
if isnul(str) then repnull=""
End Function
Function getStr(Stat,str1,str2)
if Stat=1 then
getStr=str1
else
getStr=str2
end if
End Function
'獲取當前頁面名稱
Function getPageName()
Dim fileName,arrName,postion
fileName=Request.ServerVariables("script_name")
postion=InstrRev(fileName,"/")+1
fileName=Mid(fileName,postion)
If InStr(fileName,"?")>0 Then
arrName=fileName
arrName=Split(arrName,"?")
filename=arrName(0)
End If
getPageName=filename
End Function
Function CheckAdmin(filename)
if isnul(rCookie("adminName")) then
alertMsgAndGo"您還沒有登陸","/"
else
dim Permissions
Permissions=rCookie("groupMenu")
if Permissions<>"all" and isnul(Permissions) then
alertMsgAndGo"您沒有訪問權限","-1"
elseif Permissions="all" then
exit function
end if
end if
End Function
Function checkLogin()
if isnul(rCookie("adminName")) or rCookie("adminName")="" then
alertMsgAndGo"您還沒有登陸","/"
else
dim Permissions
Permissions=rCookie("groupMenu")
if Permissions<>"all" and isnul(Permissions) then
alertMsgAndGo"您沒有訪問權限","-1"
end if
end if
End Function
'從內容裏面提取圖片
Function getImgFromText(strng)
Dim regEx, Match, Matches '建立變量。
Set regEx = New RegExp '建立正則表達式。
regEx.Pattern = "(<)(.[^<]*)(src=)('|"&CHR(34)&"| )?(.[^'|\s|"&CHR(34)&"]*)(\.)(jpg|gif|png|bmp|jpeg)('|"&CHR(34)&"|\s|>)(.[^>]*)(>)" '設置模式。
regEx.IgnoreCase = true '設置是否區分字符大小寫。
regEx.Global = True '設置全局可用性。
Set Matches = regEx.Execute(strng) '執行搜索。
For Each Match in Matches '遍歷匹配集合。
values=values&Match.Value&"{|LDIV|}"
Next
RegExpExecute = values
End Function
Function getDataCount(sqlStr)
getDataCount=conn.Exec(sqlStr,"exe")(0)
End Function
Function loadSelect(selName,tableName,fieldText,fieldValue,selected, ParentID,strOrder,topText)
echo "" & vbcr
End Function
Function makeOption(tableName,fieldText,fieldValue,selected,strOrder,ParentID)
Dim rs ,sel
sel=""
set rs =conn.Exec ("select ["&fieldValue&"],["&fieldText&"],ParentID,SortLevel,(select count(*) from {prefix}Sort where ParentID=t.SortID) as c from "&tableName&" as t where LanguageID="&rCookie("languageID")&" and ParentID="&ParentID&" "&strOrder,"r1")
Do While Not rs.Eof
IF CSTR(selected)=CSTR(rs(0)) Then sel = "selected=""selected""" else sel="" end if
dim rscount:rscount=0
echo "" & vbcr
if rs(4)>0 then
makeOption = makeOption & makeOption(tableName,fieldText,fieldValue,selected,strOrder,rs(0))
end if
rs.MoveNext
Loop
rs.Close : Set rs=Nothing
End Function
function getLevel(num)
if not isnum(num) then exit Function
dim i
getLevel=""
for i=2 to num
getLevel=getLevel&""
next
if num<>"1" then getLevel=getLevel&""
end function
function getLevel_(num)
if not isnum(num) then exit Function
dim i
getLevel_=""
for i=2 to num
getLevel_=getLevel_&"┃"
next
if num<>"1" then getLevel_=getLevel_&"┝"
end function
Function getTodayVisits
getTodayVisits=conn.Exec("select sum(Visits) from {prefix}Visits where year(AddTime)="&Year(date)&" and month(AddTime)="&month(date)&" and day(AddTime)="&day(date),"r1")(0)
if isnul(getTodayVisits) then getTodayVisits=0
End Function
Function getYesterdayVisits
getYesterdayVisits=conn.Exec("select sum(Visits) from {prefix}Visits where year(AddTime)="&Year(DateAdd("d",-1,date))&" and month(AddTime)="&month(DateAdd("d",-1,date))&" and day(AddTime)="&day(DateAdd("d",-1,date)),"r1")(0)
if isnul(getYesterdayVisits) then getYesterdayVisits=0
End Function
Function getMonthVisits
getMonthVisits=conn.Exec("select sum(Visits) from {prefix}Visits where year(AddTime)="&Year(date)&" and month(AddTime)="&month(date),"r1")(0)
if isnul(getMonthVisits) then getMonthVisits=0
End Function
Function getAllVisits
getAllVisits=conn.Exec("select sum(Visits) from {prefix}Visits","r1")(0)
if isnul(getAllVisits) then getAllVisits=0
End Function
Function getExtend(fileName)
GetExtend = Mid(fileName,Instr(fileName,".")+1,Len(fileName)-Instr(fileName,"."))
End Function
Function getTemplateFile(Byval sortID,Byval str,Byval sStyle)
getTemplateFile=conn.exec("select SortTemplate from {prefix}Sort where SortID="&SortID ,"r1")(0)
if isnul(getTemplateFile) then
if str="" then
getTemplateFile="about.html"
else
if sStyle=1 then
getTemplateFile=str&".html"
elseif sStyle=2 then
getTemplateFile=str&"list.html"
end if
end if
end if
End Function
Function checkTemplateFile(Byval fileName)
CheckTemplateFile=false
if isExistFile(fileName)then CheckTemplateFile=true
End Function
Function ipHide(ipstr)
dim t,ipx,ipfb
if not isnull(ipstr) then
t = 0
ipx=""
ipfb = split(ipstr, ".",4)
for t = 0 to 2
ipx = ipx&ipfb(t)&"."
next
ipHide = ipx&"*"
end if
end Function
Function userGroupSelect(selName, selOption, usertype)
dim selStr
if isnul(selOption) then selOption=0
selStr= "" & vbcr
userGroupSelect=selStr
end Function
Function viewNoRight(GroupID, Exclusive)
Dim rs, sql, GroupMark
Set rs =Conn.Exec("select GroupMark from {prefix}UserGroup where GroupID="&GroupID,"r1")
if not rs.eof then
GroupMark = rs("GroupMark")
else
GroupMark=0
end if
rs.Close
Set rs = Nothing
viewNoRight = True
If session("GroupMark") = "" Then session("GroupMark") = 0
select case Exclusive
case ">="
If Not session("GroupMark") >= GroupMark Then
viewNoRight = False
End If
case "="
If Not session("GroupMark") = GroupMark Then
viewNoRight = False
End If
end select
End Function
'actiontype (del, on, off)
Sub onOff(actionType, tabName, idField, upField, whereStr, url)
dim id : id=getForm("id","both")
if isnul(id) then alertMsgAndGo "請選擇要操作的內容","-1"
if actionType="on" then
conn.exec "update {prefix}"&tabName&" set "&upField&"=1 where "&idField&" in("&id&") "&whereStr,"exe"
else
dim ids,i
ids=split(id,",")
if tabName="UserGroup" then
for i=0 to ubound(ids)
if ids(i)>4 then conn.exec "update {prefix}"&tabName&" set "&upField&"=0 where "&idField&"="&ids(i)&" "&whereStr,"exe"
next
elseif tabName="User" then
for i=0 to ubound(ids)
if ids(i)>1 then conn.exec "update {prefix}"&tabName&" set "&upField&"=0 where "&idField&"="&ids(i)&" "&whereStr,"exe"
next
else
conn.exec "update {prefix}"&tabName&" set "&upField&"=0 where "&idField&" in("&id&") "&whereStr,"exe"
end if
end if
response.Redirect url
End Sub
'單篇2,文章0,產品3,下載4,招聘6,相冊1,鏈接5
'單篇1,文章2,產品3,下載4,招聘5,相冊6,鏈接7
'"單篇,文章,產品,下載,招聘,相冊,鏈接"
Function makeSortTypeSelect(selName, selOption, events)
dim selStr, types, i, sel
types=split(sortTypes, ",")
if isnul(selOption) then selOption=0
selStr= "" & vbcr
makeSortTypeSelect=selStr
End Function
Function groupMenuChecked(menus_, mid_)
dim i, menus
groupMenuChecked=""
if menus_="all" then
groupMenuChecked="checked=""checked"""
elseif not isnul(menus_) then
menus=split(menus_, ",")
for i=0 to ubound(menus)
if cstr(trim(menus(i)))=cstr(trim(mid_)) then groupMenuChecked="checked=""checked""" : exit for
next
end if
End Function
'sendMail"13322712@qq.com","QQ","aaaa","bb"
'收件人郵箱，發件人姓名，標題，內容
Function sendMail(email,sendname,zhuti,mailbody)
Server.ScriptTimeOut=5000
If Not isInstallObj("JMail.Message") Then exit function
dim jmail : set jmail=Server.CreateObject("JMail.Message")
If jmail is nothing then exit function
set jmail= server.CreateObject ("Jmail.message") '調用Jmail組件
jmail.Silent = true
jmail.Charset = "utf-8"
JMail.ContentType = "text/html"
'調用變量內容
'=================================
'發件人郵箱
jmail.From = smtp_usermail
'發件人姓名
jmail.FromName = sendname
'收件人郵箱
jmail.ReplyTo = email
'郵件標題
jmail.Subject = zhuti
'收件人郵箱
jmail.AddRecipient email
'郵件內容
jmail.Body = mailbody
'用戶名
jmail.MailServerUserName = smtp_user
'密碼
jmail.MailServerPassWord = smtp_password
'發送郵件
sendMail=jmail.Send(smtp_server)
jmail.close : set jmail = nothing
End Function
'圖片水印
'waterMarkImg(saveImgPath,waterMarkLocation)
Function waterMarkImg(saveImgPath,location)
dim sAllowMarkExt:sAllowMarkExt = ".jpg,.png,.gif,.jpeg,.bmp"
'Left(saveImgPath,inStrRev(saveImgPath,".")-1)
If InStr(sAllowMarkExt, Mid(saveImgPath, InStrRev(saveImgPath, "."), Len(saveImgPath))) = 0 Then Exit Function
'die instr(mid(saveImgPath,sAllowMarkExt)
If Not isInstallObj("Persits.Jpeg") Then exit function
dim jpegObj : set jpegObj = Server.CreateObject("Persits.Jpeg")
dim strWidth,strHeight : strWidth=len(waterMarkFont)*13 : strHeight=3
jpegObj.Open Server.MapPath(saveImgPath)
If jpegObj is nothing then exit function
if jpegObj.width <200 and jpegObj.height<200 then exit function
'為圖片加入水印功能
jpegObj.Canvas.Font.Color = &H000000 ' 顏色,這裏是設置成:黑
jpegObj.Canvas.Font.Family = "方正隸變簡體" ' 設置字體
jpegObj.Canvas.Font.Bold = False '是否設置成粗體
jpegObj.Canvas.Font.Size = 26 '字體大小
jpegObj.Canvas.Font.Quality = 4 ' 文字清晰度
select case location
case "1" : jpegObj.Canvas.Print 5 , strHeight, waterMarkFont
case "2" : jpegObj.Canvas.Print (jpegObj.width-strWidth) / 2, strHeight, waterMarkFont
case "3" : jpegObj.Canvas.Print jpegObj.width-strWidth-5, strHeight, waterMarkFont
case "4" : jpegObj.Canvas.Print 5 , (jpegObj.height-strHeight)/2, waterMarkFont
case "5" : jpegObj.Canvas.Print (jpegObj.width-strWidth) / 2, (jpegObj.height-strHeight)/2, waterMarkFont
case "6" : jpegObj.Canvas.Print jpegObj.width-strWidth-5, (jpegObj.height-strHeight)/2, waterMarkFont
case "7" : jpegObj.Canvas.Print 5 , jpegObj.height-40, waterMarkFont
case "8" : jpegObj.Canvas.Print (jpegObj.width-strWidth) / 2, jpegObj.height-40, waterMarkFont
case else : jpegObj.Canvas.Print jpegObj.width-strWidth-5, jpegObj.height-40, waterMarkFont
end select
jpegObj.Save Server.MapPath(saveImgPath) ' 保存文件
set jpegObj=Nothing
End Function
'獲得目錄
Function getAdminDir
dim scriptname
dim page,systempath
scriptname=request.servervariables("script_name")
page=replace(scriptname,"\","/")
page=lcase(right(page,len(page)-instrrev(page,"/")))
systempath=left(scriptname,len(scriptname)-len(page)-1)
getAdminDir=right(systempath,len(systempath)-instrrev(systempath,"/"))
End Function
'通過TAG內容獲取到ID
Function getTagID(tag)
dim sql,rs,tags,tagIDs
tags=split(tag, ",")
for each tag in tags
if not isnul(tag) then
sql="select TagID from {prefix}Tag where TagName='"&tag&"'"
set rs=conn.exec(sql,"r1")
if not rs.eof then
getTagID=getTagID&"{"&rs(0)&"}"
end if
end if
next
rs.close : set rs=nothing
End Function
rem 通過內容中的ID獲取TAG內容
Function getTags(tagID)
dim sql,rs
if isnul(tagID) then exit function
sql="select * from {prefix}Tag where TagID in("&replace(replace(replace(tagID,"}{",","),"{",""),"}","")&")"
set rs=conn.exec(sql,"r1")
do while not rs.Eof
getTags=getTags&rs("TagName")&","
rs.movenext
loop
rs.close : set rs=nothing
'getTags=left(getTags,len(getTags)-1)
if not isnul(getTags) then getTags=left(getTags,len(getTags)-1)
End Function
rem 為TAG加鏈接
Function tagsLink(tags)
dim sql,rs,link,tag
link=sitePath&setting.languagePath&"taglist.asp?tag="
tags=split(tags, ",")
for each tag in tags
if not isnul(tag) then
tagsLink=tagsLink&""&tag&","
end if
next
if not isnul(tagsLink) then tagsLink=left(tagsLink,len(tagsLink)-1)
End Function
%>