<%
'PaintBlue 1.X 首页调用程序
'Asp Created by V37 PaintBlue.Net
DIM bbsPath
bbsPath="/bbs"
DIM MaxID
DIM imgCount:imgCount=0
DIM imgWidth,imgHeight
DIM imgArr,ubsize
dim imgBorder_light
dim imgBorder_dark
dim imgOutBorder_light
dim imgOutBorder_dark
dim imgBorder,imgOutBorder
dim colorSet68,colorSet85,colorSet84,colorSet83,colorSet82
dim logwidth,logheight
DIM logWM,logHM '最大缩图
DIM indexSize,indexColSize,indexRowSize
dim Cellpadding,Cellspacing
DIM SQL,rs,ados,i,j '数据库string,记录对象,Stream对象,通用循环变量
set rs=Server.CreateObject("ADODB.RecordSet")
'==================调用样式需要修改的参数==========\\\
indexColSize=6 '首页显示的作品列数 不能小于1
indexRowSize=1 '首页显示的作品数行数 不能小于1
logWM=80 '缩图最大尺寸
logHM=80 '缩图最大尺寸
imgBorder_light="#404040" '缩图亮边线
imgBorder_dark="#FFFFFF" '缩图暗边线
imgOutBorder_light="#FFFFFF" '缩图外框亮边线
imgOutBorder_dark="#808080" '缩图外框暗边线
colorSet82="#D4D0C8" '缩图背景色
colorSet83="#cccccc" '背景色
colorSet84="#3399EE" '背景表格线色
colorSet85="#003399" '连接文字颜色
Cellspacing=0 '背景表格线宽
Cellpadding=6 '缩图外边缘退距
'===============================================///
indexSize=indexColSize*indexRowSize '首页显示的最多top作品数
rs.open "Select Max(imageID) from [imgTopic] where paintType_int<>0 and paintType_int<>7 and isShow=1 and AutoDel=0 and access=0 and ShowInx=1",CONN,0,1
MaxID=rs(0)
rs.close
imgBorder="style=\"""&_
"border-top: 1px solid "&imgBorder_light&";"&_
"border-right: 1px solid "&imgBorder_dark&";"&_
"border-bottom: 1px solid "&imgBorder_dark&";"&_
"border-left: 1px solid "&imgBorder_light&";\"""
imgOutBorder="style=\"""&_
"border-top: 1px solid "&imgOutBorder_light&";"&_
"border-right: 1px solid "&imgOutBorder_dark&";"&_
"border-bottom: 1px solid "&imgOutBorder_dark&";"&_
"border-left: 1px solid "&imgOutBorder_light&";\"""
if Not isnull(MaxID) then
%>
var TOPimg="<%=TOPimg()%>";
window.document.write (TOPimg);
<%
end if
function TOPimg()
dim rseof:rseof=true
SQL="select top "&indexSize&" imageID,BoardID,img_Width,img_Height,piclog,Topic,UserName,Expression from [imgTopic] where paintType_int<>0 and paintType_int<>7 and isShow=1 and AutoDel=0 and access=0 and ShowInx=1 order by imageID Desc"
rs.open SQL,CONN,0,1
TOPimg=""
iF Not rs.eof then
rseof=false
imgArr=rs.GetRows '第一维是列第二维是行
ubsize=ubound(imgArr,2)
'if action="next" then
dim tests
'for i=0 to ubsize
' Response.write "&"\"") | "
' Response.write ""&HTMLencode(imgArr(5,i))
' Response.write " | "
'next
for i=0 to ubsize
imgWidth=imgArr(2,i)
imgHeight=imgArr(3,i)
logwidth=picWH(imgWidth,imgHeight,1)
'获取缩图尺寸,可考虑前端写入数据库去
if imgWidth=imgHeight then
logheight=logwidth
else logheight=picWH(imgWidth,imgHeight,0) '获取缩图尺寸
end if
if imgCount mod indexColSize=0 then TOPimg=TOPimg& ""
TOPimg=TOPimg& (" | ")
imgCount=imgCount+1
tests=0
if imgCount mod indexColSize = 0 then
TOPimg=TOPimg& " "
tests=1
end if
next
eND if
rs.close
'补足不足整数的HTML tag
if imgCount")
next
TOPimg=TOPimg& ("")
end if
TOPimg=TOPimg& (" ")
if Not rseof then Erase imgArr
End function
function picWH(imgW,imgH,WH)
DIM logW,logH
if imgW=imgH then
logW=logWM
logH=int(logWM*(imgH/imgW))
else
if imgW/imgH>logWM/logHM then
logW=logWM
logH=int(logHM*(imgW/imgH))
else
logH=logHM
logW=int(logHM*(imgW/imgH))
end if
end if
else
if imgW>imgH then
if imgW/imgH>logWM/logHM then
logW=logWM
logH=int(logHM*(imgH/imgW))
else
logH=logHM
logW=int(logHM*(imgW/imgH))
end if
else
logH=logHM
logW=int(logHM*(imgW/imgH))
end if
end if
end if
Select CASE WH
CASE 0 picWH=logW
CASE 1 picWH=logH
End Select
end function
function HTMLEncode(reString)
dim Str:Str=reString
if not isnull(Str) then
rem Str = Replace(Str, CHR(38), "&") '&
rem Str = Replace(Str, CHR(40), "(") '(
rem Str = Replace(Str, CHR(41), ")") ')
Str = replace(Str, ">", ">")
Str = replace(Str, "<", "<")
Str = Replace(Str, CHR(32), " ")
Str = Replace(Str, CHR(9), " ")
Str = Replace(Str, CHR(34), """) ' "
Str = Replace(Str, CHR(39), "'") ' '
Str = Replace(Str, CHR(13), "")
Str = Replace(Str, CHR(10) & CHR(10), " ")
Str = Replace(Str, CHR(10), " ")
HTMLEncode = Str
else
HTMLEncode=""
end if
end function
function URLencode(codetype,reString)
dim Str:Str=reString
select CASE codetype
case 0
if isnull(Str) then
URLencode=""
else
URLencode=Server.URLencode(reString)
end if
case 1
Str = replace(Str, ">", "%3E")
Str = replace(Str, "<", "%3C")
Str = replace(Str, "+", "%2B")
Str = Replace(Str, CHR(32), "%20")
Str = Replace(Str, CHR(9), "%09")
Str = Replace(Str, CHR(34), "%22")
Str = Replace(Str, CHR(38), "%26") '&
Str = Replace(Str, CHR(39), "%27")
Str = Replace(Str, CHR(13), "%0D")
Str = Replace(Str, CHR(10), "%0A")
Str = Replace(Str, CHR(61), "%3D") '=
rem Str = Replace(Str, "(", "%28")
rem Str = Replace(Str, ")", "%29")
URLencode = Str
case else
URLencode=reString
end select
end function
function deTitleUBB(content)
dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=true
re.Pattern="(\[t\])(.+?)(\[\/t\])"
're.Pattern="(\[t\])(.[^\[]*)(\[\/t\])"
content=re.Replace(content,"$2")
re.Pattern="(\[#)(\S+?)(\])(.+?)(\[\/#\])"
're.Pattern="(\[#)(.[^\[]*)(\])(.[^\[]*)(\[\/#\])"
content=re.Replace(content,"$4")
deTitleUBB=content
End Function
Function Juncode(byVal iStr)
if SQLserver then Juncode=iStr : exit function end if
if isNull(iStr) or isEmpty(iStr) then
Juncode=""
Exit function
end if
dim F,i,E
E=array("Jn0;","Jn1;","Jn2;","Jn3;","Jn4;","Jn5;","Jn6;","Jn7;","Jn8;","Jn9;","Jn10;","Jn11;","Jn12;","Jn13;","Jn14;","Jn15;","Jn16;","Jn17;","Jn18;","Jn19;","Jn20;","Jn21;","Jn22;","Jn23;","Jn24;","Jn25;")
F=array(chr(-23116),chr(-23124),chr(-23122),chr(-23120),_
chr(-23118),chr(-23114),chr(-23112),chr(-23110),_
chr(-23099),chr(-23097),chr(-23095),chr(-23075),_
chr(-23079),chr(-23081),chr(-23085),chr(-23087),_
chr(-23052),chr(-23076),chr(-23078),chr(-23082),_
chr(-23084),chr(-23088),chr(-23102),chr(-23104),_
chr(-23106),chr(-23108))
Juncode=iStr
for i=0 to 25
Juncode=replace(Juncode,E(i),F(i))'□
next
End Function
%> |