<% F_filename="D:\hosting\wwwroot\chinapantone_com_ufhost\htdocs\" dim conn,connstr,TimesDB,rs TimesDB="/shop/admin/#TimesShop.asa" Set conn = Server.CreateObject("ADODB.Connection") connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(""&TimesDB&"") conn.Open connstr Sub SetConn () set conn = Server.CreateObject("ADODB.Connection") connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(""&TimesDB&"") conn.Open connstr 'If Err.number <> 0 Then 'Response.Write "" 'Response.End 'End If End Sub Sub ClearConn () Conn.Close Set Conn = Nothing End Sub Dim UserAgent UserAgent = Trim(Lcase(Request.Servervariables("HTTP_USER_AGENT"))) If InStr(UserAgent,"teleport") > 0 or InStr(UserAgent,"webzip") > 0 or InStr(UserAgent,"flashget")>0 or InStr(UserAgent,"offline")>0 Then Response.Write "请不要采用teleport/Webzip/Flashget/Offline等工具来浏览商城！" Response.End End If Function FormatSQL(strChar) if strChar="" then FormatSQL="" else FormatSQL=replace(replace(replace(replace(replace(replace(replace(replace(strChar,"'","’"),"*","×"),"?","？"),"(","（"),")","）"),"<","〈"),"$","。"),";","；") end if End Function Function SafeRequest(ParaName,ParaType) Dim ParaValue ParaValue=Request(ParaName) If ParaType=1 then If not isNumeric(ParaValue) then Response.write "参数" & ParaName & "必须为数字型！" Response.end End if Else ParaValue=replace(ParaValue,"'","''") End if SafeRequest=ParaValue End function strVersion = "PANTONE 色卡中国总代理" Sub EnumTypeInfo (TableName) sql = "Select ID, tName From " & TableName & " Order by ID" Response.Write "" & vbCrLF Response.Write " 请选择" & vbCrLF Set objTemp = Conn.Execute (sql) IF Not objTemp.Eof Then Do while not objTemp.Eof Response.Write "" & objTemp (1) objTemp.MoveNext Loop End If objTemp.Close Set objTemp = Nothing Response.Write "" & vbCrLF End Sub sub Enumtppselect (strtpp) Response.Write "" Response.Write "--Pleast select--" sql = "Select ID, tName From tPp" Set objTemp = Conn.Execute (sql) Do while not objTemp.Eof if strtpp=objtemp(0) then Response.Write "" & objTemp (1) else Response.Write "" & objTemp (1) end if objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" End Sub Sub GetdTypeName (strTypeway) sql = "Select * from Adesigner where classid = " & strTypeway & "" Set objTemp1 = Conn.Execute (sql) response.write objtemp1("class") objTemp1.Close Set objTemp1 = Nothing End Sub '显示推荐的品牌 Sub Writeproductpp () sql = "Select * From tpp where iview=1 Order By pporder" Set objTemp = Conn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof If i <> 0 and i mod 2 = 0 Then Response.Write "" End If 'Response.write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "

" 'Response.Write " 4" 'Response.Write "	" if objtemp("id")=47 then response.write " 4 " & objTemp ("tName") & " " else response.write " 4 " & objTemp ("tName") & " " end if Response.write "

" End Sub '显示商品的类别 Sub Writetcoatcatalog (id) sql = "Select * From sorts where categoryid = " & id & " and first=0 Order By sortsID" 'response.write sql Set objTemp = Conn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof If i <> 0 and i mod 1 = 0 Then Response.Write "" End If Response.write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "

4" Response.Write "	" & objTemp ("sorts") & "

" End Sub ' ================================== ' 获取人气排行榜 ' Sub Listclickproduct () 'sql = "Select Top 10 * from tproduct where mdel=0 and show=0 order by id DESC" sql = "Select Top 10 * from tproduct where mdel=0 and show=0 order by mclickcount DESC" Set objTemp = Conn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("tproduct") If Len (str) > 14 Then str = Left (objTemp ("tproduct"), 14) End If Response.Write "" Response.Write "" i = i + 1 if i>=10 then exit do objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "

" & str & "..

