<% '列表显示产品大全 例示：照明行业目录 Sub WriteproductCatalog (id) if id="" then response.write "未指定类别" else sql = "Select * From tCoatCatalog where dTypeWay = " & id & " Order By CatalogID" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof If i <> 0 and i mod 5 = 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 ("tCatalogName") & "

" end if End Sub '获取大类别产品的总数 Sub GetCataloglamp (CatalogID) sql = "Select * From tcoatcatalog where catalogid=" & CatalogID & "" Set objTemp4 = objConn.Execute (sql) shengfen1=objtemp4("tcatalogname") response.write shengfen1 objTemp4.Close Set objTemp4 = Nothing End Sub Sub GetTypeNamelamp (strTypeway) if strtypeway="" then response.write "未选择类别" else sql = "Select * from Aclass where classid = " & strTypeway & "" Set objTemp1 = objConn.Execute (sql) response.write objtemp1("class") objTemp1.Close Set objTemp1 = Nothing end if End Sub ' 获得供求信息的类型 Function GettradeleadsType (intinfo) If intinfo = 1 Then GettradeleadsType = "【求购】" ElseIf intinfo = 0 Then GettradeleadsType = "【供应】" ElseIf intinfo = 2 Then GettradeleadsType = "【合作】" ElseIf intinfo = 3 Then GettradeleadsType = "【代理】" ElseIf intinfo = 5 Then GettradeleadsType = "调控设备类" end if End Function Sub total_count (id) sql="select Count (*) as total_count from tinfobank where aclassid= " & id & "" Set objTemp = objConn.Execute (sql) strtotal_count = objtemp(0) response.write strtotal_count objTemp.Close Set objTemp = Nothing End Sub '获取小类别的总数 Sub total_count1 (id) sql="select Count (*) as total_count from tinfobank where ancatalogid= " & id & "" Set objTemp = objConn.Execute (sql) strtotal_count1 = objtemp(0) response.write strtotal_count1 objTemp.Close Set objTemp = Nothing End Sub '获取公司ID Function GetCompanyID (ID) sql = "Select c.Companyid From tUser u, tCompany c where u.CompanyID = c.CompanyID and u.tUsername = '" & ID & "'" Set objUser = objConn.Execute (sql) If Not objUser.Eof Then GetCompanyID = objUser ("CompanyID") End If objUser.CLose Set objUser = Nothing End Function '格式化字符 Function GetLeftStrshop (str) If str = "" Then GetLeftStrshop = "" Else If Len (str) > 82 Then str = Left (str,80) & "..." End If GetLeftStrshop = str End If End Function Function ReplaceStr (str) If str = "" Then ReplaceStr = "" Else If Instr (str, "|" ) <> 0 Then arrStr = Split (str, "|") tmp = "" For i = 0 To Ubound (arrStr) If tmp = "" Then tmp = "产品名称" & (i+1) & ":  " & arrStr (i) & "    " Else tmp = tmp & " " & "产品名称" & (i+1) & ":  " & arrStr (i) & "    " End If Next Else tmp = str End If ReplaceStr = tmp End If End Function Function FormatStr (str) If str = "" Then FormatStr = "" Else FormatStr = Replace (str, "|", "
") End IF End Function ' ================================== ' 根据类别获得新闻列表 例示新闻中心：index.asp ' Sub ListNewsInfoByType (strType) sql = "Select Top 8 * from tUserNews n, tUserNewsType t where n.mPublish = 1 and n.mDel = 0 and t.tName = '" & strType & "'and t.ID = n.NewsTypeID and n.webtype=2 order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("tTitle") If Len (str) > 18 Then str = Left (objTemp ("tTitle"), 15) End If if objtemp("fpath")<>"" and objtemp("fname")<>"" then Response.Write "" else Response.Write "" end if Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

·  " & str & " (" & FormatTime (objTemp ("dCreateDate")) &")	·  " & str & " (" & FormatTime (objTemp ("dCreateDate")) &")
" Response.Write " 更多" & strType & "...

" End Sub ' ================================== ' 根据关键词显示订购关键词广告的企业 ' Sub Listkeyword (keyword) if keyword<>"" then sql = "Select Top 8 * from tcompany where musertype = 2 and mDel = 0 and (tcompany like '%" & keyword & "%' or keyword like '%" & keyword & "%') and webtype=2 order by companyid DESC" else sql = "Select * from tcompany where musertype = 2 and mDel = 0 and webtype=2 order by companyid DESC" end if Set objTemp = objConn.Execute (sql) i = 0 Do While not objTemp.Eof Response.Write "" Response.Write "" str = objTemp ("tcompany") strcompany = objTemp ("tcompanyintro") If Len (strcompany) > 100 Then strcompany = Left (objTemp ("tcompanyintro"), 100) End If Response.Write "" Response.Write "" Response.Write "" Response.Write "

" & str & "

" Response.Write " " & strcompany & "...

" response.write "
" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing End Sub ' ================================== ' 根据类别获得新闻列表 例示首页新闻中心：index.asp ' Sub ListNewsInfoByType1 (strType) sql = "Select Top 6 * from tUserNews n, tUserNewsType t where n.mPublish = 1 and n.mDel = 0 and t.tName = '" & strType & "'and t.ID = n.NewsTypeID and n.webtype=2 order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("tTitle") If Len (str) > 17 Then str = Left (objTemp ("tTitle"), 17) End If if objtemp("fpath")<>"" and objtemp("fname")<>"" then Response.Write "" else Response.Write "" end if Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

·  " & str & "	·  " & str & "
" Response.Write " 更多" & strType & "...

" End Sub Sub ListNewsInfoByType2 (strType) sql = "Select Top 10 * from tUserNews n, tUserNewsType t where n.mPublish = 1 and n.mDel = 0 and t.tName = '" & strType & "'and t.ID = n.NewsTypeID and n.webtype=2 order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("tTitle") If Len (str) > 17 Then str = Left (objTemp ("tTitle"), 17) End If if objtemp("fpath")<>"" and objtemp("fname")<>"" then Response.Write "" else Response.Write "" end if Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing 'Response.Write "" Response.Write "

·  " & str & "	·  " & str & "
" 'Response.Write " 更多" & strType & "...

" End Sub ' ================================= ' 列出新闻信息内容 例示：前后页面 ' Sub ListNewsInfo () sql = "Select Top 7 * from tUserNews where mPublish = 1 and mDel = 0 and webtype=2 order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" Response.write "" str = Left (objTemp ("tTitle"), 16) if objtemp("fpath")<>"" and objtemp("fname")<>"" then Response.Write "" else Response.Write "" end if Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write " " Response.Write "	·  " & str & " (" & FormatTime (objTemp ("dCreateDate")) &")	·  " & str & " (" & FormatTime (objTemp ("dCreateDate")) &")
>>发布新闻...        " Response.Write "    >>更多新闻...

" End Sub ' 显示最新供求信息 Sub ListnewbuyInfo (ID) If IsNumeric (ID) Then sql = "Select Top 10 * From tInfoBank where mDel = 0 and mPublish = 1 and dInfoUse = " & ID & " and webtype=2 order by dCreateDate DESC " Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" Response.Write "" strdate= formattime(objtemp("dcreatedate")) str2 = objTemp ("tinfotitle") str1=objtemp("tproductname") if str2<>"" then str=str2 else str=str1 end if If Len (str) > 8 Then str = Left (str, 8) End if Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "

" if id=0 then Response.Write "[供应]" end if if id=1 then Response.Write "[求购]" end if if id=2 then Response.Write "[合作]" end if if id=3 then Response.Write "[代理]" end if response.write "

" if objTemp("dInfoUse")="0" then ' Response.write "[供]" Response.write "" & str & " " elseif ObjTemp("dinfouse")="1" Then 'Response.write "[求]" Response.write "" & str & " " elseif objtemp("dinfouse")="2" then Response.write "" & str & " " elseif objtemp("dinfouse")="3" then Response.write "" & str & " " end if Response.write "

" End If End Sub '最新展会信息 Sub MarqueeShowzh () sql = "Select Top 9 * From tCoatShow where mDel = 0 and webtype=2 order by ShowID DESC" Set objTemp = objConn.Execute (sql) ' i = 0 Response.Write "" Do While not objTemp.Eof str=left(objTemp ("tShowName"),16) Response.Write "" Response.write "" Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write "" Response.Write "	" & str & "..
" Response.Write "    >>更多...

" End Sub '最新推荐展会信息 Sub MarqueeShowtjzh () sql = "Select Top 9 * From tCoatShow where mDel = 0 and mintro=1 and webtype=2 order by ShowID DESC" Set objTemp = objConn.Execute (sql) ' i = 0 Response.Write "" Do While not objTemp.Eof str=objTemp ("tShowName") Response.Write "" Response.write "" Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write "" Response.Write "	" & str & "..
" Response.Write "    >>更多...

