<% dim conn dim str ''on error resume next Set Conn=Server.CreateObject("ADODB.Connection") Conn.open "driver={SQL Server};server=localhost,2433;uid=jiankang;pwd=redc2h0i0n8a;database=jiankang42062_" '============================================================================== If Err Then err.Clear Set Conn = Nothing Response.Write "数据库连接出错，请检查连接字串。" Response.End End If '============================================================================== ''我正在调试，请不要动！ %> <% '=====================网站基本配置信息========================= dim website,webaddre,qqopen,qqstr website="健康科学网" webaddre="http://www.5jk.com.cn/" qqopen="1" qqstr="307293649,463205265,741423120" %> <% function advshow(id) set ggrs=server.CreateObject("adodb.recordset") sql="select * from honor where id="&id ggrs.open sql,conn,1,1 if not ggrs.eof then if ggrs("flash")=0 then webshow="" if ggrs("links")<>"" then webshow=""&webshow response.write webshow else response.write""&_ ""&_ ""&_ ""&_ ""&_ "" end if end if ggrs.close set ggrs=nothing end function %> <% function advbg(id) set ggrs=server.CreateObject("adodb.recordset") sql="select * from honor where id="&id ggrs.open sql,conn,1,1 if not ggrs.eof then response.Write ggrs("Img") end if ggrs.close set ggrs=nothing end function %><% function guanggao1(id) set ggrs=server.CreateObject("adodb.recordset") sql="select * from honor where ID="&id&"" ggrs.open sql,conn,1,1 if not ggrs.eof then if cint(ggrs("flash"))=1 then weizhi=" " else weizhi="" end if end if ggrs.close set ggrs=nothing guanggao1=weizhi end function %> <% '==========================获取IMG===================== Function getimg(str) regstr="src\=.+?\.(gif|jpg)" url=Replace(Replace(Replace(RegExp_Execute(regstr,str),"'",""),"""",""),"src=","") tmpArr=Split(url,",") if IsArray(tmpArr) and url<>"" then getimg=tmpArr(0) end if End Function '返回匹配值 Function RegExp_Execute(patrn, strng) Dim regEx, Match, Matches,values '建立变量。 Set regEx = New RegExp '建立正则表达式。 regEx.Pattern = patrn '设置模式。 regEx.IgnoreCase = true '设置是否区分字符大小写。 regEx.Global = True '设置全局可用性。 Set Matches = regEx.Execute(strng) '执行搜索。 For Each Match in Matches '遍历匹配集合。 values=values&Match.Value&"," Next RegExp_Execute = values End Function '===================================获取文字=========================== Function getword(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 getword=strHTML Set objRegExp = Nothing End Function %> <% '========================= '获取当前Url参数的函数 Private Function GetUrl() Dim ScriptAddress, M_ItemUrl, M_item ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME")) '取得当前地址 M_ItemUrl = "" If (Request.QueryString <> "") Then ScriptAddress = ScriptAddress & "?" For Each M_item In Request.QueryString If InStr(page,M_Item)=0 Then M_ItemUrl = M_ItemUrl & M_Item &"="& Server.URLEncode(Request.QueryString(""&M_Item&"")) & "&" End If Next end if GetUrl = ScriptAddress & M_ItemUrl End Function '============================= %> <% '===================================== guid=trim(request("guid")) if guid="" then guid="2" set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From guide where guid="&guid,conn,1,1 guname=rs("guname") rs.close set rs=nothing '============================================ %> :::健康科学网首页,丰富的健康知识,企业信息,产品信息:::
<% '====================================í?ò3?ù±?????D??￠================================= dim advs(5) 'í???ID set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From honor where advprev='"&guid&"' and ID not in(24) order by ID asc",conn,1,1 j=1 do while not rs.eof and j<=5 advs(j)=rs("ID") rs.movenext j=j+1 loop rs.close set rs=nothing '-------------D???---------------------- dim newsid(30) dim newslink(30) dim newsname(30) set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From guide where nextclass='"&guid&"' order by guorder asc",conn,1,1 aa=1 do while not rs.eof and aa<=30 newsid(aa)=rs("guid") newslink(aa)=rs("gulink") newsname(aa)=rs("guname") rs.movenext aa=aa+1 loop rs.close set rs=nothing '------------------------------------------- %>
<% dim gunstr(27) set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From guide where nextclass='0' order by guorder asc",conn,1,1 for aa=1 to 27 if rs("gulink")="0" then gustr="href="&""""&"#"&""""&" style="&""""&"BEHAVIOR: url(#default#homepage); CURSOR: hand;"&""""&" onclick="&""""&"var strHref=window.location.href;this.style.behavior="&"'"&"url(#default#homepage)"&"'"&";this.setHomePage("&"'"&webaddre&"'"&");"&""""&"" if rs("gulink")="1" then gustr="href="&""""&"#"&""""&" onclick="&""""&"window.external.addFavorite("&"'"&webaddre&"'"&","&"'"&website&"'"&")"&""""&"" if rs("gulink")<>"0" and rs("gulink")<>"1"then gustr="href='"&rs("gulink")&"'" if aa=1 or aa=10 or aa=19 then gunstr(aa) =""&rs("guname")&"" else gunstr(aa) =""&rs("guname")&"" end if rs.movenext if rs.eof then exit for next rs.close set rs=nothing %>
<% call advshow(24) %>
<% =gunstr(1) %>
<% =gunstr(2) %>
<% =gunstr(3) %>
<% =gunstr(4) %>
<% =gunstr(5) %>
<% =gunstr(6) %>
<% =gunstr(7) %>
<% =gunstr(8) %>
<% =gunstr(9) %>
<% =gunstr(10) %>
<% =gunstr(11) %>
<% =gunstr(12) %>
<% =gunstr(13) %>
<% =gunstr(14) %>
<% =gunstr(15) %>
<% =gunstr(16) %>
<% =gunstr(17) %>
<%=gunstr(18)%>
<% =gunstr(19) %>
<% =gunstr(20) %>
<% =gunstr(21) %>
<% =gunstr(22) %>
<% =gunstr(23) %>
<% =gunstr(24) %>
<% =gunstr(25) %>
<% =gunstr(26) %>
<% =gunstr(27) %>
<% set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From mecon where meid=1",conn,1,1 if not rs.eof then if rs("melink")<>"" then response.Write"" response.Write rs("mename")&"" wmvstr=rs("mecon") end if rs.close set rs=nothing %>
<% call advshow(advs(1)) %>

建立终身健康档案
发泄郁闷的空间
<% set rs=Server.CreateObject("Adodb.Recordset") Rs.open "select top 5 * from video order by addtime asc",conn,1,1 ' wmvstr=rs("mecon") Rec=Rs.RecordCount %> <% Rs.close set Rs=nothing %>
<% '===================新闻6========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(6)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=7 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>
<% '===================D???èy========================== set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From guide where nextclass='3' order by guorder asc",conn,1,1 aa=1 do while not rs.eof and aa<=30 if aa=1 then ordstr="'"&rs("guid")&"'" else ordstr=ordstr&","&"'"&rs("guid")&"'" end if rs.movenext aa=aa+1 loop rs.close set rs=nothing dim imgstr(12) dim wostr(12) set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type IN("&ordstr&") ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=12 if rs("imgpath")="NO" then imgstr(aa)="?Yê±??óDí???" else imgstr(aa)="&rs(" end if wostr(aa)=""&year(rs("addtime"))&"-"&month(rs("addtime"))&"-"&day(rs("addtime"))&"
"&left(replace(Replace(Replace(Replace(getword(rs("content"))," ","")," ",""),chr(13)&chr(10),""),chr(32),""),23)&"" rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
<% '===================新闻5========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(5)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=7 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>
         产品目录                更多>>
<% '===================新闻四========================== bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From qimulu ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=9 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
> [ <% set rs2=Server.CreateObject("Adodb.Recordset") rs2.open "SELECT * From usercon",conn,1,3 if not rs.eof then sstra=rs2("ucpro") rs2.close set rs2=nothing session("sheng")=rs("sheng") tmpArra=Split(sstra,"|") if IsArray(tmpArra) then response.Write tmpArra(int(rs("sheng"))) %>] >
<% shenhe=rs("shenhe") if shenhe=0 then response.Write(""&left(rs("qname"),13)&"") else if shenhe=1 then response.Write(""&left(rs("qname"),13)&"") else response.Write(""&left(rs("qname"),13)&"") end if end if %>
<% '===================新闻四========================== bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From chanpin ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=8 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>   •  <% leixing=rs("leixing") if leixing=0 then response.Write(""&left(rs("cname"),11)&"") else if leixing=1 then response.Write(""&left(rs("cname"),11)&"") else response.Write("dghfhf") end if end if %>
<% set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From ceshi ORDER BY addtime DESC",conn,1,1 if not rs.eof then for i=1 to 3 %> <% rs.movenext if rs.eof then exit for next end if rs.close set rs=nothing '===================================================================================== %>
&uid=<% =rs("leibie")%>"> <% =left(rs("title"),10) %> [ <% =month(rs("addtime"))&"."&day(rs("addtime")) %> ]
   营养学知识  饮食与健康
<% '===================新闻9========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(7)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=7 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>  • "><% =left(rs("title"),9) %>
<% '===================新闻四========================== bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(4)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>  • "> <% =left(rs("title"),10) %>
<% '===================新闻9========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(10)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=7 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>
<% '===================新闻10========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(9)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>
<% '===================新闻二========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(2)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=2 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>
<% '===================新闻18========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(18)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=2 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
<% '===================新闻二========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(1)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>
<% '===================新闻16========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(16)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
<% '===================D???15========================== bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(15)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=4 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>
<% '===================新闻8========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(8)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=4 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>
专家专栏  环境与健康
妇科      胃病
健康论坛
医学博士骨科专家
<% '===================D???14========================== bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(14)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
> "><% =left(rs("title"),9) %>
<% '===================D???12========================== bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(19)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=8 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
> "><% =left(rs("title"),10) %>
<% '===================D???13========================== bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(13)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>  • "><% =left(rs("title"),10) %>
<% '===================D???12========================== bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(12)&"' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=7 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>  • "><% =left(rs("title"),10) %>
<% set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(24)&"' ORDER BY addtime DESC",conn,1,1 if not rs.eof then for i=1 to 3 %> <% rs.movenext if rs.eof then exit for next end if rs.close set rs=nothing %>
"> <% =left(rs("title"),13) %>
企业
<% set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From qimulu where shenhe='1' ORDER BY addtime DESC",conn,1,1 if not rs.eof then for i=1 to 10 %> <% rs.movenext if rs.eof then exit for next end if rs.close set rs=nothing '===================================================================================== %>
'"> <% =left(rs("qname"),14) %>
产品  <% '===================新闻16========================== aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "select c.cname,c.leixing,c.cId,c.qiId from chanpin c left join qimulu q on c.qiId=q.qiId where q.shenhe='1' order by c.addtime desc",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
·<% leixing=rs("leixing") if leixing=0 then response.Write(""&left(rs("cname"),13)&"") else if leixing=1 then response.Write(""&left(rs("cname"),13)&"") else response.Write("dghfhf") end if end if %>
本
站
公
告		 <% set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From news where type='"&newsid(11)&"' ORDER BY addtime DESC",conn,1,1 if not rs.eof then for i=1 to 3 %> <% rs.movenext if rs.eof then exit for next end if rs.close set rs=nothing %>
"> <% =left(rs("title"),13) %>
最新求购信息
最新销售信息
中药材
药 品
医药软件
<% bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "select c.cId,q.qiId,c.cname,q.qname,q.shenhe from chanpin c left join qimulu q on c.qiId=q.qiId where c.leixing='0' order by c.addtime desc",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
> &uid=<% =rs("qiId")%>"> <% =left(rs("cname"),11)%>
<% bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "select c.cId,q.qiId,c.cname,q.qname,q.shenhe from chanpin c left join qimulu q on c.qiId=q.qiId where c.leixing='1' order by c.addtime desc",conn,1,1 ' rs.open "SELECT * From chanpin where leixing='销售' ORDER BY c.addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>&uid=<% =rs("qiId")%>"> <% =left(rs("cname"),11)%>
<% bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "select c.cId,q.qiId,c.cname,q.qname from chanpin c left join qimulu q on c.qiId=q.qiId where c.fenlei='中药材' order by c.addtime desc",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>&uid=<% =rs("qiId")%>"> <% =left(rs("cname"),11)%>
<% '===================新闻四========================== bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From qimulu where fenlei='药品' ORDER BY addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>
<% shenhe=rs("shenhe") if shenhe=0 then response.Write(""&left(rs("qname"),13)&"") else if shenhe=1 then response.Write(""&left(rs("qname"),13)&"") else response.Write(""&left(rs("qname"),13)&"") end if end if %>
<% bg="" aa=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "select c.cId,q.qiId,c.cname,q.qname,q.shenhe from chanpin c left join qimulu q on c.qiId=q.qiId where c.fenlei='药品软件' order by c.addtime desc",conn,1,1 ' rs.open "SELECT * From chanpin where leixing='销售' ORDER BY c.addtime DESC",conn,1,1 aa=1 do while not rs.eof and aa<=3 %> <% rs.movenext aa=aa+1 loop rs.close set rs=nothing %>
>&uid=<% =rs("qiId")%>"> <% =left(rs("cname"),11)%>
<% '=========================文字链接============================ dim wstr set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From buinfo where buid<12",conn,1,1 aa=1 do while not rs.eof if rs("bulink")="0" then addstr="href="&""""&"#"&""""&" style="&""""&"BEHAVIOR: url(#default#homepage); CURSOR: hand;"&""""&" onclick="&""""&"var strHref=window.location.href;this.style.behavior="&"'"&"url(#default#homepage)"&"'"&";this.setHomePage("&"'"&webaddre&"'"&");"&""""&"" if rs("bulink")="1" then addstr="href="&""""&"#"&""""&" onclick="&""""&"window.external.addFavorite("&"'"&webaddre&"'"&","&"'"&website&"'"&")"&""""&"" if rs("bulink")<>"0" and rs("bulink")<>"1"then addstr="href='"&rs("bulink")&"'" if aa=1 then wstr=""&rs("buname")&" " else wstr=wstr&"| "&rs("buname")&" " end if rs.movenext aa=aa+1 loop rs.close set rs=nothing '================================================================= %>
<% '====================????========================== dim img(6) dim wor(6) for i=1 to 6 img(i)="??????" wor(i)="??????" next i=1 set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From qimgs order by qId asc",conn,1,1 do while not rs.eof and i<=6 img(i)=""&rs("yname")&"" wor(i)=""&left(rs("yname"),10)&"" rs.movenext i=i+1 loop rs.close set rs=nothing '======================================================== %>
<%=img(1)%>
<%=img(2)%>
<%=img(3)%>
<%=img(4)%>
<%=img(5)%>
<%=img(6)%>
<% =wor(1) %>
<% =wor(2) %>
<% =wor(3) %>
<% =wor(4) %>
<% =wor(5) %>
<% =wor(6) %>
文
字
链
接
<% '========文字链接============== set rs=conn.execute("select * from wlinks order by id asc") do while not rs.eof response.Write"　"&rs("name")&"" rs.movenext loop rs.close set rs=nothing '========================================================== %>
<% =wstr %>
<% '================================信息=============================== set rs=Server.CreateObject("Adodb.Recordset") rs.open "SELECT * From buinfo where buid=13",conn,1,1 if not rs.eof then response.write rs("bucon") rs.close set rs=nothing '================================================================= conn.close set conn=nothing %>
<% if qqopen="1" then dim adm_qq,qq,N,myqq '《网站QQ在线咨询插件》 '作者：逍遥浪子（参考腾讯技术文档编写） 'ＱＱ：46603699 '演示：http://www.buyok.net/ '转载请完整保留此说明文档 '修改adm_qq后面引号中的QQ号，多个QQ号用半角逗号隔开，QQ数量不限。 adm_qq=qqstr QQ=split(adm_qq,",") for N=0 to UBound(QQ) MyQQ=MyQQ+QQ(N)+":" next %> <% for N=0 to UBound(QQ) %> <%next%>
<% end if %>