设为首页收藏本站

新微赢技术网

 找回密码
 注册
搜索
热搜: 回贴
查看: 68|回复: 1
打印 上一主题 下一主题

请教:Microsoft VBScript 编译器错误- Error '800a0401'

[复制链接]
跳转到指定楼层
1#
发表于 2010-1-11 00:01:59 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
小的新手!!1在调试一程序的时候!!出现

Microsoft VBScript 编译器错误- Error '800a0401'

语句未结束

/inc/Function.asp, line 79

strtemp = strtemp & "<a href="""&webml&readproclass(fs_rs("cid"))&"/"&fs_rs("productus")&"/"" target=""_blank""><img src="""&strproimg&""" onload=""imgadapter(this,"&str4&","&str5&")"" alt=""产品名称:&fs_rs("productcn")&vbcrlf&"产品型号:&fs_rs("proxinghao")&vbcrlf&"产品规格:&fs_rs("proguige")&""" /></a><br />"&vbcrlf
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------^


Function.asp文件:

<%
'-------------------------------
'GB2312 TO UTF-8
'-------------------------------
Function toUTF8(szInput)
Dim wch, uch, szRet
Dim x
Dim nAsc, nAsc2, nAsc3
If szInput = "" Then
toUTF8 = szInput
Exit Function
End If
For x = 1 To Len(szInput)
wch = Mid(szInput, x, 1)
nAsc = AscW(wch)
If nAsc < 0 Then nAsc = nAsc + 65536

If (nAsc And &HFF80) = 0 Then
szRet = szRet & wch
Else
If (nAsc And &HF000) = 0 Then
uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
Else
uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
End If
End If
Next
toUTF8 = szRet
End Function

'-----------------------
'UTF-8 to GB2312
'-----------------------
function UTF2GB(UTFStr)
for Dig=1 to len(UTFStr)
if mid(UTFStr,Dig,1)="%" then
if len(UTFStr) >= Dig+8 then
GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9))
Dig=Dig+8
else
GBStr=GBStr & mid(UTFStr,Dig,1)
end if
else
GBStr=GBStr & mid(UTFStr,Dig,1)
end if
next
UTF2GB=GBStr
end function

