asp常用函數(shù)集合，非常不錯(cuò)以后研究第3/4頁(yè)
更新時(shí)間：2008年01月12日 16:36:13 作者：
asp常用函數(shù)集合，非常不錯(cuò)以后研究
function createnewsclass(id)
dim arrcont:arrcont = getcurclasscount(id)
dim i,j
for i = 0 to arrcont - 1
dim Temp:Temp = ""
Temp = processcustomtag(loadtempletfile("../templet/" & getclassall(id,1) & ""))
Temp = X_processcustomtag(Temp)
dim charclass
set charclass = new stringclass
dim PatrnStr
PatrnStr = "<title>.*?</title>"
Temp = charclass.replacestr(PatrnStr,Temp,"<title>" & charclass.getstr(getclassname(id)) & " - " & site_name & "</title>")
PatrnStr = "\{\$guide\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,guide(id))
PatrnStr = "\{\$keywords\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_keywords)
PatrnStr = "\{\$search\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,search())
PatrnStr = "\{\$description\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_description)
PatrnStr = "\{\$copyright\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_copyright)
PatrnStr = "\{\$root\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_root)
dim sPATH,cPATH:cPATH = "" & site_root & "/" & site_html & "/" & getclasspath(id) & "/"
createdir(server.mappath(cPATH))
dim PageHTM:PageHTM = ""
if i = 0 then
sPATH = "" & cPATH & "index" & site_extname & ""
else
sPATH = "" & cPATH & "index" & site_extname & ""
sPATH = left(sPATH,(len(sPATH)-len(site_extname))) & "_" & i + 1 & site_extname
end if
if arrcont >= 2 then
if i = 0 then
PageHTM = PageHTM & "【首頁(yè)】-"
PageHTM = PageHTM & "【上頁(yè)】"
end if
if i > 1 then
PageHTM = PageHTM & "【<a href=""index" & site_extname & """>首頁(yè)</a>】-"
PageHTM = PageHTM & "【<a href=""index" & "_" & i & site_extname & """>上頁(yè)</a>】"
end if
if i = 1 Then
PageHTM = PageHTM & "【<a href=""index" & site_extname & """>首頁(yè)</a>】-"
PageHTM = PageHTM & "【<a href=""index" & site_extname & """>上頁(yè)</a>】"
end if
PageHTM = PageHTM & "-【第<font color=""red"">" & i + 1 & "</font>頁(yè)】/【共<font color=""red"">" & arrcont & "</font>頁(yè)】-"
if i < arrcont - 1 then
PageHTM = PageHTM & "【<a href=""index" & "_" & i + 2 & site_extname & """>下頁(yè)</a>】-"
PageHTM = PageHTM & "【<a href=""index" & "_" & arrcont & site_extname & """>尾頁(yè)</a>】- "
end if
if i = arrcont - 1 then
PageHTM = PageHTM & "【下頁(yè)】-"
PageHTM = PageHTM & "【尾頁(yè)】- "
end if
PageHTM = PageHTM & "<select name=""page"" onchange=""self.location.href=this.options[this.selectedIndex].value"">"
PageHTM = PageHTM & "<option selected>頁(yè)/碼</option>"
PageHTM = PageHTM & "<option value=""index" & site_extname & """>第1頁(yè)</option>"
for j = 1 to arrcont - 1
PageHTM = PageHTM & "<option value=""index" & "_" & j + 1 & site_extname & """>第" & j + 1 & "頁(yè)</option>"
next
PageHTM = PageHTM & "</select>"
end if
PatrnStr = "{news:[^<>]+?\/}"
Temp = charclass.classcustomtag(PatrnStr,Temp,id,i + 1,"<p align=""center"">" & PageHTM & "</p>" & chr(10) & "")
dim objstream
set objstream = server.createobject("adodb.stream")
with objstream
.open
.charset = "" & chrset & ""
.position = objstream.size
.writetext = Temp
.savetofile server.mappath(sPATH),2
.close
end with
next
set objstream = nothing
if err.number <> 0 then
err.clear
createnewsclass = false
else
createnewsclass = true
end if
end function
function createnewsfile(id)
dim rs,sql
set rs = server.createobject("adodb.recordset")
sql = "select id,classid,title,content,author,source,keywords,bimg,simg,filename,pagetype,addtime from NCMS_news where id=" & id
rs.open sql,conn,1,1
dim databox:databox = rs.getrows()
rs.close:set rs = nothing
dim Temp:Temp = ""
if databox(10,0) = 0 then
Temp = processcustomtag(loadtempletfile("../templet/" & getclassall(databox(1,0),2) & ""))
Temp = X_processcustomtag(Temp)
else
Temp = processcustomtag(loadtempletfile("../templet/" & site_stemp & ""))
Temp = X_processcustomtag(Temp)
end if
dim charclass
set charclass = new stringclass
dim PatrnStr,AdvCont
PatrnStr = "<title>.*?</title>"
Temp = charclass.replacestr(PatrnStr,Temp,"<title>" & charclass.getstr(databox(2,0)) & " - " & site_name & "</title>")
PatrnStr = "{news:[^<>]+?\/}"
Temp = charclass.newscustomtag(PatrnStr,Temp,databox(1,0),databox(0,0),databox(6,0))
PatrnStr = "\{\$id\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(0,0))
PatrnStr = "\{\$classid\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(1,0))
PatrnStr = "\{\$title\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(2,0))
PatrnStr = "\{\$author\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(4,0))
PatrnStr = "\{\$source\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(5,0))
PatrnStr = "\{\$keywords\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(6,0))
PatrnStr = "\{\$click\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,click(databox(0,0)))
PatrnStr = "\{\$addtime\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,databox(11,0))
PatrnStr = "\{\$guide\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,guide(databox(1,0)))
PatrnStr = "\{\$search\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,search())
PatrnStr = "\{\$fontselect\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,fontselect())
PatrnStr = "\{\$toolbar\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,toolbar(databox(0,0)))
PatrnStr = "\{\$copyurl\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,copyurl())
PatrnStr = "\{\$description\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_description)
PatrnStr = "\{\$copyright\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_copyright)
PatrnStr = "\{\$root\$\}"
Temp = charclass.replacestr(PatrnStr,Temp,site_root)
PatrnStr = "\{\$advarea\$\}"
AdvCont = databox(3,0)
AdvCont = charclass.replacestr(PatrnStr,AdvCont,advshow(site_advcode))
dim tempArr,n,sPATH,ePATH,cPATH:cPATH = "" & site_root & "/" & site_html & "/" & getclasspath(databox(1,0)) & "/"
if instr(databox(9,0),"/") = 0 then
createdir(server.mappath(cPATH))
else
tempArr = split(databox(9,0),"/")
for n = 0 to ubound(tempArr)
ePATH = replace(databox(9,0),tempArr(n),"")
next
createdir(server.mappath(cPATH & ePATH))
end if
dim TTemp:TTemp = Temp
dim arrcont:arrcont = split(AdvCont,"{$split$}",-1,1)
dim PageHTM:PageHTM = ""
dim i,j,k:k = ubound(arrcont)
for i = 0 to k
if i = 0 then
sPATH = "" & cPATH & databox(9,0) & site_extname & ""
else
sPATH = "" & cPATH & databox(9,0) & site_extname & ""
sPATH = left(sPATH,(len(sPATH)-len(site_extname))) & "_" & i + 1 & site_extname
end if
if sPATH = "" then
createnewsfile = false
exit function
end if
if k >= 1 then
PageHTM = "<p align=""center"">【本新聞共<font color=""red"">" & k + 1 & "</font>頁(yè)】-"
if i = 0 then
PageHTM = PageHTM & "【首頁(yè)】-"
PageHTM = PageHTM & "【上頁(yè)】-"
end if
if i > 1 then
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & site_extname & """>首頁(yè)</a>】-"
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & "_" & i & site_extname & """>上頁(yè)</a>】-"
end if
if i = 1 Then
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & site_extname & """>首頁(yè)</a>】-"
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & site_extname & """>上頁(yè)</a>】-"
end if
if i < k then
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & "_" & i + 2 & site_extname & """>下頁(yè)</a>】-"
PageHTM = PageHTM & "【<a href=""" & cPATH & databox(9,0) & "_" & k + 1 & site_extname & """>尾頁(yè)</a>】-"
end if
if i = k then
PageHTM = PageHTM & "【下頁(yè)】-"
PageHTM = PageHTM & "【尾頁(yè)】-"
end if
PageHTM = PageHTM & "【當(dāng)前在第<font color=""red"">" & i + 1 & "</font>頁(yè)】</p>"
else
PageHTM = ""
end if
PatrnStr = "\{\$content\$\}"
Temp = charclass.replacestr(PatrnStr,TTemp,"" & chr(10) & "<div id=""content"">" & chr(10) & arrcont(i) & PageHTM & chr(10) & "</div>" & chr(10))
dim objstream
set objstream = server.createobject("adodb.stream")
with objstream
.open
.charset = "" & chrset & ""
.position = objstream.size
.writetext = X_processcustomtag(Temp)
.savetofile server.mappath(sPATH),2
.close
end with
set objstream = nothing
next
if err.number <> 0 then
err.clear
createnewsfile = false
else
conn.execute("update NCMS_news set created=1 where id=" & databox(0,0))
createnewsfile = true
databox = ""
end if
end function
function createnewsjs(show,id,len,num,lih,col,filename)
dim TempHTM,xsql,rs,databox,i
TempHTM = "document.writeln('<table cellpadding=\""0\"" cellspacing=\""0\"" width=\""100%\"" border=\""0\"">');"
TempHTM = TempHTM & "document.writeln('<tr>');"
select case show
case "new"
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and created=1 and pagetype=0 order by id desc")
end if
case "elite"
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where elite=1 and created=1 and pagetype=0 order by id desc")
else
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and elite=1 and created=1 and pagetype=0 order by id desc")
end if
case "hot"
if id = 0 then
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where click>=100 and created=1 and pagetype=0 order by click desc")
else
set rs = conn.execute("select top " & num & " classid,title,filename from NCMS_news where classid in(" & id & allchildclass(id) & ") and click>=100 and created=1 and pagetype=0 order by click desc")
end if
case else
response.write("[新聞?lì)愋蚞參數(shù)錯(cuò)誤!")
response.end()
end select
if rs.eof then
rs.close:set rs = nothing
TempHTM = "document.writeln('<li><font color=\""red\"">暫時(shí)沒(méi)有新聞!<\/font><\/li>');"
else
databox = rs.getrows()
rs.close:set rs = nothing
for i = 0 to ubound(databox,2)
TempHTM = TempHTM & "document.writeln('<td height=\""" & lih & "\"" align=\""left\"" valign=\""middle\"">·<a href=\""" & site_root & "/" & site_html & "/" & getclasspath(databox(0,i)) & "/" & databox(2,i) & site_extname & "\"" title=\""" & databox(1,i) & "\"" target=\""_blank\"">" & gottopic(databox(1,i),len) & "<\/a><\/td>');"
if i = ubound(databox,2) then
TempHTM = TempHTM & "document.writeln('<\/tr>');"
else
if cint((i+1) mod col) = 0 then
TempHTM = TempHTM & "document.writeln('<\/tr>');"
TempHTM = TempHTM & "document.writeln('<tr>');"
end if
end if
next
databox = ""
TempHTM = TempHTM & "document.writeln('<\/table>');"
end if
if checkfolder("" & site_root & "/jss/") = false then
createdir(server.mappath("" & site_root & "/jss/"))
end if
if checkfile("" & site_root & "/jss/" & filename & ".js") = true then
call alertbox("文件已存在!請(qǐng)更換文件名!",2)
end if
dim objstream
set objstream = server.createobject("adodb.stream")
with objstream
.open
.charset = "" & chrset & ""
.position = objstream.size
.writetext = TempHTM
.savetofile server.mappath("" & site_root & "/jss/" & filename & ".js"),2
.close
end with
set objstream = nothing
if err.number <> 0 then
err.clear
createnewsjs = false
else
createnewsjs = true
end if
end function
function getnewstitle(id)
dim rs,tempstr
set rs = conn.execute("select title from NCMS_news where id=" & id)
if not rs.eof then
tempstr = server.urlencode(rs("title"))
end if
rs.close:set rs = nothing
getnewstitle = tempstr
end function
function getclasspath(id)
dim rs,tempstr
set rs = conn.execute("select ename from NCMS_class where id=" & id)
if not rs.eof then
tempstr = rs("ename")
end if
rs.close:set rs = nothing
getclasspath = tempstr
end function
function getclassid(id)
dim rs,tempstr
set rs = conn.execute("select classid from NCMS_news where id=" & id)
if not rs.eof then
tempstr = rs("classid")
end if
rs.close:set rs = nothing
getclassid = tempstr
end function
function getclassname(id)
dim rs,tempstr
set rs = conn.execute("select cname from NCMS_class where id= " & id)
if not rs.eof then
tempstr = rs("cname")
end if
rs.close:set rs = nothing
getclassname = tempstr
end function
function allchildclass(id)
dim rs
set rs = conn.execute("select id from NCMS_class where parent=" & id)
while not rs.eof
allchildclass = allchildclass & "," & rs("id")
allchildclass = allchildclass & allchildclass(rs("id"))
rs.movenext
wend
rs.close:set rs = nothing
end function
function getclassall(id,stype)
dim rs,tempstr
select case stype
case "1"
set rs = conn.execute("select ctemp from NCMS_class where id=" & id)
if not rs.eof then
tempstr = rs("ctemp")
end if
rs.close:set rs = nothing
getclassall = tempstr
case "2"
set rs = conn.execute("select ntemp from NCMS_class where id=" & id)
if not rs.eof then
tempstr = rs("ntemp")
end if
rs.close:set rs = nothing
getclassall = tempstr
case "3"
set rs = conn.execute("select fname from NCMS_class where id=" & id)
if not rs.eof then
tempstr = rs("fname")
end if
rs.close:set rs = nothing
getclassall = tempstr
case else
response.write("獲取欄目屬性失敗!")
response.end()
end select
end function
function advshow(advcode)
if advcode = "" then
advshow = ""
exit function
else
dim advarr
advarr = split(advcode,"|||")
if ubound(advarr) = 0 then
advshow = "" & chr(10) & "<table style=""padding:0px;width:250px;height:250px"" cellspacing=""0"" cellpadding=""0"" align=""left"" border=""0"">" & chr(10)
advshow = advshow & "<tr>" & chr(10)
advshow = advshow & "<td>" & advcode & "</td>" & chr(10)
advshow = advshow & "</tr>" & chr(10)
advshow = advshow & "</table>" & chr(10)
else
dim n:randomize
n = int((ubound(advarr) + 1) * rnd)
advshow = "" & chr(10) & "<table style=""padding:0px;width:250px;height:250px"" cellspacing=""0"" cellpadding=""0"" align=""left"" border=""0"">" & chr(10)
advshow = advshow & "<tr>" & chr(10)
advshow = advshow & "<td>" & advarr(n) & "</td>" & chr(10)
advshow = advshow & "</tr>" & chr(10)
advshow = advshow & "</table>" & chr(10)
end if
end if
end function
function click(id)
click = "<script language=""javascript"" type=""text/javascript"" src=""" & site_root & "/tools/click.asp?id=" & id & """></script>"
end function
function fontselect()
fontselect = "" & chr(10) & "<div id=""fontselect"">" & chr(10)
fontselect = fontselect & "<ul>" & chr(10)
fontselect = fontselect & "<li id=""explain"">字體大小</li>" & chr(10)
fontselect = fontselect & "<li><a href=""javascript:doZoom(12)"">小</a></li>" & chr(10)
fontselect = fontselect & "<li><a href=""javascript:doZoom(14)"">中</a></li>" & chr(10)
fontselect = fontselect & "<li><a href=""javascript:doZoom(16)"">大</a></li>" & chr(10)
fontselect = fontselect & "</ul>" & chr(10)
fontselect = fontselect & "</div>" & chr(10)
end function
function toolbar(id)
toolbar = "" & chr(10) & "<div id=""toolbar"">" & chr(10)
toolbar = toolbar & "<ul>" & chr(10)
toolbar = toolbar & "<li id=""explain"">瀏覽工具</li>" & chr(10)
toolbar = toolbar & "<li><a href=""" & site_root & "/tools/comment.asp?newsid=" & id & "&newstitle=" & getnewstitle(id) & "#comment"" target=""_blank"" title=""新聞評(píng)論"">新聞評(píng)論</a><li>" & chr(10)
toolbar = toolbar & "<li><a href=""javascript:window.print()"" title=""打印本文"">打印本文</a><li>" & chr(10)
toolbar = toolbar & "<li><a href=""javascript:window.close()"" title=""關(guān)閉本頁(yè)"">關(guān)閉本頁(yè)</a><li>" & chr(10)
toolbar = toolbar & "<li><a href=""javascript:scroll(0,0)"" title=""返回頁(yè)首"">返回頁(yè)首</a><li>" & chr(10)
toolbar = toolbar & "</ul>" & chr(10)
toolbar = toolbar & "</div>" & chr(10)
end function
function copyurl()
copyurl = "" & chr(10) & "<div id=""copyurl"">" & chr(10)
copyurl = copyurl & "<script language=""javascript"" type=""text/javascript"">document.write('<input name=""url"" type=""text"" value=""' + window.location.href + '"" readonly=""true"" /><input name=""btn"" type=""button"" value=""復(fù)制本頁(yè)地址與好友分享"" onclick=""copyurl();"" />');</script>" & chr(10)
copyurl = copyurl & "</div>" & chr(10)
end function
function search()
search = "" & chr(10) & "<div id=""search"">" & chr(10)
search = search & "<form name=""form"" action=""" & site_root & "/tools/search.asp"" method=""get"">" & chr(10)
search = search & "<input name=""kw"" type=""text"" value="""" />" & chr(10)
search = search & "<select name=""tn"">" & chr(10)
search = search & "<option value=""1"">標(biāo)題</option>" & chr(10)
search = search & "<option value=""2"">作者</option>" & chr(10)
search = search & "<option value=""3"">內(nèi)容</option>" & chr(10)
search = search & "</select>" & chr(10)
search = search & "<input name=""do"" type=""hidden"" value=""ok"" />" & chr(10)
search = search & "<input name=""search"" type=""submit"" value=""搜索"" />" & chr(10)
search = search & "</form>" & chr(10)
search = search & "</div>" & chr(10)
end function
function rannumkey(digits)
dim chararray(10)
chararray(0) = "0"
chararray(1) = "1"
chararray(2) = "2"
chararray(3) = "3"
chararray(4) = "4"
chararray(5) = "5"
chararray(6) = "6"
chararray(7) = "7"
chararray(8) = "8"
chararray(9) = "9"
randomize
do while len(output) < digits
dim num:num = cstr(chararray(int((10-0+1) * rnd + 0)))
dim output:output = output + num
loop
rannumkey = output
end function
function makefntype(datestr,types,classid)
select case types
case "1"
makefntype = year(datestr) & "/" & month(datestr) & "-" & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年/月-日/隨機(jī)數(shù)
case "2"
makefntype = year(datestr) & "/" & month(datestr) & "/" & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年/月/日/隨機(jī)數(shù)
case "3"
makefntype = year(datestr) & "-" & month(datestr) & "-" & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年-月-日/隨機(jī)數(shù)
case "4"
makefntype = year(datestr) & "-" & month(datestr) & "/" & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年-月/日/隨機(jī)數(shù)
case "5"
makefntype = year(datestr) & "/" & month(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年/月/隨機(jī)數(shù)
case "6"
makefntype = year(datestr) & "-" & month(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年-月/隨機(jī)數(shù)
case "7"
makefntype = year(datestr) & month(datestr) & day(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年月日/隨機(jī)數(shù)
case "8"
makefntype = year(datestr) & "/" & getclassall(classid,3) & rannumkey(8) '年/隨機(jī)數(shù)
case "9"
makefntype = year(datestr) & month(datestr) & day(datestr) & rannumkey(3) '年月日隨機(jī)數(shù)
case "10"
makefntype = getclassall(classid,3) & rannumkey(16) '16位隨機(jī)數(shù)
case "11"
makefntype = getclassall(classid,3) & md5(datestr & rannumkey(3),16) '16位md5加密字符
case "12"
makefntype = getclassall(classid,3) & year(datestr) & month(datestr) & day(datestr) & hour(datestr) & minute(datestr) & second(datestr) & rannumkey(3) '年月日時(shí)分秒隨機(jī)數(shù)
case else
makefntype = getclassall(classid,3) & year(datestr) & month(datestr) & day(datestr) & hour(datestr) & minute(datestr) & second(datestr) & rannumkey(3) '年月日時(shí)分秒隨機(jī)數(shù)
end select
end function
function dateformat(datestr,types)
dim datestring
if isdate(datestr) = false then
datestring = ""
end if
select case types
case "1"
datestring = year(datestr) & "-" & month(datestr) & "-" & day(datestr)
case "2"
datestring = year(datestr) & "." & month(datestr) & "." & day(datestr)
case "3"
datestring = month(datestr) & "-" & day(datestr) & "-" & year(datestr)
case "4"
datestring = month(datestr) & "." & day(datestr) & "." & year(datestr)
case "5"
datestring = year(datestr) & month(datestr) & day(datestr)
case "6"
datestring = hour(datestr) & minute(datestr) & second(datestr)
case "7"
datestring = year(datestr) & "年" & month(datestr) & "月" & day(datestr) & "日"
case else
datestring = datestr
end select
dateformat = datestring
end function
function formattagdate(mdate,temp)
if not isdate(mdate) or temp = "" then
formattagdate = temp
exit function
end if
dim myear:myear = year(mdate)
dim mmonth:mmonth = month(mdate)
dim mday:mday = day(mdate)
dim mhour:mhour = hour(mdate)
dim mmin:mmin = minute(mdate)
dim msec:msec = second(mdate)
temp = replace(temp,"{Y}",year(mdate))
temp = replace(temp,"{y}",right(year(mdate),2))
temp = replace(temp,"{M}",month(mdate))
temp = replace(temp,"{m}",right("00" & month(mdate),2))
temp = replace(temp,"{D}",day(mdate))
temp = replace(temp,"vvxyksv9kd",right("00" & day(mdate),2))
formattagdate = temp
end function
function strlength(str)
on error resume next
dim winnt_chinese
winnt_chinese = (len("中國(guó)") = 2)
if winnt_chinese then
dim l, t, c
dim i
l = len(str)
t = l
for i = 1 to l
c = asc(mid(str,i,1))
if c < 0 then c = c + 65536
if c > 255 then
t = t + 1
end if
next
strlength = t
else
strlength = len(str)
end if
if err.number <> 0 then err.clear
end function
function gottopic(byval str,byval strlen)
if str = "" or str = null then
gottopic = ""
exit function
end if
dim l,t,c,i,tstr
str = replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
l = len(str)
t = 0
tstr = str
strlen = clng(strlen)
for i = 1 to l
c = abs(asc(mid(str,i,1)))
if c > 255 then
t = t + 2
else
t = t + 1
end if
if t >= strlen then
tstr = left(str,i)
exit for
end if
next
if tstr <> str then
tstr = tstr & "..."
end if
gottopic = replace(replace(replace(replace(tstr," "," "),chr(34),"""),">",">"),"<","<")
end function
function insertchr(num)
dim str1:str1 = "├"
dim str2:str2 = ""
dim iii
for iii = 2 to num
str2 = str2 & "│ "
next
insertchr = str2&str1
end function
class classlist
private class_id
private class_table
private class_parentid
private class_name
public property let id(str)
class_id = str
end property
public property let table(str)
class_table = str
end property
public property let parentid(str)
class_parentid = str
end property
public property let name(str)
class_name = str
end property
dim list()
dim i,n
private sub class_initialize()
i = 0:n = 0
end sub
public function classarry(thisid,id)
dim rsclass,classsql
if id > 0 then
classsql = "select * from " & class_table & " where " & class_parentid & "=" & thisid
else
classsql = "select * from " & class_table & " where " & class_id & "=" & thisid
end if
set rsclass = conn.execute(classsql)
n = n + 1
do while not rsclass.eof
list(0,i) = rsclass(class_id)
list(1,i) = rsclass(class_name)
list(2,i) = n
i = i + 1
thisid = classarry(rsclass(class_id),1)
rsclass.movenext
loop
n = n - 1
rsclass.close
end function
public function arrylist()
dim rsclass
set rsclass = conn.execute("select count(" & class_id & ") from " & class_table)
dim lenght
lenght = rsclass(0)
rsclass.close
redim list(2,lenght)
dim rspclass
set rspclass = conn.execute("select " & class_id & " from " & class_table & " where " & class_parentid & "=0")
do while not rspclass.eof
call classarry(rspclass(class_id),0)
rspclass.movenext
loop
rspclass.close
arrylist = list
end function
end class
class imginfo
dim aso
private sub class_initialize
set aso = createobject("adodb.stream")
aso.mode = 3
aso.type = 1
aso.open
end sub
private sub class_terminate
err.clear
set aso = nothing
end sub
private function bin2str(bin)
dim i,str,clow
for i = 1 to lenb(bin)
clow = midb(bin,i,1)
if ascb(clow) < 128 then
str = str & chr(ascb(clow))
else
i = i + 1
if i <= lenb(bin) then
str = str & chr(ascw(midb(bin,i,1)&clow))
end if
end if
next
bin2str = str
end function
private function num2str(num,base,lens)
dim ret
ret = ""
while(num>=base)
ret = (num mod base) & ret
num = (num - num mod base)/base
wend
num2str = right(string(lens,"0") & num & ret,lens)
end function
private function str2num(str,base)
dim ret
ret = 0
for i = 1 to len(str)
ret = ret *base + cint(mid(str,i,1))
next
str2num = ret
end function
private function binval(bin)
dim ret
ret = 0
dim i
for i = lenb(bin) to 1 step -1
ret = ret*256 + ascb(midb(bin,i,1))
next
binval = ret
end function
private function binval2(bin)
dim ret
ret = 0
Dim i
for i = 1 to lenb(bin)
ret = ret*256 + ascb(midb(bin,i,1))
next
binval2 = ret
end function
private function getimagesize(filespec)
dim ret(3)
aso.loadfromfile(filespec)
dim bflag
bflag = aso.read(3)
select case hex(binval(bflag))
case "4E5089":
aso.read(15)
ret(0) = "PNG"
ret(1) = binval2(aso.read(2))
aso.read(2)
ret(2) = binval2(aso.read(2))
case "464947":
aso.read(3)
ret(0) = "GIF"
ret(1) = binval(aso.read(2))
ret(2) = binval(aso.read(2))
case "535746":
aso.read(5)
bindata = aso.read(1)
sconv = num2str(ascb(bindata),2,8)
nbits = str2num(left(sconv,5),2)
sconv = mid(sconv,6)
while(len(sconv)<nbits*4)
bindata = aso.read(1)
sconv = sconv & num2str(ascb(bindata),2,8)
wend
ret(0) = "SWF"
ret(1) = int(abs(str2num(mid(sconv,1*nbits+1,nbits),2)-str2num(mid(sconv,0*nbits+1,nbits),2))/20)
ret(2) = int(abs(str2num(mid(sconv,3*nbits+1,nbits),2)-str2num(mid(sconv,2*nbits+1,nbits),2))/20)
case "FFD8FF":
do
dim p1
do:p1 = binval(aso.read(1)):loop while p1 = 255 and not aso.eos
if p1 > 191 and p1 < 196 then exit do else aso.read(binval2(aso.read(2))-2)
do:p1 = binval(aso.read(1)):loop while p1 < 255 and not aso.eos
loop while true
aso.read(3)
ret(0) = "JPG"
ret(2) = binval2(aso.read(2))
ret(1) = binval2(aso.read(2))
case else:
if left(bin2str(bflag),2) = "BM" then
aso.read(15)
ret(0) = "BMP"
ret(1) = binval(aso.read(4))
ret(2) = binval(aso.read(4))
else
ret(0) = ""
end if
end select
ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
getimagesize = ret
end function
public function imgW(pic_path)
dim imgfso
set imgfso = server.createobject("scripting.filesystemobject")
if (imgfso.fileexists(pic_path)) then
dim imgfs,ext
set imgfs = imgfso.getfile(pic_path)
ext = imgfso.getextensionname(pic_path)
select case ext
case "gif","bmp","jpg","png":
dim arr
arr = getimagesize(imgfs.path)
imgW = arr(1)
end select
set imgfs = nothing
else
imgW = 0
end if
set imgfso = nothing
end function
public function imgH(pic_path)
dim imgfso
set imgfso = server.createobject("scripting.filesystemobject")
if (imgfso.fileexists(pic_path)) then
dim imgfs,ext
set imgfs = imgfso.getfile(pic_path)
ext = imgfso.getextensionname(pic_path)
select case ext
case "gif","bmp","jpg","png":
dim arr
arr = getimagesize(imgfs.path)
imgH = arr(2)
end select
set imgfs = nothing
else
imgH = 0
end if
set imgfso = nothing
end function
end class
相關(guān)文章
剛看到吳磊同學(xué)的一些關(guān)于購(gòu)物車的想法，正巧本人丁學(xué)對(duì)電子商務(wù)這方面比較熟悉，跳出來(lái)獻(xiàn)丑了，希望對(duì)一些同行有些用處。本來(lái)想回復(fù)到下面的，結(jié)果發(fā)現(xiàn)寫(xiě)起來(lái)比較多，干脆寫(xiě)到這里好了，以后自己找起來(lái)也方便，呵呵2008-11-11
ASP所有的Session變量獲取實(shí)現(xiàn)代碼
在程序調(diào)試中，有時(shí)候需要知道有多少Session變量在使用，她們的值如何？由于Session對(duì)象提供一個(gè)稱為Contents的集合(Collection)，我們可以通過(guò)For...Each循環(huán)來(lái)達(dá)到目標(biāo)2009-07-07
Microsoft VBScript 編譯器錯(cuò)誤 錯(cuò)誤原因 代碼大全
這篇文章主要介紹了Microsoft VBScript 編譯器錯(cuò)誤 錯(cuò)誤原因 代碼大全,需要的朋友可以參考下2015-07-07
asp下利用fso實(shí)現(xiàn)文件夾或文件移動(dòng)改名等操作函數(shù)
以后利用fso來(lái)操作文件和文件夾就方便了2008-01-01
再發(fā)幾個(gè)ASP不錯(cuò)的函數(shù)
再發(fā)幾個(gè)ASP不錯(cuò)的函數(shù)...2007-08-08
去除HTML代碼中所有標(biāo)簽的兩種方法...2007-08-08![關(guān)于ASP循環(huán)表格的問(wèn)題之解答[比較詳細(xì)]](http://img.jbzj.com/images/xgimg/bcimg6.png)
關(guān)于ASP循環(huán)表格的問(wèn)題之解答[比較詳細(xì)]
在很多時(shí)候,我們采用原始的方法來(lái)解決一行內(nèi)循環(huán)3張圖片,如果上傳者只上傳了2張圖片,那么2張圖片間的距離會(huì)很大,因?yàn)槿鄙倭艘粋€(gè)<td> </td>.2008-11-11
ASP提示錯(cuò)誤 ''8002801d''的解決辦法
這篇文章主要介紹了ASP提示錯(cuò)誤 '8002801d'的解決辦法,本文使用重新注冊(cè)的方法解決了這個(gè)問(wèn)題,需要的朋友可以參考下2014-09-09
asp提示Server 對(duì)象 錯(cuò)誤 ASP 0178 : 80070005
今天幫客戶配置好服務(wù)器以后測(cè)試程序發(fā)現(xiàn)asp程序提示Server 對(duì)象 錯(cuò)誤 ASP 0178 : 80070005，經(jīng)測(cè)試是因?yàn)闄?quán)限問(wèn)題。2011-11-11
這篇文章主要介紹了asp限制域名訪問(wèn)實(shí)現(xiàn)代碼,需要的朋友可以參考下2020-09-09