" End Sub '显示首页推荐的商品 Sub listtjproduct () sql = "Select tp.id,tp.tproduct,tp.tproduct_bh,tp.tpricenet,tp.tprice1,tp.tprice2,tp.tprice3,tp.tprice4 From tproduct tp,tproduct_tj tj where tp.tproduct_bh=tj.tproduct_bh and tp.mDel = 0 and tp.show=0 and tj.ptype=1 Order by tj.porder DESC" Set objTemp1 = Server.CreateObject ("ADODB.Recordset") objTemp1.MaxRecords = 50 objTemp1.Open sql, Conn, 1, 1 str = "" Response.Write "" Response.Write "" i=0 Do While not objTemp1.Eof If i <> 0 and i mod 5= 0 Then Response.Write "" End If str = objTemp1 (1) If Len (str) > 12 Then str = Left (objTemp1 (1), 12) End If if request.cookies("timesshop")("vip")<>"" then if request.cookies("timesshop")("vip")=0 then strcontent="会员价格:" iprice=objtemp1(3) elseif request.cookies("timesshop")("vip")=1 then strcontent="一钻会员价格:" iprice=objtemp1(4) elseif request.cookies("timesshop")("vip")=2 then strcontent="二钻会员价格:" iprice=objtemp1(5) elseif request.cookies("timesshop")("vip")=3 then strcontent="三钻会员价格:" iprice=objtemp1(6) elseif request.cookies("timesshop")("vip")=4 then strcontent="四钻会员价格:" iprice=objtemp1(7) end if else strcontent="会员价格:" iprice=objtemp1(3) end if iproduct_bh=objtemp1(2) Response.Write "" 'Response.Write "" i = i + 1 objTemp1.MoveNext Loop objTemp1.Close Response.Write "" Set objTemp1 = Nothing Response.Write "

" Response.write " "&str&".. "& strcontent&"￥"&iprice&"

" End Sub '显示首页推荐的商品 Sub listbuy () sql = "Select tp.id,tp.tproduct,tp.tproduct_bh,tp.tpricenet,tp.tprice1,tp.tprice2,tp.tprice3,tp.tprice4 From tproduct tp,tproduct_tj tj where tp.tproduct_bh=tj.tproduct_bh and tp.mDel = 0 and tp.show=0 and tj.ptype=2 Order by tj.porder DESC" Set objTemp1 = Server.CreateObject ("ADODB.Recordset") objTemp1.MaxRecords = 50 objTemp1.Open sql, Conn, 1, 1 str = "" Response.Write "" Response.Write "" i=0 Do While not objTemp1.Eof If i <> 0 and i mod 2= 0 Then Response.Write "" End If title=objtemp1(1) strcontent="价格:" iprice=objtemp1(5) iproduct_bh=objtemp1(2) Response.Write "" 'Response.Write "" i = i + 1 objTemp1.MoveNext Loop objTemp1.Close Response.Write "" Set objTemp1 = Nothing Response.Write "

" Response.write " "&title&" "& strcontent &"￥"&iprice&"

" End Sub '显示推荐精品 Sub listbuynew () sql = "Select tp.id,tp.tproduct,tp.tproduct_bh,tp.tpricenet,tp.tprice1,tp.tprice2,tp.tprice3,tp.tprice4 From tproduct tp,tproduct_tj tj where tp.tproduct_bh=tj.tproduct_bh and tp.mDel = 0 and tp.show=0 and tj.ptype=3 Order by tj.porder DESC" Set objTemp = Server.CreateObject ("ADODB.Recordset") objTemp.MaxRecords = 60 objTemp.Open sql, Conn, 1, 1 str = "" Response.Write "" Response.Write "" i=0 Do While not objTemp.Eof If i <> 0 and i mod 2= 0 Then Response.Write "" End If title=objtemp(1) strcontent="价格:" iprice=objtemp(5) iproduct_bh=objtemp(2) Response.Write "" 'Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Response.Write "" Set objTemp = Nothing Response.Write "

" Response.write "   "&title&" "& strcontent &" ￥"&iprice&"

" End Sub ' 列举商品类别 例示： Sub EnumbuyType (aclassid) sql = "Select sortsid,sorts From sorts where categoryid="& aclassid &" Order by sortsorder" Response.Write "" & vbCrLF Response.Write " 商品类别" & vbCrLF Set objTemp = Conn.Execute (sql) IF Not objTemp.Eof Then Do while not objTemp.Eof Response.Write "" & objTemp (1) objTemp.MoveNext Loop End If objTemp.Close Set objTemp = Nothing Response.Write "" & vbCrLF End Sub '显示指定类别商品-推荐 Sub listbuycatalogtj (catalogid) sql = "Select top 2 * From tproduct where mDel = 0 and aclassid= "& catalogid &" and recommend=1 and show=0 Order by id DESC" Set objTemp = Server.CreateObject ("ADODB.Recordset") 'Set objTemp = Conn.Execute (sql) objTemp.MaxRecords = 2 'response.write sql objTemp.Open sql,Conn, 1, 1 str = "" Response.Write "" Response.Write "" i=0 Do While not objTemp.Eof If i <> 0 and i mod 1= 0 Then Response.Write "" End If title=objtemp("tproduct") mprice=objtemp("tprice") iprice=objtemp("tpricenet") iproduct_bh=objtemp("tproduct_bh") Response.Write "" 'Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Response.Write "" Set objTemp = Nothing Response.Write "

" Response.write "会员价格： ￥"&iprice&"