" End Sub '最新供求信息 Sub newsinfobank () sql = "Select Top 10 * From tinfobank where mDel = 0 order by infoID DESC" Set objTemp = objConn.Execute (sql) ' i = 0 Response.Write "" Do While not objTemp.Eof str=left(objTemp ("tproductname"),20) intinfotype= objtemp("dinfouse") Response.Write "" Response.write "" Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write "" Response.Write "	"& GetinfobankType(intinfotype) & "  " & str & "..
" Response.Write "    >>更多...

" End Sub ' 获得信息类型 Function GetinfobankType (intinfotype) If intinfotype = 0 Then GetinfobankType = "国内供应" ElseIf intinfotype = 1 Then GetinfobankType = "国内采购" ElseIf intinfotype = 2 Then GetinfobankType = "合作信息" ElseIf intinfotype = 3 Then GetinfobankType = "代理信息" ElseIf intinfotype = 4 Then GetinfobankType = "国际采购" ElseIf intinfotype = 5 Then GetinfobankType = "国际供应" End If End Function ' 获得用户VIP等级 Function GetUservip (ID) If IsNumeric (ID) and ID >= 0 Then sql1 = "Select * From tUser where webtype=2 and UserID = " & CInt (ID) & "" 'Response.Write sql1 Set objUser = objConn.Execute (sql1) mvip = objUser ("mvip") if mvip=1 then GetUservip="准VIP" elseif mvip=0 then GetUservip="免费会员" elseif mvip=2 then GetUservip="VIP会员" end if objUser.Close Set objUser = Nothing End If End Function ' 获得用户公司ID Function GetUsercompanyid (ID) If IsNumeric (ID) and ID >= 0 Then sql1 = "Select * From tUser tu,tcompany tc where tu.companyid = tc.companyid and tu.UserID = " & CInt (ID) & "" 'Response.Write sql1 Set objUser = objConn.Execute (sql1) If not objUser.Eof Then GetUsercompanyid = objUser ("companyid") Else GetUsercompanyid = 0 End If objUser.Close Set objUser = Nothing End If End Function ' 原料助剂供应商 Sub listcompany () 'sql = "Select Distinct c.CompanyID, c.tCompany From tProduct p, tCompany c" 'sql = sql & " where c.CompanyID = p.CompanyID and p.mPublish = 1 and p.mDel = 0 order by c.CompanyID DESC" sql = "Select * From tCompany where mDel = 0 and musertype>0 and webtype=2 order by musertype desc,companyid desc" Set objTemp = Server.CreateObject ("ADODB.Recordset") objTemp.MaxRecords = 10 objTemp.Open sql, objConn, 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 Response.write "" str = objTemp ("tcompany") If Len (str) > 16 Then str = Left (objTemp ("tcompany"), 25) End If Response.Write "" 'Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Response.Write "" Set objTemp = Nothing 'Response.Write "" Response.Write "

" Response.Write "·" Response.Write "	" & objTemp ("tCompany") & "
" 'Response.Write "    >>更多...

" End Sub ' 推荐企业 Sub listtjcompany () 'sql = "Select Distinct c.CompanyID, c.tCompany From tProduct p, tCompany c" 'sql = sql & " where c.CompanyID = p.CompanyID and p.mPublish = 1 and p.mDel = 0 order by c.CompanyID DESC" sql = "Select * From ttjcompany where tjdel = 0 order by id desc" Set objTemp = Server.CreateObject ("ADODB.Recordset") objTemp.MaxRecords = 10 objTemp.Open sql, objConn, 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 Response.write "" Response.Write "" 'Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Response.Write "" Set objTemp = Nothing 'Response.Write "" Response.Write "

" Response.Write "·" Response.Write "	" & objTemp ("tjCompany") & "
" 'Response.Write "    >>更多...

" End Sub ' 原料助剂供应商 Sub listshop () 'sql = "Select Distinct c.CompanyID, c.tCompany From tProduct p, tCompany c" 'sql = sql & " where c.CompanyID = p.CompanyID and p.mPublish = 1 and p.mDel = 0 order by c.CompanyID DESC" sql = "Select top 4 * From tshop where mDel = 0 and mPublish = 1 and tj=1 and webtype =2 Order by dCreateDate DESC" Set objTemp = Server.CreateObject ("ADODB.Recordset") objTemp.MaxRecords = 6 objTemp.Open sql, objConn, 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 shopsize=objtemp("shopsize") if shopsize=1 then img = objtemp("img") elseif shopsize=0 then img="/photo/shopmode.jpg" end if shopname=objtemp("tshopname") Response.Write "" 'Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Response.Write "" Set objTemp = Nothing 'Response.Write "" Response.Write "

" Response.write "    "&shopname&"

" 'Response.Write "    >>更多...

" End Sub ' 原料助剂供应商 Sub listshop1 () 'sql = "Select Distinct c.CompanyID, c.tCompany From tProduct p, tCompany c" 'sql = sql & " where c.CompanyID = p.CompanyID and p.mPublish = 1 and p.mDel = 0 order by c.CompanyID DESC" sql = "Select top 4 * From tshop where mDel = 0 and mPublish = 1 and tj=1 and webtype =2 Order by dCreateDate DESC" Set objTemp = Server.CreateObject ("ADODB.Recordset") objTemp.MaxRecords = 8 objTemp.Open sql, objConn, 1, 1 str = "" Response.Write "" Response.Write "" i=0 Do While not objTemp.Eof If i <> 0 and i mod 4= 0 Then Response.Write "" End If shopsize=objtemp("shopsize") if shopsize=1 then img = objtemp("img") elseif shopsize=0 then img="/photo/shopmode.jpg" end if shopname=objtemp("tshopname") Response.Write "" 'Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Response.Write "" Set objTemp = Nothing 'Response.Write "" Response.Write "

" Response.write "    "&shopname&"

" 'Response.Write "    >>更多...

" End Sub ' 列举技术资料类型信息 例示： Sub EnumtechTypeInfo () sql = "Select ID, tName From ttechType Order by ID" Response.Write "" & vbCrLF Response.Write " 全部类型" & vbCrLF Set objTemp = objConn.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 ListtechInfoByType (strType) sql = "Select Top 6 * from ttech n, ttechType t where n.mPublish = 1 and n.mDel = 0 and t.tName = '" & strType & "'and t.ID = n.NewsTypeID order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("tTitle") 'If Len (str) > 16 Then ' str = Left (objTemp ("tTitle"), 16) 'End If Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

·  " & str & " (" & FormatTime (objTemp ("dCreateDate")) &")

" Response.Write " 更多" & strType & "...

" End Sub ' ================================== ' 根据类别获得技术资料列表 ' Sub ListtechInfoByType1 (strType) sql = "Select Top 9 * from ttech n, ttechType t where n.mPublish = 1 and n.mDel = 0 and t.tName = '" & strType & "'and t.ID = n.NewsTypeID order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("tTitle") 'If Len (str) > 16 Then ' str = Left (objTemp ("tTitle"), 20) 'End If Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

·  " & str & "

" Response.Write " 更多" & strType & "...

" End Sub Sub ListtechInfoByType2 (strType) sql = "Select Top 9 * from ttech n, ttechType t where n.mPublish = 1 and n.mDel = 0 and t.tName = '" & strType & "'and t.ID = n.NewsTypeID order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("tTitle") 'If Len (str) > 16 Then ' str = Left (objTemp ("tTitle"), 20) 'End If Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" & str & "

" Response.Write " 更多" & strType & "...

