<%
'-站点相关信息-
Const CopyRight="乐清市伸亚电子有限公司"
Const CopyRightS="乐清市伸亚电子有限公司"
Const CopyRightUrl="http://www.sydz.org"
Const Copy="乐清市伸亚电子有限公司"
Const CopyUrl="http://www.sydz.org"
dim Conn,strConn
strConn="driver={Microsoft Access Driver (*.mdb)};dbq="&Server.MapPath("/data/smiledata/smilestudioadmin.mdb")
'开连接
sub ConnOpen()
'On Error resume next
set Conn=server.CreateObject("adodb.connection")
Conn.Open strConn
if err.number<>0 then
err.clear
set conn=nothing
response.write "系统维护中，请稍后再试..."
Response.End
else
if err then
err.clear
set conn=nothing
response.write "系统维护中，请稍后再试..."
Response.End
end if
end if
end sub
'--关连接--
sub ConnClose()
Conn.Close()
set Conn=nothing
end sub
'--栏目导航--
function ClassNamelist(BcgID,BcgNameList)
set cnlRs=server.CreateObject("Adodb.recordset")
sql="select * from bigcategory_InfoCenter where Bcg_ID="&BcgID
cnlRs.Open sql,Conn,1,1
if not cnlRs.EOF then
BcgNameList=cnlRs("Bcg_Name") + ">>" + BcgNameList
if cnlRs("That_BcgID")<>0 then
ClassNamelist cnlRs("That_BcgID"),BcgNameList
else
ClassNamelist = ""&left(BcgNameList,len(BcgNameList)-2)&""
exit function
end if
ClassNamelistArray = split(BcgNameList,">>")
for i=0 to UBound(ClassNamelistArray)-1
if i=0 then
ClassNamelist = ClassNamelist +""+ ClassNamelistArray(i) + ""
else
ClassNamelist = ClassNamelist +">>"+ ClassNamelistArray(i)
end if
next
end if
end function
function InstrChar(fv)
'非法的字符
lawlesschar="`a~a#a$a@a%a^a&a*a(a)a_a-a+a=a{a}a[a]a\a|a:a;a'a,a.a>a
<%
'-----------取得文件扩展名-----------------
Function GetextEndName(FileName)
dim ExtName
Extname= LCase(FileName)
Extname= right(ExtName,3)
Extname= right(ExtName,3-Instr(ExtName,"."))
GetextEndname= ExtName
End Function
'-------将当前的日期和时间转为文件名------------
Function MakeFileName()
fname= now()
fname= replace(fname,"-","")
fname= replace(fname," ","")
fname= replace(fname,":","")
fname= replace(fname,"PM","")
fname= replace(fname,"AM","")
fname= replace(fname,"上午","")
fname= replace(fname,"下午","")
MakeFilename=fname
End Function
'--------输出内容字数限制-------------
Function got(txt,txtlen)
dim l,t,c, i
l=len(txt)
t=0
for i=1 to l
c=Abs(Asc(Mid(txt,i,1)))
if c>255 then
t=t+2
else
t=t+1
End if
if t>txtlen then
got=left(txt,i-1)&"*"
exit for
else
got=txt&Space(txtlen-t)
End if
next
End Function
'---将文字转化为它的源代码格式---
Function htmlout(str)
dim guest
if isnull(str) or str="" then
htmlout=str
exit Function
End if
guest=str
guest=Replace(guest," "," ")
guest=Replace(guest," ","nbsp;")
guest=server.htmlencode(guest)
guest=Replace(guest,"nbsp;"," ")
guest=Replace(guest,vbcrlf)
htmlout=guest
End Function
'---提示信息并回到前一页面(跳二)-------
Function AlertOut(Msg)
Response.Write ""
Response.End
End Function
'---提示信息并回到前一页面(跳一)---
Function Back(str)
Response.Write ""
Response.End
End Function
'----检测是否是数据类型---
Function CheckInt(str,Msg)
if str<>"" then
if isnumeric(str)=false then
Response.Write""
Response.End
End if
end if
End Function
'----检查email地址的合法性---
Function CheckEmail(str,Msg)
if instr(str,"@")<=0 or instr(str,".")<=0 then
Response.Write""
Response.End
End if
End Function
'---检测web地址的合法性---
Function CheckHttp(str,Msg)
if instr(str,"http://")<=0 or instr(str,".")<=0 then
Response.Write""
Response.End
End if
End Function
'---检测内容是否为空---
Function CheckNull(str,Msg)
if trim(str)="" then
Response.Write""
Response.End
End if
End Function
'---检测月份和日期---
Function CheckTime(str,Msg)
if isdate(str)=false then
Response.Write""
Response.End
End if
End Function
'---禁止非法字符的输入chr(34)代表引号---
Function CheckChar(str,Msg)
if str<>"" then
for i=1 to len(str)
us=mid(str,i,1)
if us="~" or us="`" or us="/" or us="?" or us=">" or us="<" or us=";" or us=":" or us="}" or us="{" or us=")" or us="(" or us="*" or us="&" or us="'" or us="%" or us="$" or us="#" or us="@" or us="!" or us=chr(34) then
Response.Write""
Response.End
End if
next
end if
End Function
'---提示信息并关闭本窗口---
Function Closes(Msg)
Response.Write""
Response.End
End Function
'---提示信息并关闭本窗口刷新父窗口---
Function CloseReload(Msg)
Response.Write""
Response.End
End Function
'---提示信息或直接转到某一页面---
Function Href(url,Msg)
if Msg<>"" then
Response.Write""
else
Response.Write""
End if
End Function
'---转到相应的页面并刷新---
Function UrlMsg(Url,Msg)
if Msg<>"" then
Response.Write ""
else
Response.Write ""
End if
End Function
'---分页程序(上部分)---
'---传递每页条数：num/ipagesize，第几页：page
'---maxpage:页数,countnum:记录数
Dim page,maxpage,ipagesize,countnum
Sub fpage(num)
rs.pagesize= cint(num)
ipagesize= cint(num)
countnum = rs.recordcount
maxpage = rs.pagecount
page = request("page")
if Not IsNumeric(page) or page="" then page=1 else page=cint(trim(request("page"))) End if
if page<1 then
page=1
elseif page>maxpage then
page=maxpage
End if
rs.absolutepage=page
End Sub
'---分页程序(显示部分)---
'---适用于前台页面有相关页码显示---
'---pagecount:多少页,page:第几页,pagenum:中间显示几页
Sub nextpage(pagecount,page,pagenum)
if pagecount>1 then
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_StrING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbtextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
Response.Write("
" & vbCrLf)
End if
if page>pagenum then
noj=page-pagenum
zon_page=page+pagenum
else
noj=1
zon_page=pagenum*2+1
End if
if zon_page>=maxpage then zon_page=maxpage
for i=noj to zon_page
if i=page then
Response.Write ("
")
end if
End Sub
'---分页程序(显示部分带图片)---
'---适用于前台页面有相关页码显示---
'---pagecount:多少页,page:第几页,pagenum:中间显示几页
Sub NextPagePic(maxpage,page,pagenum)
if maxpage>1 then
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_StrING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbtextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
if pagenum=2 then
Response.Write("
")
if page" & vbCrLf)
else
Response.Write ("
" & vbCrLf)
End if
if page>1 then
Response.Write("
" & vbCrLf)
else
Response.Write ("
" & vbCrLf)
End if
Response.Write("
")
elseif pagenum=1 then
Response.Write("
")
if page" & vbCrLf)
else
Response.Write ("
" & vbCrLf)
End if
response.Write("
")
if page>1 then
Response.Write("
" & vbCrLf)
else
Response.Write ("
" & vbCrLf)
End if
Response.Write("
")
end if
end if
End Sub
Sub NextPagePicEn(maxpage,page,pagenum,prop)
if maxpage>1 then
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
Response.Write("
" & vbCrLf)
End if
if page>pagenum then
noj=page-pagenum
zon_page=page+pagenum
else
noj=1
zon_page=pagenum*2+1
End if
if zon_page>=maxpage then zon_page=maxpage
for i=noj to zon_page
if i=page then
Response.Write ("
")
end if
End Sub
Sub ShowPageen(pagecount,page,prop)
if pagecount>1 then
Dim query, a, x
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
Response.Write("" & vbCrLf )
end if
End Sub
Sub ShowPage(pagecount,page,prop)
if pagecount>1 then
Dim query, a, x
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
Response.Write("" & vbCrLf )
end if
End Sub
'------前台用于传参数并可直接转到某一页----
Sub ShowLastNext(pagecount,page,prop)
if pagecount>1 then
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
Response.Write(""
end if
End Sub
%>
<%
'--------------------------显示栏目名称-------------------
Function ShowBcgName(BcgID,language)
if BcgID<>"" then
set rsBcg=server.CreateObject("adodb.recordset")
sqlBcg="select * from Bigcategory_InfoCenter where Bcg_ID="&BcgID
rsBcg.open sqlBcg,conn,1,1
if not rsBcg.eof then
if language="en" then
ShowBcgName=rsBcg("Bcg_Name_en")
else
ShowBcgName=rsBcg("Bcg_Name")
end if
end if
rsBcg.close
set rsBcg=nothing
end if
End function
Function ShowName(BcgID)
set rsBcg0=server.CreateObject("adodb.recordset")
sqlBcg0="select * from Bigcategory_InfoCenter where Bcg_ID="&BcgID&""
rsBcg0.open sqlBcg0,conn,1,1
if not rsBcg0.eof then
ShowName=rsBcg0("Bcg_Name")
end if
rsBcg0.close
set rsBcg0=nothing
End function
'显示栏目导航
Function ShowBcgNav(BcgID,Msg)
set rsNext=server.createobject("adodb.recordset")
sqlNext="select * from Bigcategory_InfoCenter where Bcg_ID in(select distinct That_BcgID from Bigcategory_InfoCenter where Bcg_Isyouxiao=1 and Bcg_ID="&BcgID&") and Bcg_Isyouxiao=1"
rsNext.Open sqlNext,conn,1,1
if rsNext.eof then
ShowBcgNav=ShowBcgName(BcgID)
else
ShowBcgNav=rsNext("Bcg_Name")&Msg&""&ShowBcgName(BcgID)&""
end if
rsNext.close
set rsNext=nothing
End function
'显示下级栏目ID
public function ShowNextBcgList(BcgID)
set rsNext=server.createobject("adodb.recordset")
sqlNext="select * from Bigcategory_InfoCenter where That_BcgID ="&BcgID&" and Bcg_Isyouxiao=1"
rsNext.Open sqlNext,conn,1,1
if rsNext.eof then
if ShowNextBcgList="" then
ShowNextBcgList=BcgID
else
ShowNextBcgList=ShowNextBcgList&","&BcgID
end if
else
while not rsNext.eof
if ShowNextBcgList="" then
ShowNextBcgList=ShowNextBcgList(rsNext("Bcg_ID"))
else
ShowNextBcgList=ShowNextBcgList&","&ShowNextBcgList(rsNext("Bcg_ID"))
end if
rsNext.movenext
wend
end if
rsNext.close
set rsNext=nothing
end function
'-------------------------显示内容-------------------
sub ShowContent(BcgID,ICIID)
set rsContent=server.createobject("adodb.recordset")
sqlContent="select top 1 * from Info_InfoCenter where ICI_Isfabu=1"
if BcgID<>"" then sqlContent=sqlContent&" and Bcg_ID="&BcgID
if ICIID<>"" then sqlContent=sqlContent&" and ICI_ID="&ICIID
sqlContent=sqlContent&" order by ICI_NumberID desc,ICI_Edittime desc"
rsContent.open sqlContent,conn,1,1
if rsContent.eof then
response.write "没有内容！"
else
response.write rsContent("ICI_Content")
end if
rsContent.close
set rsContent=nothing
end sub
'-----------显示首页图片新闻-----------------------
sub Showpic(BcgID,leftnum,wnum,hnum)
set NewRs = server.createobject("adodb.recordset")
if BcgID<>"" then
sqlNew = "SELECT top 1 * FROM Info_InfoCenter where Bcg_ID ="&BcgID&" and ICI_Isfabu=1 and ICI_Ishome=1 and ICI_Image<>'' and (ICI_Image like '%jpg' or ICI_Image like '%gif' or ICI_Image like '%jpeg') ORDER BY ICI_NumberID desc,ICI_addtime DESC"
NewRs.open sqlNew, Conn, 1, 1
if err.number <> 0 then
response.write "数据库出错"
else
if NewRs.bof and NewRs.eof then
if language="english" then
response.Write(" no information!")
else
response.write " 没有信息！"
end if
else
NewRs.movefirst
response.Write("
"
end if
end if
NewRs.close
end if
set NewRs = nothing
end sub
'-----------首页新闻列表-----------------------
sub Shownews(BcgID,num,leftnum)
dim rs,Sql
set rs = server.createobject("adodb.recordset")
if BcgID<>"" then
sql = "SELECT top "&num&" * FROM Info_infoCenter where ICI_Isfabu=1 and Bcg_ID in("&BcgID&") ORDER BY ICI_NumberID desc,ICI_edittime DESC"
rs.open sql, Conn, 1,1
if err.number <> 0 then
response.write "出错！"
else
if rs.bof and rs.eof then
response.write "
first 
previous 
next 
last 