" End Sub Sub listbuycatalog (catalogid) sql = "Select top 6 * From tproduct where mDel = 0 and aclassid= "& catalogid &" Order by id DESC" Set objTemp = Server.CreateObject ("ADODB.Recordset") objTemp.MaxRecords = 6 objTemp.Open sql, Conn, 1, 1 str = "" Response.Write "" Response.Write "" i=0 Do While not objTemp.Eof If i <> 0 and i mod 3= 0 Then Response.Write "" End If title=objtemp("tproduct") mprice=objtemp("tprice") iprice=objtemp("tpricenet") iproduct_bh=objtemp("tproduct_bh") Response.Write "" 'Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Response.Write "" Set objTemp = Nothing Response.Write "

" Response.write "会员价格： "&iprice&"￥

" End Sub ' ================================== ' 获取各类别商品的前几名 ' Sub Listnewproduct (aclass) sql = "Select Top 5 * from tproduct where mdel=0 and aclassid="& aclass &" order by id DESC" Set objTemp = Conn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("tproduct") If Len (str) > 14 Then str = Left (objTemp ("tproduct"), 14) End If Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "

" & str & "...

" End Sub '获取小类别名称 Sub GetCatalog (CatalogID) sql = "Select * From sorts where sortsid=" & CatalogID & "" Set objTemp4 = Conn.Execute (sql) shengfen1=objtemp4("sorts") response.write shengfen1 objTemp4.Close Set objTemp4 = Nothing End Sub '获取大类别名称 Sub GetTypeName (strTypeway) sql = "Select * from category where categoryid = " & strTypeway & "" Set objTemp1 = Conn.Execute (sql) response.write objtemp1("category") objTemp1.Close Set objTemp1 = Nothing End Sub '显示大类别下的小类别 Sub WriteproductCatalog (id) if id="" then response.write "未指定类别" else sql = "Select * From sorts where categoryid = " & id & " and first=0 Order By sortsID" Set objTemp = Conn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof If i <> 0 and i mod 4 = 0 Then Response.Write "" End If Response.write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "

" Response.Write "" Response.Write "	" & objTemp ("sorts") & " " Response.write "

" end if End Sub ' 获得汽车的称呼 Function Getdesigner (designerid) If designerid <> "" Then sql = "select sname,sid From small where sID = " & designerid & "" Set objTemp = Conn.Execute (sql) IF Not objTemp.Eof Then GetppName1 = objTemp (0) Getsid=objtemp (1) Else GetppName1 = "" End If response.write ""& getppname1 &" " response.write "
" objTemp.Close Set objTemp = Nothing Else GetppName1 = "" End If End Function ' 获得品牌的名字 Function GetppName (tppid) If tppID <> 0 Then sql = "select tName From tPp where ID = " & tppID & "" Set objTemp = Conn.Execute (sql) IF Not objTemp.Eof Then GetppName1 = objTemp (0) Else GetppName1 = "" End If response.write getppname1 objTemp.Close Set objTemp = Nothing Else GetppName1 = "" End If End Function '获取品牌名称 Sub GetPpid (tppid) sql = "Select * From tpp where id=" & tppid & "" Set objTemp3 = Conn.Execute (sql) If not objTemp3.Eof Then shengfen=objtemp3("tname") else shengfen="nothing" end if response.write shengfen objTemp3.Close Set objTemp3 = Nothing End Sub ' 列出类别目录 Sub EnumCatalog () sql = "Select categoryid, category from category order by categoryid" Set objTemp = Conn.Execute (sql) Response.Write "" & vbCrLf Response.Write "--请选择类别--" & vbCrLF If not objTemp.Eof Then Do while Not objTemp.Eof Response.Write "" & objTemp (1) & vbCrLF objTemp.MoveNext Loop End If Response.Write "" objTemp.Close Set objTemp = Nothing End Sub ' 列出品牌 Sub Enumpp () sql = "Select id, tname from tpp order by id" Set objTemp = Conn.Execute (sql) Response.Write "" & vbCrLf Response.Write "--请选择品牌--" & vbCrLF If not objTemp.Eof Then Do while Not objTemp.Eof Response.Write "" & objTemp (1) & vbCrLF objTemp.MoveNext Loop End If Response.Write "" objTemp.Close Set objTemp = Nothing End Sub ' '---------------------- Sub SendMail (name,mailto, mailfrom, subject, content) Set JMail = Server.CreateObject ("JMail.SMTPMail") JMail.Lazysend = True JMail.MailDomain = "211.100.8.162" JMail.Charset = "gb2312" JMail.ContentType ="text/html" JMail.Sender = mailfrom '"service@cars51.cn" JMail.SenderName = "Cars51" JMail.ReplyTo = "service@cars51.cn" 'JMail.ReturnReceipt = True JMail.Subject = Subject JMail.ClearRecipients () JMail.AddRecipient mailto JMail.AddRecipientBCC "service@cars51.cn" JMail.Body = content 'JMail.Subject = subject JMail.Priority = 1 JMail.AddHeader "Originating-IP", Request.ServerVariables ("Remote_Addr") JMail.Execute () ' 发送Email JMail.Close () Set JMail = Nothing End Sub %>