" End Sub '环球照明网 function now_date() '日期函数 now_date=year(now()) & "-" & right("0" & month(now()),2) & "-" & right("0" & day(now()),2) end function function now_time() '时间函数 now_time=year(now()) & "-" & right("0" & month(now()),2)& "-" & right("0" & day(now()),2) & " " & right("0" & hour(now()),2) & ":" & right("0" & minute(now()),2) end function Function strRnd(intLen) '生成随机字符串 dim num,yourpass yourpass="" Randomize Do While Len(yourpass)0 then dist=trim(str) dist=replace(dist,"'","''") else dist="" end if save=dist end function function view(str) '过滤Html函数(不换行) dim dist if len(str)>0 then dist=trim(str) dist=replace(dist,"<","<") dist=replace(dist,">",">") dist=replace(dist,chr(10)," ") dist=replace(dist,chr(13)," ") dist=replace(dist,vbcrlf," ") else dist="" end if view=dist end function function list(str) '过滤Html函数(换行) dim dist if len(str)>0 then dist=trim(str) dist=replace(dist,"<","<") dist=replace(dist,">",">") dist=replace(dist,chr(13) & chr(10),"
") dist=replace(dist,vbcrlf,"
") else dist="" end if list=dist end function function viewjs(str) '当用javascript显示时过滤'<>等特殊字符 不换行 dim dist if len(str)>0 then dist=trim(str) dist=replace(dist,"<","<") dist=replace(dist,">",">") dist=replace(dist,"\","\\") dist=replace(dist,"'","\'") dist=replace(dist,chr(10)," ") dist=replace(dist,chr(13)," ") dist=replace(dist,vbcrlf," ") else dist="" end if viewjs=dist end function function viewjslist(str) '当用javascript显示时过滤'<>等特殊字符 并换行 dim dist if len(str)>0 then dist=trim(str) dist=replace(dist,"<","<") dist=replace(dist,">",">") dist=replace(dist,chr(13) & chr(10),"
") dist=replace(dist,vbcrlf,"
") dist=replace(dist,"\","\\") dist=replace(dist,"'","\'") dist=replace(dist,vbcrlf," ") else dist="" end if viewjslist=dist end function function mylist(str) '不过滤Html函数(换行) dim dist if len(str)>0 then dist=trim(str) if instr(dist,"")<1 then dist=replace(dist,chr(13) & chr(10),"
") dist=replace(dist,vbcrlf,"
") end if else dist="" end if mylist=dist end function Function leftlm(strString,pos) '判断字符串长度函数 dim iLen,j,i,strone iLen = Len(strString) j=0 For i = 1 To iLen strOne = Mid(strString, i, 1) If Asc(strOne) < 0 Then j=j+2 else j=j+1 end if if cint(j)=cint(pos) then leftlm=left(strString,i) exit function end if if cint(j)>cint(pos) then leftlm=left(strString,i-1) exit function end if next if j<=pos then leftlm=strString end if End function Function length(strString) '判断字符串长度 dim iLen,j,i iLen = Len(strString) j=0 For i = 1 To iLen strOne = Mid(strString, i, 1) If Asc(strOne) < 0 Then j=j+2 else j=j+1 end if next Length=j End function function isnum(curpage) '判断是否数字 dim strtest dim i dim isRight strtest="0123456789" isRight=true if curpage<>"" then for i=1 to len(curpage) if instr(strtest,mid(curpage,i,1))<1 then isRight=false end if next else isRight=false end if isnum=isright end function ' 获得公司的类型 Function GetMainType (intjingyin) If strtjingyin = 1 Then GetMainType = "电光源类" ElseIf strtjingyin = 2 Then GetMainType = "灯具/灯饰类" ElseIf strtjingyin = 3 Then GetMainType = "零配件类" ElseIf strtjingyin = 4 Then GetMainType = "专用材料类" ElseIf strtjingyin = 5 Then GetMainType = "调控设备类" ElseIf strtjingyin = 6 Then GetMainType = "其它类" End If End Function Sub Getbigcatalog (BigCatalogID) sql = "Select * From aclass where classid=" & BigCatalogID & "" Set objTemp3 = objConn.Execute (sql) If not objTemp3.Eof Then shengfen=objtemp3("class") else shengfen="nothing" end if response.write shengfen objTemp3.Close Set objTemp3 = Nothing Response.Write "" End Sub Sub GetCatalog (CatalogID) sql = "Select * From tcoatcatalog where catalogid=" & CatalogID & "" Set objTemp4 = objConn.Execute (sql) shengfen1=objtemp4("tcatalogname") response.write shengfen1 objTemp4.Close Set objTemp4 = Nothing End Sub '显示省份信息 Sub GetProvinceid (intprovinceid) sql = "Select * From tprovince where id=" & intprovinceid & "" Set objTemp3 = objConn.Execute (sql) If not objTemp3.Eof Then shengfen=objtemp3("tname") else shengfen="nothing" end if response.write shengfen objTemp3.Close Set objTemp3 = Nothing Response.Write "" End Sub Sub EnumCountryselect (strprovinceid) Response.Write "" Response.Write "--Pleast select--" sql = "Select ID, tName From tProvince" Set objTemp = objConn.Execute (sql) Do while not objTemp.Eof if strprovinceid=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 Function GetUserIDByName (str) sql = "Select * from tUser where sUserName = '" & Replace (str, "'", "''") & "'" Set objUser = objConn.Execute (sql) If not objUser.Eof Then GetUserIDByName = objUser ("UserID") Else GetUserIDByName = 0 End If objUser.close () Set objUser = Nothing End Function ' 根据小类别获得大类别 例示: managerindex/catalog.asp ' Sub GetbmTypeName (strTypeway) sql = "Select * from Aclassjc where classid = " & strTypeway & "" Set objTemp1 = objConn.Execute (sql) response.write objtemp1("class") objTemp1.Close Set objTemp1 = Nothing End Sub Sub GetTypeName (strTypeway) sql = "Select * from Aclass where classid = " & strTypeway & "" Set objTemp1 = objConn.Execute (sql) response.write objtemp1("class") objTemp1.Close Set objTemp1 = Nothing End Sub ' 列出小类别目录 例示: managerindex/addcatalog.asp Sub EnumCatalog () sql = "Select classid, class from Aclass order by classid" Set objTemp = objConn.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 ' 列出小类别目录 例示: managerindex/addcatalog.asp Sub EnumbmCatalog () sql = "Select classid, class from Aclassjc order by classid" Set objTemp = objConn.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 '列出被选择的大类 例示:modcatalog.asp Sub SelCatalogmod (id) Response.Write "" Response.Write "--请选择--" sql = "Select classID, class From aclass" Set objTemp = objConn.Execute (sql) Do while not objTemp.Eof If id = 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 '列出被选择的大类 例示:modcatalog.asp Sub SelbmCatalogmod (id) Response.Write "" Response.Write "--请选择--" sql = "Select classID, class From aclassjc" Set objTemp = objConn.Execute (sql) Do while not objTemp.Eof If id = 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 ' 增加产品 例示:modPorduct.asp Sub InsertProduct (sql) If Len (sql) > 0 Then Response.Write sql 'Resposne.End objConn.Execute (sql) If Err.number <> 0 Then Response.Write "数据库正忙, 请稍候再试!" Response.End End IF End If End Sub '后台函数 '列表显示产品大全 例示：首页产品大全 Sub WritenewCatalog (id) sql = "Select * From tCoatCatalog where dTypeWay = " & id & " Order By CatalogID" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof If i <> 0 and i mod 3 = 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 ("tCatalogName") & "

" End Sub ' ================================= ' 列出商务中心的新闻 例示：User/index.asp ' Sub ListuserNewsInfo () sql = "Select Top 10 * from tUserNews where mPublish = 1 and mDel = 0 order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" Response.write "" str = Left (objTemp ("tTitle"), 16) Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write " " Response.Write "	" & str & "(" & FormatTime (objTemp ("dCreateDate")) &")
>>发布新闻...        " Response.Write "    >>更多新闻...

" End Sub ' ===================================================================== ' 以下是省份信息的管理部分 ' 显示省份信息 ' Sub EnumProvince () Response.Write "" Response.Write "--请选择省份--" sql = "Select ID, tName From tProvince" Set objTemp = objConn.Execute (sql) Do while not objTemp.Eof Response.Write "" & objTemp (1) objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" End Sub ' ================================== ' 根据UserName 获得用户ID 例示：user/man_info.asp Function GetUserIDByName (str) sql = "Select * from tUser where tUserName = '" & Replace (str, "'", "''") & "'" Set objUser = objConn.Execute (sql) If not objUser.Eof Then GetUserIDByName = objUser ("UserID") Else GetUserIDByName = 0 End If objUser.close () Set objUser = Nothing End Function ' ================================================ ' 检验用户操作权限 例示：user/add_info.asp ' Sub CheckLoginUser (str) If str = "" Then Response.Write "您没有继续操作的权限，请重新登录" Response.End End If End Sub ' 列举所有的类型信息 时间：4-10 例示程序：user/addinfocorp.asp Sub EnumTypeInfo (TableName) sql = "Select ID, tName From " & TableName & " Order by ID" Response.Write "" & vbCrLF Response.Write " 请选择" & vbCrLF Set objTemp = objConn.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 ' ============================ ' 获得供求信息的发布公司名称 ' Function GetCompanyNameEx2 (userID) If IsNumeric (userID) Then Dim i_strCompanyNameTmp i_strCompanyNameTmp = "" i_sql_2 = "" i_sql_2 = "Select UserID From tinfobank where userID = " & userID & "" Set objInfo = objConn.Execute (i_sql_2) If not objInfo.Eof Then i_intUserID = objInfo ("UserID") 'i_intSysID = objInfo ("SysID") 'If i_intSysID = 1 Then 'i_strCompanyNameTmp = "中华涂料商务网" 'ElseIf IsNumeric (i_intUserID) and i_intUserID > 0 Then 'i_strCompanyNameTmp = GetCompanyName (i_intUserID) & "(会员单位!)" 'Else 'i_strCompanyNameTmp = objInfo ("TCompanyName") i_strCompanyNameTmp = GetCompanyName (i_intUserID) 'End If End If objInfo.Close Set objInfo = Nothing GetCompanyNameEx2 = i_strCompanyNameTmp End If End Function Function GetCompanyNameEx3 (userID) If IsNumeric (userID) Then Dim i_strCompanyNameTmp i_strCompanyNameTmp = "" i_sql_2 = "" i_sql_2 = "Select c.tcompany From tcompany c,tuser u where c.companyid=u.companyid and userID = " & userID & "" Set objInfo = objConn.Execute (i_sql_2) If not objInfo.Eof Then i_intUserID = objInfo ("tcompany") End If objInfo.Close Set objInfo = Nothing GetCompanyNameEx3 = i_intuserid End If End Function ' 获得公司名称 Function GetCompanyName (ID) If ID = 0 Then GetCompanyName = "环球照明网" Else sql = "Select c.TCompany From tUser u, tCompany c where u.CompanyID = c.CompanyID and u.UserID = " & ID & "" Set objUser = objConn.Execute (sql) If Not objUser.Eof Then GetCompanyName = objUser ("TCompany") End If objUser.CLose Set objUser = Nothing End If End Function Function GetCompanyNameEx4 (companyID) If IsNumeric (companyID) Then Dim i_strCompanyNameTmp i_strCompanyNameTmp = "" i_sql_2 = "" i_sql_2 = "Select tcompany From tcompany where companyid=" & companyID & "" Set objInfo = objConn.Execute (i_sql_2) If not objInfo.Eof Then i_intUserID = objInfo ("tcompany") End If objInfo.Close Set objInfo = Nothing GetCompanyNameEx4 = i_intuserid End If End Function ' ================================== '　获得反馈信息标题 ' Function GetInfoAgainTitle (InfoID, InfoType) If IsNumeric (InfoType) Then Select Case Cint (InfoType) Case 0 sql1 = "select tproductname from tInfoBank where webtype=2 and InfoID = " & Clng (InfoID) & "" Case 1 sql1 = "select tproductname from tInfoBank where webtype=2 and InfoID = " & Clng (InfoID) & "" Case 2 sql1 = "select tproductname from tInfoBank where webtype=2 and InfoID = " & Clng (InfoID) & "" Case 3 sql1 = "select tproductname from tInfoBank where webtype=2 and InfoID = " & Clng (InfoID) & "" Case 4 sql1 = "Select tproductname From tproduct where webtype=2 and productID = " & CLng (InfoID) & "" Case 5 sql1 = "Select ttitle from tusernews where webtype=2 and usernewsID = " & Clng (InfoID) & "" Case 6 sql1 = "Select tshopname from tshop where webtype=2 and shopID = " & Clng (InfoID) & "" Case 7 sql1 = "Select ttitle from ttech where webtype=2 and usernewsID = " & Clng (InfoID) & "" Case 8 sql1 = "Select tshowname from tcoatshow where webtype=2 and showID = " & Clng (InfoID) & "" End Select 'Response.Write sql1 'Response.End If sql1 <> "" Then Set objTitle = objConn.Execute (sql1) If not objTitle.Eof Then 'Response.Write objTitle (0) 'Response.End GetInfoAgainTitle = objTitle(0) Else GetInfoAgainTitle = "" End If objTitle.Close () Set objTitle = Nothing End If Else GetInfoAgainTitle = "" End If End Function ' 列举新闻类型信息 例示：新闻中心index.asp Sub EnumNewsTypeInfo () sql = "Select ID, tName From tUserNewsType Order by ID" Response.Write "" & vbCrLF Response.Write " 全部类型" & vbCrLF Set objTemp = objConn.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 Function FormatSQL (str) FormatSQL = Replace (Trim (str), "'", "''") End Function ' 原料助剂供应商 Sub ListProvider () sql = "Select Distinct c.CompanyID, c.tCompany From tProduct p, tCompany c" sql = sql & " where c.CompanyID = p.CompanyID and p.mPublish = 1 and p.mDel = 0 order by c.CompanyID DESC" Set objTemp = Server.CreateObject ("ADODB.Recordset") objTemp.MaxRecords = 6 objTemp.Open sql, objConn, 1, 1 str = "" Response.Write "" Do While not objTemp.Eof Response.Write "" Response.write "" str = objTemp ("tcompany") If Len (str) > 16 Then str = Left (objTemp ("tcompany"), 16) End If Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write "" Response.Write "	" & objTemp ("tCompany") & "
" Response.Write "    >>更多...

" End Sub '21lightings函数 ' 列表框的类型信息选择 时间：4-10 Sub SelTypeInfo (tableName, ID) sql = "Select ID, tName From " & TableName & " Order by ID" Response.Write "" & vbCrLF Response.Write " 请选择" & vbCrLF Set objTemp = objConn.Execute (sql) IF Not objTemp.Eof Then Do while not objTemp.Eof If objTemp (0) = ID Then Response.Write "" & objTemp (1) Else Response.Write "" & objTemp (1) End If objTemp.MoveNext Loop End If objTemp.Close Set objTemp = Nothing Response.Write "" & vbCrLF End Sub '获取配方类型 Function GetConType (ID) If IsNumeric (ID) And Clng (ID) > 0 Then If ID = 0 Then GetConType = "其他" Else sql = "Select tName From tCoatingConType where ID = " & ID & "" Set objTemp1 = objConn.Execute (sql) If not objTemp1.Eof Then GetConType = objTemp1 (0) Else GetConType = "其他" End If objTemp1.Close Set objTemp1 = Nothing End If End If End Function '获得配方表 Sub GetConTable (ID) If IsNumeric (ID) And ID > 0 Then sql = "Select * from tCoatingConTable where ConID = " & ID & "" Set objTemp1 = objConn.Execute (sql) If Not objTemp1.Eof Then Do while Not objTemp1.Eof Response.Write "质量:" & objTemp1("tMateria") & "-" & "比例" & objTemp1("tQuality") & "
" objTemp1.MoveNext Loop Else Response.Write " " End If objTemp1.Close Set objTemp1 = Nothing Else Response.Write " " End If End Sub ' 一级目录管理 Sub SelCatalog (ID) If IsNumeric (ID) And ID >=1 Then sql = "Select CatalogID, tCatalogName from tCoatCatalog order by dTypeway" Set objTemp = objConn.Execute (sql) Response.Write "" & vbCrLf Response.Write "--请选择--" & vbCrLF If not objTemp.Eof Then Do while Not objTemp.Eof If objTemp (0) = ID Then Response.Write "" & objTemp (1) & vbCrLF Else Response.Write "" & objTemp (1) & vbCrLF End If objTemp.MoveNext Loop End If objTemp.Close Set objTemp = Nothing End If End Sub ' ================================================================== ' 插入信息相关内容 Function InsertInfoPub (Quantity, Price, PayInfo, ExchangeTime, ExecStandard, Detail, UserID, SysID, Company, LinkMan, Phone, Email, Fax, IPAddress) ' ================================ ' 插入产品的连贯信息 ' Dim i_intInfoPubID Set objCmd = Server.CreateObject ("ADODB.Command") objCmd.ActiveConnection = objConn objCmd.CommandType = adCmdStoredProc objCmd.CommandText = "sprAddInfoPub" objCmd.Parameters.Append objCmd.CreateParameter ("Quantity", adVarChar, adParamInput, 50) objCmd.Parameters ("Quantity") = Quantity objCmd.Parameters.Append objCmd.CreateParameter ("Price", adVarChar, adParamInput, 50) objCmd.Parameters ("Price") = Price objCmd.Parameters.Append objCmd.CreateParameter ("PayInfo", adVarChar, adParamInput, 50) objCmd.Parameters ("PayInfo") = PayInfo objCmd.Parameters.Append objCmd.CreateParameter ("ExchangeTime", adVarChar, adParamInput, 50) objCmd.Parameters ("ExchangeTime") = ExchangeTime objCmd.Parameters.Append objCmd.CreateParameter ("ExecStandard", adVarChar, adParamInput, 30) objCmd.Parameters ("ExecStandard") = ExecStandard objCmd.Parameters.Append objCmd.CreateParameter ("Detail", adVarChar, adParamInput, 1000) objCmd.Parameters ("Detail") = Detail objCmd.Parameters.Append objCmd.CreateParameter ("UserID", adInteger, adParamInput) objCmd.Parameters ("UserID") = UserID objCmd.Parameters.Append objCmd.CreateParameter ("SysID", adInteger, adParamInput) objCmd.Parameters ("SysID") = SysID objCmd.Parameters.Append objCmd.CreateParameter ("Company", adVarChar, adParamInput, 255) objCmd.Parameters ("Company") = Company objCmd.Parameters.Append objCmd.CreateParameter ("LinkMan", adVarChar, adParamInput, 255) objCmd.Parameters ("LinkMan") = LinkMan objCmd.Parameters.Append objCmd.CreateParameter ("Phone", adVarChar, adParamInput, 255) objCmd.Parameters ("Phone") = Phone objCmd.Parameters.Append objCmd.CreateParameter ("Email", adVarChar, adParamInput, 255) objCmd.Parameters ("Email") = Email objCmd.Parameters.Append objCmd.CreateParameter ("Fax", adVarChar, adParamInput, 255) objCmd.Parameters ("Fax") = Fax objCmd.Parameters.Append objCmd.CreateParameter ("IPAddress", adVarChar, adParamInput, 255) objCmd.Parameters ("IPAddress") = IPAddress objCmd.Parameters.Append objCmd.CreateParameter ("ID", adInteger,adParamOutput) objCmd.Execute () If objCmd ("ID") <> 0 Then i_intInfoPubID = objCmd ("ID") Else i_intInfoPubID = 0 End If Set objCmd = Nothing InsertInfoPub = i_intInfoPubID End Function ' =================================================================== ' 发表供求信息 Function InsertInfoBank (InfoUse, InfoTitle, InfoSpec, InfoEngTitle, BigCatalog, Catalog, SubCatalog, ProductDesc, InfoPubID, ClickNum, Publish,utype) i_sql_3 = "" i_sql_3 = "Insert Into tInfoBank (dInfoUse, tInfoTitle, tInfoSpec, tInfoEngTitle, dBigCatalogID, dCatalogID, " i_sql_3 = i_sql_3 & " dSubCatalogID, tProductDesc, InfoPubID, dClickNum, mPublish,UserType) Values (" i_sql_3 = i_sql_3 & " " & InfoUse & ", '" & InfoTitle & "', '" & InfoSpec & "', '" & InfoEngTitle & "'," i_sql_3 = i_sql_3 & " " & BigCatalog & ", " & Catalog & ", " & SubCatalog & ", '" & ProductDesc & "', " & InfoPubID & ", " & ClickNum & ", " i_sql_3 = i_sql_3 & " " & Publish & ", " & utype & ")" objConn.Execute (i_sql_3) If Err.number = 0 Then InsertInfoBank = 0 Else InsertInfoBank = Err.number End If End Function ' ================================================ ' 页面转移 Sub TransferUrl (str) If str <> "" Then Response.Write "" End If End Sub ' ========================================================================================== ' 列表显示一级目录 ' Function EnumProductCatalog1 (id) sql = "Select CatalogID, tCatalogName from tCoatCatalog order by dTypeway" Set objTemp = objConn.Execute (sql) i_str = "" i_str = i_str + "--请选择类别--" If not objTemp.Eof Then Do while Not objTemp.Eof i_str = i_str + "" & objTemp (1) objTemp.MoveNext Loop End If i_str = i_str + "" objTemp.Close() Set objTemp = Nothing EnumProductCatalog1 = i_str End Function ' ================================================ ' 更新tblInfoPub Sub UpdateInfoPub (Quantity, EffectDate, Detail, IPAddress, InfoPubID) i_sql = "" i_sql = "Update tInfoPub set tQuantity = '" & Quantity & "', tExchangeTime = '" & EffectDate & "', tDetail = '" & Detail & "'," i_sql = i_sql & " tIPAddress = '" & IPAddress & "' where InfoPubID = " & intInfoPubID & "" objConn.Execute (i_sql) End Sub Sub UpdateInfoPubEx (Quantity, EffectDate, Detail, Company, Linkman, Phone, Email, Fax, IPAddress, InfoPubID) i_sql = "" i_sql = "Update tInfoPub set tQuantity = '" & Quantity & "', tExchangeTime = '" & EffectDate & "', tDetail = '" & Detail & "'," i_sql = i_sql & " tIPAddress = '" & IPAddress & "', tCompanyName = '" & Company & "', tLinkMan = '" & Linkman & "', " i_sql = i_sql & " tPhone = '" & Phone & "', tEmail = '" & Email & "', tFax = '" & Fax & "' where InfoPubID = " & intInfoPubID & "" 'Response.Write i_sql objConn.Execute (i_sql) End Sub ' =================================== ' 根据类别信息选择 Sub SelProductCatalogEx (CatalogID) i_sql = "" i_sql = "Select CatalogID, tCatalogName from tCoatCatalog order by dTypeway" Set i_objTemp = objConn.Execute (i_sql) i_str = "" i_str = i_str + "--请选择类别--" If not i_objTemp.Eof Then Do while Not i_objTemp.Eof If CatalogID = i_objTemp (0) Then i_str = i_str + "" & i_objTemp (1) Else i_str = i_str + "" & i_objTemp (1) End If i_objTemp.MoveNext Loop End If i_str = i_str + "" i_objTemp.Close() Set i_objTemp = Nothing Response.Write i_str End Sub ' ================================== ' 获得反馈信息类型 ' 0 - 表示供求信息 ' 1 - 表示合作信息 ' 2 - 表示展会信息 ' 3 - 表示产品信息 ' 4 - 表示新闻信息 ' 5 - 表示配方信息 ' 6 - other Function GetInfoAgainType (InfoType) If IsNumeric (InfoType) Then Select Case Cint (InfoType) Case 0 ' 供求信息 GetInfoAgainType = "供应信息" Case 1 GetInfoAgainType = "求购信息" Case 2 GetInfoAgainType = "合作信息" Case 3 GetInfoAgainType = "代理信息" Case 4 GetInfoAgainType = "库存产品" Case 5 GetInfoAgainType = "行业资讯" Case 6 GetInfoAgainType = "精品展示" Case 7 GetInfoAgainType = "技术资料" Case 8 GetInfoAgainType = "行业展会" Case Else GetInfoAgainType = "Other" End Select Else GetInfoAgainType = "NULL" End If End Function ' 获得某个省份信息 Function GetProvinceName (nID) If nID <> 0 Then sql = "select tName From tProvince where ID = " & nID & "" Set objTemp = objConn.Execute (sql) IF Not objTemp.Eof Then GetProvinceName = objTemp (0) Else GetProvinceName = "" End If objTemp.Close Set objTemp = Nothing Else GetProvinceName = "" End If End Function ' 获得公司名称 扩展函数 ' ID - 表示信息的ID ' TypeID - 表示类型ID 0 -　供求, 1 - 合作 Function GetCompanyNameEx (ID, TypeID) If CInt (TypeID) = 0 Then ' 供求信息 i_sql = "Select UserID, mNotUser, tReserve from tInfoBank where InfoID = " & ID & "" Else ' 合作信息 i_sql = "Select UserID, mNotUser, tReserve From tInfoCorp where InfoCorpID = " & ID & "" End If Set objInfo = objConn.Execute (i_sql) If not objInfo.Eof Then intUserID = objInfo (0) intNotUser = objInfo(1) strLinkUrl = objInfo (2) If intNotUser = 0 Then ' 会员 GetCompanyNameEx = GetCompanyName (intUserID) Else If Instr (strLinkUrl, "|") <> 0 Then arrValue = Split (strLinkUrl, "|") GetCompanyNameEx = arrValue (UBound (arrValue)) ElseIf Instr (strLinkUrl) = 0 Then GetCompanyNameEx = " " End If End If End If objInfo.Close () Set objInfo = Nothing End Function ' ================================================ ' 更新tblInfoBank ' Sub UpdateInfoBank (InfoTitle, InfoEngTitle,InfoSpec, CatalogID, ProductDesc, InfoID) i_sql = "" i_sql = "Update tInfoBank set tInfoTitle = '" & InfoTitle & "', tInfoEngTitle = '" & InfoEngTitle & "'," i_sql = i_sql & "tInfoSpec = '" & InfoSpec & "', dCatalogID = " & CatalogID & ", tProductDesc = '" & ProductDesc & "'" i_sql = i_sql & " where InfoID = " & InfoID & "" objConn.Execute (i_sql) End Sub '建立合作信息类型 Function GetInfoCorpType (ID) If IsNumeric (ID) And Clng (ID) >= 0 Then If ID = 0 Then GetInfoCorpType = "任何方式" Else sql = "Select tName From tInfoCorpType where ID = " & ID & "" Set objTemp1 = objConn.Execute (sql) If not objTemp1.Eof Then GetInfoCorpType = objTemp1 (0) Else GetInfoCorpType = "" End If objTemp1.Close Set objTemp1 = Nothing End If End If End Function Sub ListCataType (ID, nSort) If IsNumeric (ID) Then sql = "Select * From tCoatCatalog where dTypeway = " & CInt (ID) & "" Set objTemp = objConn.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 If End Sub Sub SelProvinceName (id) Response.Write "" Response.Write "--请选择--" sql = "Select ID, tName From tProvince" Set objTemp = objConn.Execute (sql) Do while not objTemp.Eof If id = 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 SelCataType (ID, nSort, str) If IsNumeric (ID) Then sql = "Select * From tCoatCatalog where dTypeway = " & CInt (ID) & "" Set objTemp = objConn.Execute (sql) Response.Write "" & vbCrLf Response.write "请选择" & vbCrLf If not objTemp.Eof Then Do while Not objTemp.Eof If str = CStr (objTemp (0)) Then Response.Write "--" & objTemp (1) & "--" & vbCrLF Else Response.Write "--" & objTemp (1) & "--" & vbCrLF End If objTemp.MoveNext Loop End If Response.Write "" objTemp.Close Set objTemp = Nothing End If End Sub ' 利用列表表示目录信息 Function GetListCatalogType (ID, str) If Len (str) > 0 Then ' 首先判断是否存在"," If Instr (str, ",") <> 0 Then arrStrValue = split (str, ",") For i = 0 To UBound (arrStrValue) If strProductType = "" Then strProdcutType = DoWithCatalog (arrStrValue (i)) Else strProdcutType = strProductType & "+" & DoWithCatalog (arrStrValue (i)) End If Next Else strProductType = DoWithCatalog (str) End If Else strProductType = "" End If GetListCatalogType = strProductType End Function Function DoWithCatalog (str) If Len (str) > 0 Then iPos = Instr (str, "|") If iPos <> 0 Then iSubCatalogID = CLng(Mid (str, iPos + 1)) sql = "Select tSubCatalogName From tSubCoatCatalog where SubCatalogID = " & iSubCatalogID & "" Set objTemp = objConn.Execute (sql) If not objTemp.Eof Then DoWithCatalog = objTemp ("tSubCatalogName") End If objTemp.Close Set objTemp = Nothing Else iCatalogID = CInt (str) sql = "Select tCatalogName From tCoatCatalog where CatalogID = " & iCatalogID & "" Set objTemp = objConn.Execute (sql) If not objTemp.Eof Then DoWithCatalog = objTemp ("tCatalogName") End If objTemp.Close Set objTemp = Nothing End If Else DoWithCatalog = "" End If End Function '最新更新末 Function strRnd(intLen) '生成随机字符串 dim num,yourpass yourpass="" Randomize Do While Len(yourpass)cint(pos) then leftlm=left(strString,i-1) exit function end if next if j<=pos then leftlm=strString end if End function function save(str) 'SQL语句过滤函数 dim dist if len(str)>0 then dist=trim(str) dist=replace(dist,"'","''") else dist="" end if save=dist end function ' ===================================================================== ' 验证Mail的函数 ' Function CheckMail (mail) If Mail = "" Then CheckMail = False Else If Len (Mail) < 6 Or Instr (mail, "@") = 0 or Instr (mail, ".") = 0 Then CheckMail = False ElseIf ((Instr (mail, ".") - Instr (mail, "@")) <= 1) Then CheckMail = False Else CheckMail = True End If End If End Function ' ===================================================================== ' 发送Email 的函数 ' 参数表： ' 发邮件名字 ' 收件人名字 ' 收件人邮件 ' 发件人邮件 ' 主题 ' 内容 ' 优先级 ' 回复 Sub EmailSend (yourname, friendname, mailto, mailfrom, subject, content, Priority, ReplyTo) Dim objMail Set JMail = Server.CreateObject ("JMail.SMTPMail") JMail.Lazysend = True JMail.MailDomain = "211.100.8.162" JMail.Charset = "gb2312" JMail.ContentType ="text/html" JMail.Sender = "service@coatweb.com" JMail.SenderName = "中华涂料商务网" If CheckMail (ReplyTo) = true Then JMail.ReplyTo = ReplyTo Else JMail.ReplyTo = "service@coatweb.com" End If 'JMail.ReturnReceipt = True JMail.Subject = subject JMail.ClearRecipients () JMail.AddRecipient mailto JMail.AddRecipientBCC "service@coatweb.com" 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 ' =================================== ' 获得VIP会员ID ' Function GetVipID () sql = "Select v.VIPID From tblUser u, tblVip v where u.mVIP = 1 and u.sUserName = '" & Session ("LoginUserName") & "' and u.UserID = v.UserID " Set objTemp = objConn.Execute (sql) IF not objTemp.Eof Then intVipID = objTemp ("VIPID") End If objTemp.close () Set objTemp = Nothing GetVipID = intVipID End Function Function GetGroupName (ID) If ID = 0 Then GetGroupName = "正式客户" ElseIf ID = -1 Then GetGroupName = "陌生客户" ElseIf ID = -2 Then GetGroupName = "客户黑名单" Else i_sql = "select sGroupName from tblGroup where GroupID = " & ID & "" Set objGroup = objConn.Execute (i_sql) If not objGroup.Eof Then GetGroupName = objGroup ("sGroupName") End If objGroup.Close () Set objGroup = Nothing End If End Function Function CheckOnline (str) Dim strOnline For i = 0 To online_person_num - 1 If str = Online (i) Then strOnline = "在线" Exit For Else strOnline = "不在线" End If Next CheckOnline = strOnline End Function ' ================================== ' 格式化信息显示 ' 获得第一个产品信息 ' Function GetLeftStr (str) If str = "" Then GetLeftStr = "" Else If Len (str) > 15 Then str = Left (str,13) & "..." End If GetLeftStr = str End If End Function ' ================================== ' 样品库类别 Sub EnumShopType () sql = "Select * From tblCoatCatalog where iTypeWay = 0 order by CatalogID" Set objTemp = objConn.Execute (sql) 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 ' ================================== ' 格式化日期显示 ' Function FormatTime (str) FormatTime = Year (str) & "-" & Month (str) & "-" & Day (str) End Function ' 获得产品下的次分类 Function GetProductType (id) strSQL = "Select sCatalogName From tblCoatCatalog where CatalogID = " & id & "" Set objProduct = objConn.Execute (strSQL) ' Response.Write strSQL ' Response.End If not objProduct.Eof Then GetProductType = objProduct ("sCatalogName") Else GetProductType = "" End If objProduct.Close Set objProduct = Nothing End Function ' ================================== ' 首页中产品目录显示 Sub WriteCatalog (id) sql = "Select * From tblCoatCatalog where iTypeWay = " & id & " Order By CatalogID" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof If i <> 0 and i mod 3 = 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 ("sCatalogName") & "

" End Sub Sub WriteCatalogmainpp (id) sql = "Select * From tblCoatCatalog where iTypeWay = " & id & " Order By CatalogID" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof If i <> 0 and i mod 3 = 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 ("sCatalogName") & "

" End Sub '显示首页的品牌 Sub WriteCatalogpp (id) sql = "Select top 18 * From tblCoatCatalog where iTypeWay = " & id & " Order By CatalogID" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof If i <> 0 and i mod 3 = 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 "

" Response.Write "" Response.Write "	" & objTemp ("sCatalogName") & "
更多品牌...

" End Sub '显示产品目录下的总数 Sub WriteProductTotal sql = "Select count(*) From tblproduct where mdel=0 " Set objTemp = objConn.Execute (sql) producttotal=objtemp(0) response.write producttotal objTemp.Close Set objTemp = Nothing End Sub Sub WriteCatalogEx (id, CatalogID) sql = "Select * From tblCoatCatalog where iTypeWay = " & id & " Order By CatalogID" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof If i <> 0 and i mod 3 = 0 Then Response.Write "" End If Response.write "" If CatalogID = objTemp ("CatalogID") Then Response.Write "" Else Response.Write "" End If i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "

" Response.Write "" Response.Write "	" & objTemp ("sCatalogName") & "	" & objTemp ("sCatalogName") & "

" End Sub ' 最新展会信息 Sub ListShowNews () sql = "Select Top 5 * From tblCoatShow where mDel = 0 order by ShowID DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" Response.write "" Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write "" Response.Write "	" & objTemp ("sShowName") & "
更多展会信息...

" End Sub ' 原料助剂供应商 Sub ListProvider (id) sql = "Select Distinct c.CompanyID, c.sCompany From tblProduct p, tblCompany c" sql = sql & " where p.CatalogID1 = '" & id & "' and c.CompanyID = p.CompanyID and p.mPublish = 1 and p.mDel = 0 order by c.CompanyID DESC" Set objTemp = Server.CreateObject ("ADODB.Recordset") objTemp.MaxRecords = 6 objTemp.Open sql, objConn, 1, 1 str = "" Response.Write "" Do While not objTemp.Eof Response.Write "" Response.write "" str = objTemp ("Scompany") If Len (str) > 16 Then str = Left (objTemp ("scompany"), 16) End If Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write " " Response.Write "	" & objTemp ("sCompany") & "
" Response.Write "    更多供应商信息...

" End Sub ' 滚动信息 Sub MarqueeShowNews () sql = "Select Top 6 * From tblCoatShow where mDel = 0 order by ShowID DESC" Set objTemp = objConn.Execute (sql) ' i = 0 str = "" Do While not objTemp.Eof str= str & " " & objTemp ("sShowName") & "
" objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing str = str & "

更多展会信息...

" Response.Write str End Sub Sub MarqueeShowNews1 () sql = "Select Top 6 * From tblCoatShow where mDel = 0 order by ShowID DESC" Set objTemp = objConn.Execute (sql) ' i = 0 Response.Write "" Do While not objTemp.Eof str=left(objTemp ("sShowName"),16) Response.Write "" Response.write "" Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write " " Response.Write "	" & str & "...
" Response.Write "    更多展会信息...

" End Sub ' 显示最新供求信息 Sub ListRecentInfo (ID) If IsNumeric (ID) Then sql = "Select Top 5 * From tblInfoBank where mDel = 0 and mPublish = 1 and iInfoUse = " & ID & " order by dCreateDate DESC " Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" Response.Write "" Response.write "" str = GetLeftStr (objTemp ("sInfoTitle")) If Len (str) > 10 Then str = Left (str, 10) End if Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.write "" Response.Write "

	" Response.Write "" Response.Write "	" if objTemp("iInfoUse")="0" then Response.write "[供应]" Response.write "" & str & "" else Response.write "[求购]" Response.write "" & str & "" end if Response.write "
		" if ID = 0 Then Response.Write "发布供应" Response.Write "    " Response.Write "更多供应" Else Response.Write "发布求购" Response.Write "    " Response.Write "更多求购" End If Response.Write "

" End If End Sub ' 显示长期供应信息 Sub ListlongProduct () sql = "Select top 10 * From tblProduct where mdel=0 ORDER BY NEWID() " Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Response.Write "" Do While not objTemp.Eof If i <> 0 and i mod 2 = 0 Then Response.Write "" ElseIf i mod 2 <> 0 Then Response.Write "" End If Response.write "" str = GetLeftStr (objTemp ("sProductName")) If Len (str) > 8 Then str = Left (str, 12) End if Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "" Response.Write "" Response.Write "

	" Response.Write "" Response.Write "	" & str & "...
" Response.Write "			" Response.Write "更多供应信息" Response.Write "

" End Sub ' 显示最新合作信息 Sub ListCorpInfo () sql = "Select Top 4 * From tblInfoCorp info, tblInfoCorpType infotype where info.InfoCorpTypeID = infotype.ID and info.mDel = 0 and info.mPublish = 1 order by info.InfoCorpID DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" Response.write "" str = objTemp ("sInfoTitle") If Len (str) > 16 Then str = Left (objTemp ("sInfoTitle"), 16) End If Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" Response.Write " " Response.Write "	["& objTemp ("sName") &"]  " & str & "
发布合作信息        " Response.Write "    更多合作信息

" End Sub ' 新闻信息作为一个特殊内容处理 ' Sub ListSpecNewsInfoByType (strType) sql = "Select Top 5 * from tblUserNews n, tblUserNewsType t where n.mPublish = 1 and n.mDel = 0 and t.sName = '" & strType & "'and t.ID = n.NewsTypeID order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("sTitle") 'If Len (str) > 16 Then ' str = Left (objTemp ("sTitle"), 16) 'End If Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" & str & "(" & FormatTime (objTemp ("dCreateDate")) &")

" Response.Write ">>更多" & strType & "...

" End Sub ' 新闻信息作为一个特殊内容处理//显示eastcoat上新闻的代码 ' Sub ListSpecNewsInfoByTypeEastcoat (strType) sql = "Select Top 5 * from tblUserNews n, tblUserNewsType t where n.mPublish = 1 and n.mDel = 0 and t.sName = '" & strType & "'and t.ID = n.NewsTypeID order by dCreatedate DESC" Set objTemp = objConn.Execute (sql) Response.Write "" i = 0 Do While not objTemp.Eof Response.Write "" str = objTemp ("sTitle") 'If Len (str) > 16 Then ' str = Left (objTemp ("sTitle"), 16) 'End If Response.Write "" Response.Write "" i = i + 1 objTemp.MoveNext Loop objTemp.Close Set objTemp = Nothing Response.Write "" Response.Write "

" & str & "(" & FormatTime (objTemp ("dCreateDate")) &")

" Response.Write "更多" & strType & "...

" End Sub Function GetVIPCompanyname (ID) If ID <> 0 Then sql = "select c.sCompany from tblVIP v, tblCompany c where v.VIPID = " & ID & " and c.CompanyID = v.CompanyID" Set objVip = objConn.Execute (sql) If not objVip.Eof Then GetVIPCompanyName = objVip ("sCompany") End If objVip.Close () Set objVip = Nothing End If End Function Function GetVIPCompanyname_address (ID) If ID <> 0 Then sql = "select * from tblVIP v, tblCompany c where v.VIPID = " & ID & " and c.CompanyID = v.CompanyID" Set objVip = objConn.Execute (sql) If not objVip.Eof Then GetVIPCompanyName_address = objVip ("sAddress") End If objVip.Close () Set objVip = Nothing End If End Function Function GetVIPCompanyname_phone (ID) If ID <> 0 Then sql = "select * from tblVIP v, tblCompany c where v.VIPID = " & ID & " and c.CompanyID = v.CompanyID" Set objVip = objConn.Execute (sql) If not objVip.Eof Then GetVIPCompanyName_phone = objVip ("sPhone") End If objVip.Close () Set objVip = Nothing End If End Function Function GetVIPCompanyname_fax (ID) If ID <> 0 Then sql = "select * from tblVIP v, tblCompany c where v.VIPID = " & ID & " and c.CompanyID = v.CompanyID" Set objVip = objConn.Execute (sql) If not objVip.Eof Then GetVIPCompanyName_fax = objVip ("sFax") End If objVip.Close () Set objVip = Nothing End If End Function Function GetVIPCompanyname_linkman (ID) If ID <> 0 Then sql = "select * from tblVIP v, tblCompany c where v.VIPID = " & ID & " and c.CompanyID = v.CompanyID" Set objVip = objConn.Execute (sql) If not objVip.Eof Then GetVIPCompanyName_linkman = objVip ("sLinkMan") End If objVip.Close () Set objVip = Nothing End If End Function Function GetVIPCompanyname_zipcode (ID) If ID <> 0 Then sql = "select * from tblVIP v, tblCompany c where v.VIPID = " & ID & " and c.CompanyID = v.CompanyID" Set objVip = objConn.Execute (sql) If not objVip.Eof Then GetVIPCompanyName_zipcode = objVip ("iZipCode") End If objVip.Close () Set objVip = Nothing End If End Function Function GetVIPCompanyname_url (ID) If ID <> 0 Then sql = "select * from tblVIP v, tblCompany c where v.VIPID = " & ID & " and c.CompanyID = v.CompanyID" Set objVip = objConn.Execute (sql) If not objVip.Eof Then GetVIPCompanyName_url = objVip ("sWebSite") End If objVip.Close () Set objVip = Nothing End If End Function Function GetVIPCompanyname_email (ID) If ID <> 0 Then sql = "select * from tblVIP v, tblCompany c where v.VIPID = " & ID & " and c.CompanyID = v.CompanyID" Set objVip = objConn.Execute (sql) If not objVip.Eof Then GetVIPCompanyName_email = objVip ("sEmail") End If objVip.Close () Set objVip = Nothing End If End Function '获取公司简介信息 Function GetCompanyNameDetail (InfoPubID) If IsNumeric (InfoPubID) Then Dim i_strCompanyNameTmp i_strCompanyNameTmp = "" i_sql_2 = "" i_sql_2 = "Select UserID, SysID,sDetail,sCompanyName From tblInfoPub where InfoPubID = " & InfoPubID & "" Set objInfo = objConn.Execute (i_sql_2) If not objInfo.Eof Then i_strCompanyNameDetailTmp = objInfo ("sDetail") End If objInfo.Close Set objInfo = Nothing GetCompanyNameDetail = i_strCompanyNameDetailTmp End If End Function Function GetCompanyStr (strLinkUrl) If Instr (strLinkUrl, "|") <> 0 Then arrValue = Split (strLinkUrl, "|") GetCompanyStr = arrValue (UBound (arrValue)) End If End Function ' 增加 Sub AddProvince (sProvinceName) sql = "Insert Into tblProvince (sName) values ('" & sProvinceName & "')" objConn.Execute (sql) ErrHandler (0) ' 0 - Insert 1 - Update 2 - Delete End Sub ' 删除 Sub DelProvince (nID) sql = "Delete tblProvince where ID = " & nID & "" objConn.Execute (sql) ErrHandler (2) End Sub ' 修改 Sub UpdateProvince (sProvinceName, nID) sql = "Update tblProvince Set sName = '" & sProvinceName & "' where ID = " & nID & "" objConn.Execute (sql) ErrHandler (1) End Sub ' 列出所有的产品类目 Sub EnumProductCatalog () sql = "Select CatalogID, sCatalogName from tblCoatCatalog order by iTypeway" Set objTemp = objConn.Execute (sql) Response.Write "" & vbCrLf Response.Write "--请选择类别--" & vbCrLF If not objTemp.Eof Then Do while Not objTemp.Eof Response.Write "" & objTemp (1) & vbCrLF sql_1 = "Select SubCatalogID, sSubCatalogName From tblSubCoatCatalog where CatalogID = " & objTemp (0) & "" set objTemp1 = objConn.Execute (sql_1) Do while Not objTemp1.Eof Response.Write "  " & objTemp1 (1) & vbCrLF objTemp1.MoveNext Loop objTemp1.Close Set objTemp1 = Nothing objTemp.MoveNext Loop End If Response.Write "" objTemp.Close Set objTemp = Nothing End Sub ' =========================================================================================== ' 列出所有的付款方式 ' Sub EnumPayInfo () sql = "Select ID, sName From tblPayInfo Order by ID" Set objTemp = objConn.Execute (sql) IF Not objTemp.Eof Then Response.Write "" & vbCrLF Response.Write " 任何方式" & vbCrLF Do while not objTemp.Eof Response.Write "" & objTemp (1) objTemp.MoveNext Loop End If objTemp.Close Set objTemp = Nothing End Sub Sub SelPayInfo (str) sql = "Select ID, sName From tblPayInfo Order by ID" Set objTemp = objConn.Execute (sql) IF Not objTemp.Eof Then Response.Write "" & vbCrLF Response.Write " 任何方式" & vbCrLF Do while not objTemp.Eof If str = objTemp (1) Then Response.Write "" & objTemp (1) Else Response.Write "" & objTemp (1) End If objTemp.MoveNext Loop End If objTemp.Close Set objTemp = Nothing End Sub ' 获取类型名称 Function GetTypeInfo (tablename, ID) sql = "Select sName From " & tablename & " where ID = " & ID & "" Set objTypeInfo = objConn.Execute (sql) If not objTypeInfo.Eof Then GetTypeInfo = objTypeInfo (0) End If objTypeInfo.close () Set objTypeInfo = Nothing End Function Function GetSubCatalog (ID) If IsNumeric (ID) And ID > 0 Then sql = "Select sSubCatalogName from tblSubCoatCatalog where SubCatalogID = " & ID & "" Set objTemp = objConn.Execute (sql) If not objTemp.Eof Then GetSubCatalog = objTemp(0) Else GetSubCatalog = "" End If objTemp.close Set objTemp = Nothing End IF End Function ' 选择产品类目信息 供求信息中使用 Sub SelProductCatalog (strProductStr) sql = "Select CatalogID, sCatalogName from tblCoatCatalog order by iTypeway" Set objTemp = objConn.Execute (sql) Response.Write "" & vbCrLf Response.Write "--请选择--" & vbCrLF If not objTemp.Eof Then Do while Not objTemp.Eof If IsNumeric (strProductStr) Then If CInt (strProductStr) = objTemp (0) Then Response.Write "" & objTemp (1) & vbCrLF Else Response.Write "" & objTemp (1) & vbCrLF End If Else sql_1 = "Select SubCatalogID, sSubCatalogName From tblSubCoatCatalog where CatalogID = " & objTemp (0) & "" set objTemp1 = objConn.Execute (sql_1) Do while Not objTemp1.Eof IF strProductStr = objTemp1 (0) Then Response.Write "" & objTemp1 (1) & vbCrLF Else Response.Write "" & objTemp1 (1) & vbCrLF End If objTemp1.MoveNext Loop objTemp1.Close Set objTemp1 = Nothing End If objTemp.MoveNext Loop End If Response.Write "" objTemp.Close Set objTemp = Nothing End Sub ' 选择产品类目信息 供求信息中使用 Sub SelProductCatalog1 (CatalogID, id) sql = "Select CatalogID, sCatalogName from tblCoatCatalog order by iTypeway" Set objTemp = objConn.Execute (sql) Response.Write "" Response.Write "--请选择--" If not objTemp.Eof Then Do while Not objTemp.Eof If IsNumeric (CatalogID) Then If Cint (CatalogID) = objTemp (0) Then Response.Write "" & objTemp (1) Else Response.Write "" & objTemp (1) End If Else Response.Write "" & objTemp (1) End If objTemp.MoveNext Loop End If Response.Write "" objTemp.Close Set objTemp = Nothing ' SelProductCatalog1 = i_str End Sub ' ================================================================== ' 插入信息相关内容 Function InsertInfoPub (Quantity, Price, PayInfo, ExchangeTime, ExecStandard, Detail, UserID, SysID, Company, LinkMan, Phone, Email, Fax, IPAddress) ' ================================ ' 插入产品的连贯信息 ' Dim i_intInfoPubID Set objCmd = Server.CreateObject ("ADODB.Command") objCmd.ActiveConnection = objConn objCmd.CommandType = adCmdStoredProc objCmd.CommandText = "spAddInfoPub" objCmd.Parameters.Append objCmd.CreateParameter ("Quantity", adVarChar, adParamInput, 50) objCmd.Parameters ("Quantity") = Quantity objCmd.Parameters.Append objCmd.CreateParameter ("Price", adVarChar, adParamInput, 50) objCmd.Parameters ("Price") = Price objCmd.Parameters.Append objCmd.CreateParameter ("PayInfo", adVarChar, adParamInput, 50) objCmd.Parameters ("PayInfo") = PayInfo objCmd.Parameters.Append objCmd.CreateParameter ("ExchangeTime", adVarChar, adParamInput, 50) objCmd.Parameters ("ExchangeTime") = ExchangeTime objCmd.Parameters.Append objCmd.CreateParameter ("ExecStandard", adVarChar, adParamInput, 30) objCmd.Parameters ("ExecStandard") = ExecStandard objCmd.Parameters.Append objCmd.CreateParameter ("Detail", adVarChar, adParamInput, 1000) objCmd.Parameters ("Detail") = Detail objCmd.Parameters.Append objCmd.CreateParameter ("UserID", adInteger, adParamInput) objCmd.Parameters ("UserID") = UserID objCmd.Parameters.Append objCmd.CreateParameter ("SysID", adInteger, adParamInput) objCmd.Parameters ("SysID") = SysID objCmd.Parameters.Append objCmd.CreateParameter ("Company", adVarChar, adParamInput, 255) objCmd.Parameters ("Company") = Company objCmd.Parameters.Append objCmd.CreateParameter ("LinkMan", adVarChar, adParamInput, 255) objCmd.Parameters ("LinkMan") = LinkMan objCmd.Parameters.Append objCmd.CreateParameter ("Phone", adVarChar, adParamInput, 255) objCmd.Parameters ("Phone") = Phone objCmd.Parameters.Append objCmd.CreateParameter ("Email", adVarChar, adParamInput, 255) objCmd.Parameters ("Email") = Email objCmd.Parameters.Append objCmd.CreateParameter ("Fax", adVarChar, adParamInput, 255) objCmd.Parameters ("Fax") = Fax objCmd.Parameters.Append objCmd.CreateParameter ("IPAddress", adVarChar, adParamInput, 255) objCmd.Parameters ("IPAddress") = IPAddress objCmd.Parameters.Append objCmd.CreateParameter ("ID", adInteger,adParamOutput) objCmd.Execute () If objCmd ("ID") <> 0 Then i_intInfoPubID = objCmd ("ID") Else i_intInfoPubID = 0 End If Set objCmd = Nothing InsertInfoPub = i_intInfoPubID End Function ' =================================================================== ' 发表供求信息 Function InsertInfoBank (InfoUse, InfoTitle, InfoSpec, InfoEngTitle, BigCatalog, Catalog, SubCatalog, ProductDesc, InfoPubID, ClickNum, Publish,utype) i_sql_3 = "" i_sql_3 = "Insert Into tblInfoBank (iInfoUse, sInfoTitle, sInfoSpec, sInfoEngTitle, iBigCatalogID, iCatalogID, " i_sql_3 = i_sql_3 & " iSubCatalogID, sProductDesc, InfoPubID, iClickNum, mPublish,UserType) Values (" i_sql_3 = i_sql_3 & " " & InfoUse & ", '" & InfoTitle & "', '" & InfoSpec & "', '" & InfoEngTitle & "'," i_sql_3 = i_sql_3 & " " & BigCatalog & ", " & Catalog & ", " & SubCatalog & ", '" & ProductDesc & "', " & InfoPubID & ", " & ClickNum & ", " i_sql_3 = i_sql_3 & " " & Publish & ", " & utype & ")" objConn.Execute (i_sql_3) If Err.number = 0 Then InsertInfoBank = 0 Else InsertInfoBank = Err.number End If End Function ' =================================================================== ' 转换字符串 ' ' Sub AddUserInfo (sUserName, sPassword, sPassQuestion, sPassAnswer, Function ConvertStr (str) dim result dim l if isnull(str) then htmlencode="" exit function end if l=len(str) result="" dim i dim i_num i_num = 0 for i = 1 to l select case mid(str,i,1) case "<" result=result+"<" case ">" result=result+">" case chr(34) result=result+""" case "&" result=result+"&" case chr(13) result=result+"
    " case chr(9) result=result+"    " case chr(32) 'result=result+" " if i+1<=l and i-1>0 then if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then result=result+" " else result=result+" " end if else result=result+" " end if case else result=result+mid(str,i,1) end select next if err.number<>0 then err.clear ConvertStr = "
     " + result End Function %>