'-----------------------
'最新商品 newpro
'str1 - 调用行数 str2 - 每行调用数 str3 - 产品名称字符数
'str4 - 图片宽度 str5 - 图片高度
'-----------------------
function newpro(str1,str2,str3,str4,str5)
dim strwidth1,strwidth2
strwidth1 = 100
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select top "&str1*str2&" * from Hu_product order by id desc",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">没有产品</span><br />"
else
i = 0
strtemp = strtemp & "<ul class=""newpro-ul"">"&vbcrlf
do while not fs_rs.eof
i = i+1
if i mod str2*1 <> 0 then '判断是不是每行的最行一条数据,是的话宽度减1%.
strwidth2 = strwidth1/str2
else
strwidth2 = (strwidth1/str2)-1
end if '结束判断
if left(trim(fs_rs("proimages")),5) = "http:" then
strproimg = trim(fs_rs("proimages"))
elseif trim(fs_rs("proimages")) <> "" then
strproimg = webml&trim(fs_rs("proimages"))
else
strproimg = webml&"upfiles/system/nophoto.gif"
end if
strtemp = strtemp & "<li style=""width: "&strwidth2&"%; height:"&str5+30&"px;"">"&vbcrlf
strtemp = strtemp & "<a href="""&webml&readproclass(fs_rs("cid"))&"/"&fs_rs("productus")&"/"" target=""_blank""><img src="""&strproimg&""" onload=""imgadapter(this,"&str4&","&str5&")"" alt=""产品名称:"&fs_rs("productcn")&vbcrlf&"产品型号:"&fs_rs("proxinghao")&vbcrlf&"产品规格:"&fs_rs("proguige")&""" /></a><br />"&vbcrlf
strtemp = strtemp & "<span style=""line-height: 30px;""><a href="""&webml&readproclass(fs_rs("cid"))&"/"&fs_rs("productus")&"/"" target=""_blank"" title="""&fs_rs("productcn")&""">"&left(fs_rs("productcn"),str3)&"</a></span></li>"&vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"&vbcrlf
end if
fs_rs.close
set fs_rs=nothing
newpro = strtemp
end function

'-----------------------
'推荐商品 Recommendpro
'str1 - 调用行数 str2 - 每行调用数 str3 - 产品名称字符数
'str4 - 图片宽度 str5 - 图片高度
'-----------------------
function Recommendpro(str1,str2,str3,str4,str5)
dim strwidth1,strwidth2
strwidth1 = 100
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select top "&str1*str2&" * from Hu_product where Recommenda = 1 order by id desc",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">没有推荐产品</span><br />"
else
i = 0
strtemp = strtemp & "<ul class=""newpro-ul"">"&vbcrlf
do while not fs_rs.eof
i = i+1
if i mod str2*1 <> 0 then '判断是不是每行的最行一条数据,是的话宽度减1%.
strwidth2 = strwidth1/str2
else
strwidth2 = (strwidth1/str2)-1
end if '结束判断
if left(trim(fs_rs("proimages")),5) = "http:" then
strproimg = trim(fs_rs("proimages"))
elseif trim(fs_rs("proimages")) <> "" then
strproimg = webml&trim(fs_rs("proimages"))
else
strproimg = webml&"upfiles/system/nophoto.gif"
end if
strtemp = strtemp & "<li style=""width: "&strwidth2&"%; height:"&str5+30&"px;"">"&vbcrlf
strtemp = strtemp & "<a href="""&webml&readproclass(fs_rs("cid"))&"/"&fs_rs("productus")&"/"" target=""_blank""><img src="""&strproimg&""" onload=""imgadapter(this,"&str4&","&str5&")"" alt=""产品名称:"&fs_rs("productcn")&vbcrlf&"产品型号:"&fs_rs("proxinghao")&vbcrlf&"产品规格:"&fs_rs("proguige")&""" /></a><br />"&vbcrlf
strtemp = strtemp & "<span style=""line-height: 30px;""><a href="""&webml&readproclass(fs_rs("cid"))&"/"&fs_rs("productus")&"/"" target=""_blank"" title="""&fs_rs("productcn")&""">"&left(fs_rs("productcn"),str3)&"</a></span></li>"&vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"&vbcrlf
end if
fs_rs.close
set fs_rs=nothing
Recommendpro = strtemp
end function

'-----------------------
'相关产品 relatpro
'str1 - 调用行数 str2 - 每行调用数 str3 - 产品名称字符数
'str4 - 图片宽度 str5 - 图片高度   str6 - 所属分类
'str7 - 现在的产品ID
'-----------------------
function relatpro(str1,str2,str3,str4,str5,str6,str7)
strwidth1 = 100
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select top "&str1*str2&" * from Hu_product where cid = "&str6*1&" order by id desc",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">没有产品</span><br />"
else
i = 0
strtemp = strtemp & "<ul class=""newpro-ul"">"&vbcrlf
do while not fs_rs.eof
if fs_rs("id")<>str7*1 then
i = i+1
if i mod str2*1 <> 0 then '判断是不是每行的最行一条数据,是的话宽度减1%.
strwidth2 = strwidth1/str2
else
strwidth2 = (strwidth1/str2)-1
end if '结束判断
if left(trim(fs_rs("proimages")),5) = "http:" then
strproimg = trim(fs_rs("proimages"))
elseif trim(fs_rs("proimages")) <> "" then
strproimg = webml&trim(fs_rs("proimages"))
else
strproimg = webml&"upfiles/system/nophoto.gif"
end if
strtemp = strtemp & "<li style=""width: "&strwidth2&"%; height:"&str5+30&"px;"">"&vbcrlf
strtemp = strtemp & "<a href="""&webml&readproclass(fs_rs("cid"))&"/"&fs_rs("productus")&"/"" target=""_blank""><img src="""&strproimg&""" onload=""imgadapter(this,"&str4&","&str5&")"" alt=""产品名称:"&fs_rs("productcn")&vbcrlf&"产品型号:"&fs_rs("proxinghao")&vbcrlf&"产品规格:"&fs_rs("proguige")&""" /></a><br />"&vbcrlf
strtemp = strtemp & "<span style=""line-height: 30px;""><a href="""&webml&readproclass(fs_rs("cid"))&"/"&fs_rs("productus")&"/"" target=""_blank"" title="""&fs_rs("productcn")&""">"&left(fs_rs("productcn"),str3)&"</a></span></li>"&vbcrlf
end if
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"&vbcrlf
end if
fs_rs.close
set fs_rs=nothing
relatpro = strtemp
end function

'---------------------
'asp防注过滤
'---------------------
Function Checkstr(Str)
If Isnull(Str) Then
CheckStr = ""
Exit Function
End If
Str = Replace(Str,Chr(0),"", 1, -1, 1)
Str = Replace(Str, """", "'", 1, -1, 1)
Str = Replace(Str,"<","<", 1, -1, 1)
Str = Replace(Str,">",">", 1, -1, 1)
Str = Replace(Str, "script", "script", 1, -1, 0)
Str = Replace(Str, "SCRIPT", "SCRIPT", 1, -1, 0)
Str = Replace(Str, "Script", "Script", 1, -1, 0)
Str = Replace(Str, "script", "Script", 1, -1, 1)
Str = Replace(Str, "object", "object", 1, -1, 0)
Str = Replace(Str, "OBJECT", "OBJECT", 1, -1, 0)
Str = Replace(Str, "Object", "Object", 1, -1, 0)
Str = Replace(Str, "object", "Object", 1, -1, 1)
Str = Replace(Str, "applet", "applet", 1, -1, 0)
Str = Replace(Str, "APPLET", "APPLET", 1, -1, 0)
Str = Replace(Str, "Applet", "Applet", 1, -1, 0)
Str = Replace(Str, "applet", "Applet", 1, -1, 1)
Str = Replace(Str, "[", "[")
Str = Replace(Str, "]", "]")
Str = Replace(Str, """", "", 1, -1, 1)
Str = Replace(Str, "=", "=", 1, -1, 1)
Str = Replace(Str, "'", "''", 1, -1, 1)
Str = Replace(Str, "select", "select", 1, -1, 1)
Str = Replace(Str, "execute", "execute", 1, -1, 1)
Str = Replace(Str, "exec", "exec", 1, -1, 1)
Str = Replace(Str, "join", "join", 1, -1, 1)
Str = Replace(Str, "union", "union", 1, -1, 1)
Str = Replace(Str, "where", "where", 1, -1, 1)
Str = Replace(Str, "insert", "insert", 1, -1, 1)
Str = Replace(Str, "delete", "delete", 1, -1, 1)
Str = Replace(Str, "update", "update", 1, -1, 1)
Str = Replace(Str, "like", "like", 1, -1, 1)
Str = Replace(Str, "drop", "drop", 1, -1, 1)
Str = Replace(Str, "create", "create", 1, -1, 1)
Str = Replace(Str, "rename", "rename", 1, -1, 1)
Str = Replace(Str, "count", "count", 1, -1, 1)
Str = Replace(Str, "chr", "chr", 1, -1, 1)
Str = Replace(Str, "mid", "mid", 1, -1, 1)
Str = Replace(Str, "truncate", "truncate", 1, -1, 1)
Str = Replace(Str, "nchar", "nchar", 1, -1, 1)
Str = Replace(Str, "char", "char", 1, -1, 1)
Str = Replace(Str, "alter", "alter", 1, -1, 1)
Str = Replace(Str, "cast", "cast", 1, -1, 1)
Str = Replace(Str, "exists", "exists", 1, -1, 1)
Str = Replace(Str,Chr(13),"<br>", 1, -1, 1)
CheckStr = Replace(Str,"'","''", 1, -1, 1)
End Function

'---------------------
'分页函数
'str - 当前页码 str1 - 总页数
'url - 网址
'---------------------
function kehupage(str,str1,url)
str = int(str)
str1 = int(str1)
'判断网址是否已经带参数
if right(url,4) = ".asp" then
fuhao = "?"
else
fuhao = "&"
end if
'结束判断
strtemp = "<a class=""page"" href="""&url&"""><strong>&lt;</strong></a> |  "& vbcrlf
if str1=1 or str1=0 then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">1</span></strong>"
else
if str<=5 then
if str1>=9 then
for i=1 to 9
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
if i=1 then
strtemp = strtemp & "<a class=""page"" href="""&url&"""><strong>"&i&"</strong></a> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&url&""&fuhao&"pagenum="&i&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
end if
next
else
for i=1 to str1
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
if i=1 then
strtemp = strtemp & "<a class=""page"" href="""&url&"""><strong>"&i&"</strong></a> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&url&""&fuhao&"pagenum="&i&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
end if
next
end if
elseif str1-str<=4 then
if str1>9 then
for i=str1-8 to str1
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&url&""&fuhao&"pagenum="&i&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
next
else
for i=1 to str1
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&url&""&fuhao&"pagenum="&i&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
next
end if
else
if str1>=str+4 then
for i=str-4 to str+4
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&url&""&fuhao&"pagenum="&i&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
next
else
for i=str-4 to str1
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&url&""&fuhao&"pagenum="&i&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
next
end if
end if
end if
if str1<=1 then
strtemp = strtemp & " <a class=""page"" href="""&url&"""><strong>&gt;</strong></a>"& vbcrlf
else
strtemp = strtemp & "  <a class=""page"" href="""&url&""&fuhao&"pagenum="&str1&"""><strong>&gt;</strong></a> "& vbcrlf
end if
dim striii
striii = int(1000*rnd)
strtemp = strtemp & "<select id=""selectpage"&striii&""" name=""selectpage"&striii&""" onchange=""location='"&url&""&fuhao&"pagenum='+document.getElementById('selectpage"&striii&"').value;javascript:submit()"">"& vbcrlf
strClick = ""
if str*1 = 1 or str*1 = 0 then strClick = " selected=""selected"""
strtemp = strtemp & "    <option value=""1"""&strClick&">第1页</option>"& vbcrlf
if str1 > 1 then
strClick = ""
for strpages = 2 to str1
if strpages = str*1 then strClick = " selected=""selected"""
strtemp = strtemp & "    <option value="""&strpages&""""&strClick&">第"&strpages&"页</option>"& vbcrlf
strClick = ""
next
end if
strtemp = strtemp & "</select>"& vbcrlf
kehupage=strtemp
end function

'---------------------
'网站公告函数
'str1 - 调用样式 str2 - 调用公告字数
'str3 - 宽度     str4 - 高度
'---------------------
function gonggao(str1,str2,str3,str4)
str1= str1 * 1:str2= str2 * 1
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select * from [Hu_gonggao]",conn,1,1
strgonggao = left(trim(fs_rs("gonggao")),str2)
fs_rs.close
set fs_rs=nothing
select case str1
case 1
strtemp = "<div class=""gonggao-p"" style=""width: "&str3&"px;height: "&str4&"px;"">"&strgonggao&"</div>"
case 2
strtemp = "<marquee onmouseover=""this.stop()"" onmouseout=""this.start()"" scrollAmount=""1"" scrollDelay=""0"" direction=""up"" class=""gonggao-p"" style=""width: "&str3&"px;height: "&str4&"px;"">"&strgonggao&"</marquee>"
case else
strtemp = "<marquee onmouseover=""this.stop()"" onmouseout=""this.start()"" scrollAmount=""3"" class=""gonggao-p"" style=""width: "&str3&"px;height: "&str4&"px;"">"&strgonggao&"</marquee>"
end select
gonggao = strtemp
end function

'---------------------
'最新资讯函数
'str1 - 调用栏目 str2 - 调用资讯条数
'str3 - 标题字数最大值
'---------------------
function topnews(str1,str2,str3)
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select top "&str2*1&" * from [Hu_news] where cid="&str1*1&" order by id desc",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">没有相关资讯!</span><br />"
else
i = 0
strtemp = strtemp & "<ul class=""topnews-ul"">"& vbcrlf
do while not fs_rs.eof and i < (str2*1)
i = i+1
newsaddtime = fs_rs("addtime")
newsaddtime = year(newsaddtime)&"/"&month(newsaddtime)&"/"&day(newsaddtime)
strtemp = strtemp & "<li><span>"&newsaddtime&"</span>"
strtemp = strtemp & "<a href="""&webml&readnewsclass(fs_rs("cid"))&"/"&fs_rs("id")&".html"" target=""_blank"" title="""&fs_rs("newstitle")&""">"&left(fs_rs("newstitle"),str3*1)&"</a></li>"& vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"& vbcrlf
end if
fs_rs.close
set fs_rs=nothing
topnews = strtemp
end function

'---------------------
'邮件订阅函数
'---------------------
function emailread()
strtemp = "<form name=""emaildy"" id=""emaildy"" action="""" method=""post"" class=""emailread"">"& vbcrlf
strtemp = strtemp & "<input name=""emailread"" type=""text"" /><br />"& vbcrlf
strtemp = strtemp & "<input name=""Button1"" type=""submit"" value=""订阅"" onclick=""document.emaildy.action='"&webml&"inc/Emaildy.asp?action=add'"" />&nbsp; "& vbcrlf
strtemp = strtemp & "<input name=""Button2"" type=""submit"" value=""退订"" onclick=""document.emaildy.action='"&webml&"inc/Emaildy.asp?action=del'"" />"& vbcrlf
strtemp = strtemp & "</form>"& vbcrlf
emailread = strtemp
end function

'---------------------
'树型产品分类
'str1 - 调用的分类ID号
'str2 - 分类前的图片地址
'---------------------
function proclasstree(str1,str2)
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select * from [Hu_proclass] where cid="&str1*1&"",conn,1,1
if not (fs_rs.bof and fs_rs.eof) then
do while not fs_rs.eof
set hu = server.CreateObject("adodb.recordset")
hu.open "select cid from [Hu_proclass] where cid = "&fs_rs("id")&"",conn,1,1
if not(hu.bof and hu.eof) then
strtheimg = "<img src="""&webml&"upfiles/System/plus.gif"" alt=""产品分类树"" style=""vertical-align: middle;"" />"
else
strtheimg = "<img src="""&webml&"upfiles/System/minus.gif"" alt=""树型产品分类"" style=""vertical-align: middle;"" />"
end if
hu.close
set hu = nothing
strtemp = strtemp & "<ul class=""proclasstree"">"& vbcrlf
strtemp = strtemp & "<li>"&str2&strtheimg&"<a href="""&webml&fs_rs("classnameus")&"/"">"&fs_rs("classnamecn")&"</a></li>"& vbcrlf
strtemp = strtemp & "</ul>"& vbcrlf
str2 = str2 & "<img src="""&webml&"upfiles/System/l.gif"" alt="""" style=""vertical-align: middle;"" />"
strtemp = strtemp & proclasstree(fs_rs("id"),str2)
str2 = left(str2,len(str2)-len("<img src="""&webml&"upfiles/System/l.gif"" alt="""" style=""vertical-align: middle;"" />"))
fs_rs.movenext
loop
end if
fs_rs.close
set fs_rs=nothing
proclasstree = strtemp
end function

'---------------------
'公司简介列表
'---------------------
function profilelist()
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select * from [Hu_profile]",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">公司简介文章为空</span><br />"
else
i = 0
strtemp = strtemp & "<ul class=""profilelist"">"& vbcrlf
do while not fs_rs.eof
i = i+1
strtemp = strtemp & "<li><a href="""&webml&fs_rs("newstitleus")&"/"">"&fs_rs("newstitlecn")&"</a></li>"& vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"& vbcrlf
end if
fs_rs.close
set fs_rs=nothing
profilelist = strtemp
end function

'---------------------
'营销网络列表
'---------------------
function marketlist()
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select * from [Hu_Market]",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">营销网络文章为空</span><br />"
else
i = 0
strtemp = strtemp & "<ul class=""profilelist"">"& vbcrlf
do while not fs_rs.eof
i = i+1
strtemp = strtemp & "<li><a href="""&webml&fs_rs("newstitleus")&"/"">"&fs_rs("newstitlecn")&"</a></li>"& vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"& vbcrlf
end if
fs_rs.close
set fs_rs=nothing
marketlist = strtemp
end function

'---------------------
'人才招聘列表
'---------------------
function joblist()
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select * from [Hu_job]",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">人才招聘文章为空</span><br />"
else
i = 0
strtemp = strtemp & "<ul class=""profilelist"">"& vbcrlf
do while not fs_rs.eof
i = i+1
strtemp = strtemp & "<li><a href="""&webml&fs_rs("newstitleus")&"/"">"&fs_rs("newstitlecn")&"</a></li>"& vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"& vbcrlf
end if
fs_rs.close
set fs_rs=nothing
joblist = strtemp
end function

'---------------------
'资讯分类列表
'---------------------
function newslist()
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select * from [Hu_newsclass]",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">资讯分类列表为空</span><br />"
else
i = 0
strtemp = strtemp & "<ul class=""profilelist"">"& vbcrlf
do while not fs_rs.eof
i = i+1
strtemp = strtemp & "<li><a href="""&webml&fs_rs("classnameus")&"/"">"&fs_rs("classname")&"</a></li>"& vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"& vbcrlf
end if
fs_rs.close
set fs_rs=nothing
newslist = strtemp
end function

'---------------------
'分类资讯列表
'str1 - 调用列数 str2 - 调用数量
'str3 - 新闻字数 str4 - 调用分类ID
'str5 - 当前页码
'---------------------
function classnews(str1,str2,str3,str4,str5)
strwidth1 = 100
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select * from [Hu_news] where cid="&str4&"*1 order by id desc",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">没有新闻!</span><br />"
else
i = 0
fs_rs.pagesize = str2*1
fs_rs.absolutepage = str5*1
strtemp = strtemp & "<ul class=""classnews"">"& vbcrlf
do while not fs_rs.eof and i < str2*1
i = i + 1
if i mod str1*1 <> 0 then '判断是不是每行的最行一条数据,是的话宽度减1%.
strwidth2 = (strwidth1/str1)-5
else
strwidth2 = (strwidth1/str1)-5
end if '结束判断
newsaddtime = fs_rs("addtime")
newsaddtime = year(newsaddtime)&"/"&month(newsaddtime)&"/"&day(newsaddtime)
strtemp = strtemp & "<li style=""width: "&strwidth2&"%;""><span>"&newsaddtime&"</span><a href="""&webml&readnewsclass(fs_rs("cid"))&"/"&fs_rs("id")&".html"" target=""_blank"" title="""&fs_rs("newstitle")&""">"&fs_rs("newstitle")&"</a></li>"& vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"& vbcrlf
end if
fs_rs.close
set fs_rs = nothing
classnews = strtemp
end function

'-----------------------
'产品展示 prodisplay
'str1 - 调用行数 str2 - 每行调用数 str3 - 产品名称字符数
'str4 - 图片宽度 str5 - 图片高度   str6 - 当前页码
'str7 - 分类ID
'-----------------------
function prodisplay(str1,str2,str3,str4,str5,str6,str7)
strwidth1 = 100
set fs_rs=server.CreateObject("adodb.recordset")
if str7 = "" or str7 = 0 then
fs_rs.open "select * from Hu_product order by id desc",conn,1,1
else
fs_rs.open "select * from Hu_product where cid in ("&str7&") order by id desc",conn,1,1
end if
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;"">没有产品</span><br />"
else
i = 0
fs_rs.pagesize = str1*str2
fs_rs.absolutepage = str6*1
strtemp = strtemp & "<ul class=""newpro-ul"">"&vbcrlf
do while not fs_rs.eof and i < fs_rs.pagesize
i = i+1
if i mod str2*1 <> 0 then '判断是不是每行的最行一条数据,是的话宽度减1%.
strwidth2 = strwidth1/str2
else
strwidth2 = (strwidth1/str2)-1
end if '结束判断
if left(trim(fs_rs("proimages")),5) = "http:" then
strproimg = trim(fs_rs("proimages"))
elseif trim(fs_rs("proimages")) <> "" then
strproimg = webml&trim(fs_rs("proimages"))
else
strproimg = webml&"upfiles/system/nophoto.gif"
end if
strtemp = strtemp & "<li style=""width: "&strwidth2&"%;height:"&str5+30&"px;"">"&vbcrlf
strtemp = strtemp & "<a href="""&webml&readproclass(fs_rs("cid"))&"/"&fs_rs("productus")&"/"" target=""_blank""><img src="""&strproimg&""" onload=""imgadapter(this,"&str4&","&str5&")"" alt=""产品名称:"&fs_rs("productcn")&vbcrlf&"产品型号:"&fs_rs("proxinghao")&vbcrlf&"产品规格:"&fs_rs("proguige")&""" /></a><br />"&vbcrlf
strtemp = strtemp & "<span style=""line-height: 30px;""><a href="""&webml&readproclass(fs_rs("cid"))&"/"&fs_rs("productus")&"/"" target=""_blank"" title="""&fs_rs("productcn")&""">"&left(fs_rs("productcn"),str3)&"</a></span></li>"&vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"&vbcrlf
end if
fs_rs.close
set fs_rs=nothing
prodisplay = strtemp
end function

'---------------------
'读取新闻栏目英文函数
'str - 栏目ID
'---------------------
function readnewsclass(str)
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select classnameus from [Hu_newsclass] where id = "&str&"",conn,1,1
if not (fs_rs.bof and fs_rs.eof) then
strtemp = fs_rs("classnameus")
else
strtemp = ""
end if
fs_rs.close
set fs_rs = nothing
readnewsclass = strtemp
end function
'---------------------
'读取新闻栏目中文名称函数
'str - 栏目ID
'---------------------
function readnewsclassname(str)
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select classname from [Hu_newsclass] where id = "&str&"",conn,1,1
if not (fs_rs.bof and fs_rs.eof) then
strtemp = fs_rs("classname")
else
strtemp = ""
end if
fs_rs.close
set fs_rs = nothing
readnewsclassname = strtemp
end function
'---------------------
'读取产品栏目英文函数
'str - 栏目ID
'---------------------
function readproclass(str)
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select classnameus from [Hu_proclass] where id = "&str&"",conn,1,1
if not (fs_rs.bof and fs_rs.eof) then
strtemp = fs_rs("classnameus")
else
strtemp = ""
end if
fs_rs.close
set fs_rs = nothing
readproclass = strtemp
end function
'---------------------
'读取产品栏目中文名称函数
'str - 栏目ID
'---------------------
function readproclassname(str)
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select classnamecn from [Hu_proclass] where id = "&str&"",conn,1,1
if not (fs_rs.bof and fs_rs.eof) then
strtemp = fs_rs("classnamecn")
else
strtemp = ""
end if
fs_rs.close
set fs_rs = nothing
readproclassname = strtemp
end function
'---------------------
'读取产品图片
'str - 图片url
'---------------------
function readpropic(str,str1)
dim strimg
if str&"a" = "a" then
strimg = ""&webml&"upfiles/system/nophoto.gif"
elseif str <> "" and left(str,5) <> "http:" then
strimg = webml&str
else
strimg = str
end if
strtemp = strtemp & "<img src="""&strimg&""" alt="""&str1&""" onload=""imgadapter(this,400,400)"" />"
readpropic = strtemp
end function
'---------------------
'产品在线订购
'str1 - 产品ID str2 - 产品名称
'str3 - 产品型号
'---------------------
function buyonline(str1,str2,str3)
strtemp = "<form action="""&webml&"inc/Chkbuyonline.asp"" method=""post"">"& vbcrlf
strtemp = strtemp & "<input name=""proid"" type=""hidden"" value="""&str1&""">"& vbcrlf
strtemp = strtemp & "<input name=""proname"" type=""hidden"" value="""&str2&""">"& vbcrlf
strtemp = strtemp & "<input name=""proxh"" type=""hidden"" value="""&str3&""">"& vbcrlf
strtemp = strtemp & "<div style=""line-height: 30px;text-align:left; height:30px;"">"& vbcrlf
strtemp = strtemp & "您的姓名:<input name=""yourname"" type=""text"" /> 性别:<select name=""sex"">"& vbcrlf
strtemp = strtemp & "                <option value="" "" selected=""selected"">选择</option>"& vbcrlf
strtemp = strtemp & "                <option value=""男"">男</option>"& vbcrlf
strtemp = strtemp & "                <option value=""女"">女</option>"& vbcrlf
strtemp = strtemp & "            </select> <span style=""color: red;"">*</span></div>"& vbcrlf
strtemp = strtemp & "<div style=""line-height: 30px;text-align:left; height:30px;"">"& vbcrlf
strtemp = strtemp & "公司名称:<input name=""company"" type=""text"" size=""40"" /></div>"& vbcrlf
strtemp = strtemp & "<div style=""line-height: 30px;text-align:left; height:30px;"">"& vbcrlf
strtemp = strtemp & "联系电话:<input name=""tel"" type=""text"" /> <span style=""color: red;"">*</span></div>"& vbcrlf
strtemp = strtemp & "<div style=""line-height: 30px;text-align:left; height:30px;"">"& vbcrlf
strtemp = strtemp & "联系邮箱:<input name=""email"" type=""text"" /> <span style=""color: red;"">*</span></div>"& vbcrlf
strtemp = strtemp & "<div style=""line-height: 30px;text-align:left; height:30px;"">"& vbcrlf
strtemp = strtemp & "联系地址:<input name=""addr"" type=""text"" size=""40"" /> <span style=""color: red;"">*</span></div>"& vbcrlf
strtemp = strtemp & "<div style=""line-height: 30px;text-align:left; height:30px;"">"& vbcrlf
strtemp = strtemp & "邮政编码:<input name=""code"" type=""text"" /></div>"& vbcrlf
strtemp = strtemp & "<div style=""line-height: 30px;text-align:left; height:30px;"">"& vbcrlf
strtemp = strtemp & "产品编号:<input name=""probianhao"" type=""text"" value="""&str3&""" readonly=""readonly"" /></div>"& vbcrlf
strtemp = strtemp & "<div style=""line-height: 30px;text-align:left; height:70px;"">"& vbcrlf
strtemp = strtemp & "备&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 注:<textarea name=""content"" cols=""26"" rows=""3""></textarea></div>"& vbcrlf
strtemp = strtemp & "<div style=""line-height: 25px;text-align:left; height:25px;"">"& vbcrlf
strtemp = strtemp & "<input name=""Submit1"" type=""submit"" value=""提交信息"" /> &nbsp;<input name=""Reset1"" type=""reset"" value=""重置"" /></div>"& vbcrlf
strtemp = strtemp & "</form>"& vbcrlf
buyonline = strtemp
end function

'---------------------
'logo链接
'str1 - 行数 str2 - 每行数量
'---------------------
function logolinks(str1,str2)
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select top "&str1*str2&" * from [Hu_links] where linklx = 1 and recycle = 0",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;""></span><br />"
else
i = 0
strtemp = "<ul class=""links"">"& vbcrlf
do while not fs_rs.eof and i < str2
i = i + 1
strwidth1 = 100
strwidth2 = 0
if i mod str2*1 <> 0 then '判断是不是每行的最行一条数据,是的话宽度减1%.
strwidth2 = strwidth1/str2
else
strwidth2 = (strwidth1/str2)-1
end if '结束判断
if fs_rs("logourl")&"a" = "a" then
strimg = ""&webml&"upfiles/system/nologo.gif"
elseif str <> "" and left(str,5) <> "http:" then
strimg = webml&fs_rs("logourl")
else
strimg = fs_rs("logourl")
end if
if left(fs_rs("weburl"),5)<>"http:" then
logolinksweburl = "http:"&fs_rs("weburl")
else
logolinksweburl = fs_rs("weburl")
end if
strtemp = strtemp & "<li style=""width: "&int(strwidth2)&"%;""><a href="""&logolinksweburl&""" target=""_blank""><img src="""&strimg&""" alt="""&fs_rs("webcontent")&""" style=""width: 88px; height: 31px; border: 0;"" /></a></li>"& vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"& vbcrlf
end if
fs_rs.close
set fs_rs = nothing
logolinks = strtemp
end function

'---------------------
'文字链接
'str1 - 行数 str2 - 每行数量
'---------------------
function textlinks(str1,str2)
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select top "&str1*str2&" * from [Hu_links] where linklx = 0 and recycle = 0",conn,1,1
if fs_rs.bof and fs_rs.eof then
strtemp = "<span style=""line-height:25px; margin-left:20px;""></span><br />"
else
i = 0
strtemp = "<ul class=""links"">"& vbcrlf
do while not fs_rs.eof and i < str2
i = i + 1
strwidth1 = 100
strwidth2 = 0
if i mod str2*1 <> 0 then '判断是不是每行的最行一条数据,是的话宽度减1%.
strwidth2 = strwidth1/str2
else
strwidth2 = (strwidth1/str2)-1
end if '结束判断
if left(fs_rs("weburl"),5)<>"http:" then
textlinksweburl = "http:"&fs_rs("weburl")
else
textlinksweburl = fs_rs("weburl")
end if
strtemp = strtemp & "<li style=""width: "&int(strwidth2)&"%;""><a href="""&textlinksweburl&""" target=""_blank"" title="""&fs_rs("webcontent")&""">"&fs_rs("webtitle")&"</a></li>"& vbcrlf
fs_rs.movenext
loop
strtemp = strtemp & "</ul>"& vbcrlf
end if
fs_rs.close
set fs_rs = nothing
textlinks = strtemp
end function

'---------------------
'邮件发送
'subject - 邮件主题 shouemail - 收件人
'content - 邮件内容
'---------------------
Sub SendAction(subject,shouemail,content,mailfujian)
if trim(mailfujian) <> "" then
mailfujian = webml&mailfujian
mailfujian = server.MapPath(mailfujian)
set fsosss=server.CreateObject("scripting.filesystemobject")
if fsosss.FileExists(mailfujian)=false then
response.write("<script>showmsgbox('您选择的附件不存在!')</script>")
response.write("<meta http-equiv=""refresh"" content=""1;URL=index.asp?action=close"" />")
response.end
end if
set fsosss=nothing
end if
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select * from [Hu_jmail]",conn,1,1
if not(fs_rs.bof and fs_rs.eof) then
MailAddress = fs_rs("MailAddress")    'smtp地址
Sender = fs_rs("Sender")              '发送人
Fromer = fs_rs("Fromer")       '发件人email
SendUserName = fs_rs("SendUserName")         '发件人帐号
Sendpassword = fs_rs("Sendpassword")       '发件人密码
end if
fs_rs.close
set fs_rs=nothing
Set jmail = Server.CreateObject("JMail.Message")
jmail.silent = true
JMail.ISOEncodeHeaders = True
jmail.logging = true
JMail.Charset = "GB2312"
if trim(mailfujian) <> "" then
jmail.ContentType = "multipart/mixed"
else
jmail.ContentType = "text/html"
end if
JMail.From = fromer
JMail.FromName = sender
JMail.AddRecipient(shouEmail)
JMail.MailServerUserName = SendUserName
JMail.MailServerPassword = Sendpassword
JMail.Priority = 3
JMail.Subject = subject
if trim(mailfujian) <> "" then contentId = JMail.AddAttachment(""&mailfujian&"",True)
JMail.Body = content
JMail.Send(""&SendUserName&":"&Sendpassword&"@"&MailAddress&"")
JMail.Close()
Set JMail = Nothing
end sub

'---------------------
'读取所有下属分类的产品
'str1 - 当前分类id
'---------------------
function readallclasspro(str1)
set fs_rs=server.CreateObject("adodb.recordset")
fs_rs.open "select id from [Hu_proclass] where cid = "&str1*1&"",conn,1,1
if not (fs_rs.bof and fs_rs.eof) then
do while not fs_rs.eof
strtemp = strtemp & "," & fs_rs("id")
strtemp = strtemp & readallclasspro(fs_rs("id"))
fs_rs.movenext
loop
end if
fs_rs.close
set fs_rs = nothing
readallclasspro = strtemp
end function

Function ReadTemplate(TemplateFile,TemplateChar)
    'On error resume next
    Set objStream = Server.CreateObject("adodb.stream")  
    objStream.Open
    objStream.Type = 2
    objStream.Charset = TemplateChar
    objStream.LoadFromFile(Server.MapPath(TemplateFile))  
    strAllContent = objStream.ReadText  
    objStream.Close  
    Set objStream = Nothing  
    ReadTemplate =strAllContent
end function

Function Writepage(FileUrl,TemplateFile,TemplateChar)
    'On error resume next
    set objStream=Server.CreateObject("adodb.stream")
    objStream.Type=2 '以本模式读取
    objStream.mode=3
    objStream.charset=TemplateChar
    objStream.open
    objStream.WriteText TemplateFile
    objStream.SaveToFile server.MapPath(FileUrl),2
    objStream.flush
    objStream.Close
    set objStream=nothing
End Function

function Canshuint(lables,strtempp)
dim tmp1,tmp2,tmpstr,canshu,shuchu
tmp2=1
while instr(tmp2,strtempp,lables)>0
tmp1=instr(tmp2,strtempp,lables)
tmp2=instr(tmp1+1,strtempp,"%}")
tmpstr=mid(strtempp,tmp1,tmp2-tmp1)
tmpstr=replace(tmpstr,lables,"")
tmpstr=replace(tmpstr,"(","")
tmpstr=replace(tmpstr,")","")
canshu=split(tmpstr,",")
wend
select case lables
case "{%分类资讯列表"
shuchu=canshu(1)
case "{%产品列表"
shuchu= canshu(0)*canshu(1)
end select
Canshuint = shuchu
end function




function Makepage(str,str1,files,ljf,hz)
strtemp = "<a class=""page"" href="""&files&"."&hz&"""><strong>&lt;</strong></a> |  "& vbcrlf
if str1=1 or str1=0 then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">1</span></strong>"
else
if str<=5 then
if str1>=9 then
for i=1 to 9
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
if i=1 then
strtemp = strtemp & "<a class=""page"" href="""&files&"."&hz&"""><strong>"&i&"</strong></a> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&files&ljf&i&"."&hz&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
end if
next
else
for i=1 to str1
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
if i=1 then
strtemp = strtemp & "<a class=""page"" href="""&files&"."&hz&"""><strong>"&i&"</strong></a> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&files&ljf&i&"."&hz&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
end if
next
end if
elseif str1-str<=4 then
if str1>9 then
for i=str1-8 to str1
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&files&ljf&i&"."&hz&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
next
else
for i=1 to str1
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&files&ljf&i&"."&hz&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
next
end if
else
if str1>=str+4 then
for i=str-4 to str+4
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&files&ljf&i&"."&hz&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
next
else
for i=str-4 to str1
if i=str then
strtemp = strtemp & "<strong><span style=""color: #FF6600;font-size: 14px;"">"&i&"</span></strong> | "& vbcrlf
else
strtemp = strtemp & "<a class=""page"" href="""&files&ljf&i&"."&hz&"""><strong>"&i&"</strong></a> | "& vbcrlf
end if
next
end if
end if
end if
if str1<=1 then
strtemp = strtemp & " <a class=""page"" href="""&files&"."&hz&"""><strong>&gt;</strong></a>"& vbcrlf
else
strtemp = strtemp & "  <a class=""page"" href="""&files&ljf&i-1&"."&hz&"""><strong>&gt;</strong></a> "& vbcrlf
end if
dim striii
striii = int(1000*rnd)
strtemp = strtemp & "<select id=""selectpage"&striii&""" name=""selectpage"&striii&""" onchange=""location=''+document.getElementById('selectpage"&striii&"').value;javascript:submit()"">"& vbcrlf
strClick = ""
if str*1 = 1 or str*1 = 0 then strClick = " selected=""selected"""
strtemp = strtemp & "    <option value="""&files&"."&hz&""""&strClick&">第1页</option>"& vbcrlf
if str1 > 1 then
strClick = ""
for strpages = 2 to str1
if strpages = str*1 then strClick = " selected=""selected"""
strtemp = strtemp & "    <option value="""&files&ljf&strpages&"."&hz&""""&strClick&">第"&strpages&"页</option>"& vbcrlf
strClick = ""
next
end if
strtemp = strtemp & "</select>"& vbcrlf
Makepage=strtemp
end function

%>
您需要登录后才可以回帖 登录 | 注册

本版积分规则

申请友链|小黑屋|最新主题|手机版|新微赢技术网 ( 苏ICP备08020429号 )  

GMT+8, 2024-11-19 14:48 , Processed in 0.110863 second(s), 8 queries , Gzip On, Memcache On.

Powered by xuexi

© 2001-2013 HaiAn.Com.Cn Inc. 寰耽

快速回复 返回顶部 返回列表