"& SYS_WEBNAME &"

<% Option Explicit '当前系统版本设置，1为SQL版，2为ACCESS Dim IsSqlDataBase IsSqlDataBase = 2 'SQL数据库连接配置 Dim SqlDatabaseName,SqlPassword,SqlUsername,SqlLocalName '服务器名或者IP SqlLocalName = "(local)" '数据库名 SqlDatabaseName = "cnbbr" '数据库登陆用户名 SqlUsername = "sa" '数据库登陆密码 SqlPassword = "" 'ACCESS版数据库地址 Dim Db Db="/dqcata/#BB#R_6@C#brCn#br.asa" Dim SqlDiff,SqlNowString if IsSqlDatabase=1 then SqlDiff=" " SqlNowString = "GetDate()" else SqlDiff=" * " SqlNowString = "now()" end if %> <% Dim Sql,Rs,Conn dim connsql,UrlName,FileName dim breadsqlconn,ynyyconn Dim ProcessStartTime,ProcessEndTime ProcessStartTime=Timer() ConnectionDatabase Sub ConnectionDatabase Dim ConnStr If IsSqlDataBase = 1 Then ConnStr = "Provider = Sqloledb; User ID = " & SqlUsername & "; Password = " & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source = " & SqlLocalName & ";" Else ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(db) End If On Error Resume Next Set conn = Server.CreateObject("ADODB.Connection") conn.open ConnStr If Err Then err.Clear Set Conn = Nothing Response.Write "数据库连接出错，请检查连接字串。" 'Response.Write "原因："& Err.Description Response.End End If on error resume next ' '开始YNSEED数据库连接 ' 'set connsql=server.createobject("ADODB.CONNECTION") ' 'connsql.Open "Provider=SQLOLEDB.1;Password=ynseed.cm23457!@#;Persist Security Info=True;User ID=sa;Initial Catalog=ynseed;Data Source=QCWEB;Connect Timeout=15" 'If Err Then ' err.Clear ' Set connsql = Nothing ' 'End If ' ''连接YNSEED 品种展示 ' set breadsqlconn=server.createobject("ADODB.CONNECTION") ' ' breadsqlconn.Open "Provider=SQLOLEDB.1;Password=ynseed.cm23457!@#;Persist Security Info=True;User ID=sa;Initial Catalog=gongqiou;Data Source=QCWEB;Connect Timeout=15" ' 'If Err Then ' err.Clear ' Set breadsqlconn = Nothing ' 'End If ' ''连接园艺数据库 'set ynyyconn=server.createobject("ADODB.CONNECTION") ' ' ynyyconn.Open "Provider=SQLOLEDB.1;Password=ynseed.cm23457!@#;Persist Security Info=True;User ID=sa ;Initial Catalog=ynyy;Data Source=QCWEB;Connect Timeout=15" ' 'If Err Then ' err.Clear ' Set breadsqlconn = Nothing ' 'End If End Sub Function CloseConn Conn.close set Conn=nothing End Function %> <% Response.Buffer=True Server.ScriptTimeOut=60 Session.TimeOut=60 Dim StartTime,EndTime StartTime=1000*Timer() Dim ConnTimesCount ConnTimesCount=0 Sub CnbbrConnTimes() ConnTimesCount=ConnTimesCount+1 End Sub '系统顶部和底部模板宽度设置 Dim SYS_BodyWidth SYS_Bodywidth="772" Dim i,j,k Dim RsSysConfig sql="Select * From Cnbbr_SysConfig Where Cnbbrid=1" set RsSysConfig=conn.execute(sql) CnbbrConnTimes If RsSysConfig.eof then Response.write"

系统配置信息无效！请联系开发人员进行故障恢复！" Response.end Else Dim SYS_WEBNAME,SYS_WEBURL,SYS_WEBKEY,SYS_WEBBBS,SYS_STATUS,SYS_STATUSINFO Dim SKINS_FOLDER,SKINS_CSS,SKINS_DefaultID,SYS_WEBMONEY Dim SYS_Str_Words,SYS_ANNOUNCE SYS_WEBNAME=RsSysConfig("cnBBR_SysName") SYS_WEBURL=RsSysConfig("cnBBR_SysDomain") SYS_WEBKEY=RsSysConfig("cnBBR_SysSearchKey") SYS_WEBBBS=RsSysConfig("cnBBR_SysBBS") SYS_STATUS=RsSysConfig("cnBBR_SysStatus") SYS_STATUSINFO=RsSysConfig("cnBBR_SysStatusInfo") SKINS_DefaultID=RsSysConfig("cnBBR_SysSkinsID") Dim TempSkins_DefaultID TempSkins_DefaultID=Trim(Session("SysDefaultSkinsID")) if isNumBBR(TempSkins_DefaultID) then SKINS_DefaultID=TempSkins_DefaultID Dim RsDefaultSkin Sql="Select * from Cnbbr_Skins Where BBR_SkinsID="& Skins_DefaultID Set RsDefaultSkin=Conn.execute(Sql) CnbbrConnTimes if RsDefaultSkin.Eof or RsDefaultSkin.Bof then Response.write"

系统默认模板配置信息无效！请联系管理员进行默认模板设置！" Response.end else SKINS_FOLDER=RsDefaultSkin("BBR_SkinsCssPath") SKINS_CSS=RsDefaultSkin("BBR_SKinsCssUrl") end if RsDefaultSkin.Close Set RsDefaultSkin=nothing SYS_WEBMONEY=RsSysConfig("cnBBR_SysMoney") SYS_Str_Words=RsSysConfig("cnBBR_SysFilterWords") SYS_ANNOUNCE=RsSysConfig("cnBBR_SysAnnounce") Dim SYS_WEBEMAIL,SYS_WEBTEL,SYS_WEBOICQ SYS_WEBEMAIL=RsSysConfig("cnBBR_SysEmail") SYS_WEBTEL=RsSysConfig("cnBBR_SysTel") SYS_WEBOICQ=RsSysConfig("cnBBR_SysQQ") Dim SYS_MODEL,auctype1,auctype2,auctype3 SYS_MODEL=RsSysConfig("cnBBR_AucModel") auctype1="最高价竞拍" auctype2="一口价拍卖" auctype3="唯一最低价" Dim SYS_AucPayForAdd SYS_AucPayForAdd=RsSysConfig("cnBBR_AucPayForAdd") Dim AutoDel,Search_HotKey,JsPerPage,IndexPerPage AutoDel=RsSysConfig("cnBBR_AucAutoDel") Search_HotKey=RsSysConfig("cnBBR_AucHotSearch") JsPerPage=RsSysConfig("cnBBR_AucPerPageNum") IndexPerPage=RsSysConfig("cnBBR_AucIndexNum") Dim Super_User,Super_Admin Super_User=RsSysConfig("cnBBR_UserSuperUser") Super_Admin=RsSysConfig("cnBBR_UserSuperAdmin") Dim SYS_REGUSER,IdStatus,SYS_UserSellCheck SYS_REGUSER=RsSysConfig("cnBBR_UserAllowReg") IdStatus=RsSysConfig("cnBBR_UserRegCheck") SYS_UserSellCheck=RsSysConfig("cnBBR_UserSellCheck") Dim ShopAutoCheck,SYS_ShopVip,SYS_ShopMonthMoney ShopAutoCheck=RsSysConfig("cnBBR_UserShopRegCheck") SYS_ShopVip=RsSysConfig("CnBBR_ShopVip") SYS_ShopMonthMoney=RsSysConfig("cnBBR_ShopMonthMoney") Public SysUserCredit Dim Sys_UserCredit Sys_UserCredit=RsSysConfig("cnBBR_UserCreditDegrade") Dim Sys_OnlinePayStaus,Sys_MoneyChangeScale Sys_OnlinePayStaus=RsSysConfig("cnBBR_OnlinePayStaus") Sys_MoneyChangeScale=RsSysConfig("cnBBR_MoneyChangeScale") Dim creditadd creditadd=RsSysConfig("cnBBR_UserAppIncrement") Dim CreditPresent CreditPresent=RsSysConfig("cnBBR_UserIntPresent") Dim UPFILE_FOLDER,UPFILE_TOTALNUM,UPFILE_MAXSIZE,UPFILE_TYPE UPFILE_FOLDER=RsSysConfig("cnBBR_UpFolder") UPFILE_TOTALNUM=RsSysConfig("cnBBR_UpNumLimit") UPFILE_MAXSIZE=RsSysConfig("cnBBR_UpSizeLimit") UPFILE_TYPE=RsSysConfig("cnBBR_UpTypeLimit") Dim SENDAUCEMAIL,SYS_SENDREGEMAIL,EmailServer,EmailSender,EmailServerUser,EmailServerPass SENDAUCEMAIL=RsSysConfig("cnBBR_EmailAuc") SYS_SENDREGEMAIL=RsSysConfig("cnBBR_EmailUser") EmailServer=RsSysConfig("cnBBR_EmailServer") EmailServerUser=RsSysConfig("cnBBR_EmailServerUser") EmailServerPass=RsSysConfig("cnBBR_EmailServerPass") EmailSender=RsSysConfig("cnBBR_SysEmail") Dim Out_Status,out_IsSql Out_Status=RsSysConfig("cnBBR_OutStatus") out_IsSql=RsSysConfig("cnBBR_OutIsSql") Dim Out_Path,Out_SqlDB,Out_SqlLoginUser,Out_SqlLoginPass,Out_Table,Out_User,Out_Pass,Out_RegUrl,Out_GetPassUrl Out_Path=RsSysConfig("cnBBR_OutPath") Out_SqlDB=RsSysConfig("cnBBR_OutSqlDB") Out_SqlLoginUser=RsSysConfig("cnBBR_OutSqlLoginUser") Out_SqlLoginPass=RsSysConfig("cnBBR_OutSqlLoginPass") Out_Table=RsSysConfig("cnBBR_OutTable") Out_User=RsSysConfig("cnBBR_OutUser") Out_Pass=RsSysConfig("cnBBR_OutPass") Out_RegUrl=RsSysConfig("cnBBR_OutRegUrl") Out_GetPassUrl=RsSysConfig("cnBBR_OutGetPassUrl") Dim StarAucBidUnit StarAucBidUnit=RsSysConfig("cnBBR_CommAucBidUnit") Dim StarshopBidUnit StarshopBidUnit=RsSysConfig("cnBBR_CommShopBidUnit") Dim Cnbbr_IndexStarAucPerRow,Cnbbr_IndexStarAucRow Cnbbr_IndexStarAucPerRow=RsSysConfig("cnBBR_CommAucPerRow") Cnbbr_IndexStarAucRow=RsSysConfig("cnBBR_CommAucRow") Dim Cnbbr_IndexStarShopPerRow,Cnbbr_IndexStarShopRow Cnbbr_IndexStarShopPerRow=RsSysConfig("cnBBR_CommShopPerRow") Cnbbr_IndexStarShopRow=RsSysConfig("cnBBR_CommShopRow") Dim LimitStarLargerTime LimitStarLargerTime=RsSysConfig("cnBBR_CommTimeLimit") Dim Update_TempAucTimes Update_TempAucTimes=RsSysConfig("cnBBR_AppliUpdateIndex") Dim Update_SysTimes Update_SysTimes=RsSysConfig("cnBBR_AppliUpdateSys") Dim cBBRMd5Byte,cBBROutMd5Byte,cBBRPayMd5Byte cBBRMd5Byte=RsSysConfig("cnBBR_Md5Byte") cBBROutMd5Byte=RsSysConfig("cnBBR_OutMd5Byte") cBBRPayMd5Byte=RsSysConfig("cnBBR_PayMd5Byte") Const BBR_StrLen=32 Const MsgLength=250 Const DisplayQQ=1 End if RsSysConfig.Close Set RsSysConfig=nothing Function IsNumBBR(stri) IsNumBBR=True if stri="" or isNull(stri) then IsNumBBR=False else For i=1 to len(stri) if isNumeric(mid(stri,i,1)) or mid(stri,i,1)="." then IsNumBBR=True else IsNumBBR=False Exit For end if Next end if End Function %> <% '--------定义部份------------------ Dim Fy_Post,Fy_Get,Fy_In,Fy_Inf,Fy_Xh,Fy_db,Fy_dbstr,Kill_IP,WriteSql '自定义需要过滤的字串,用 "|" 分隔 Fy_In = "'|;|and|(|)|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare" Kill_IP=True WriteSql=True '---------------------------------- Fy_Inf = split(Fy_In,"|") '--------POST部份------------------ Function CheckBBRForm() If Request.Form<>"" Then For Each Fy_Post In Request.Form For Fy_Xh=0 To Ubound(Fy_Inf) If Instr(LCase(Request.Form(Fy_Post)),Fy_Inf(Fy_Xh))<>0 Then Response.Write "" Response.End End If Next Next End If ENd Function '---------------------------------- '--------GET部份------------------- If Request.QueryString<>"" Then For Each Fy_Get In Request.QueryString For Fy_Xh=0 To Ubound(Fy_Inf) If Instr(LCase(Request.QueryString(Fy_Get)),Fy_Inf(Fy_Xh))<>0 Then Response.Write "" Response.End End If Next Next End If function LockIP(sip) dim str1,str2,str3,str4 dim num LockIP=false if isnumeric(left(sip,2)) then str1=left(sip,instr(sip,".")-1) sip=mid(sip,instr(sip,".")+1) str2=left(sip,instr(sip,".")-1) sip=mid(sip,instr(sip,".")+1) str3=left(sip,instr(sip,".")-1) str4=mid(sip,instr(sip,".")+1) if isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 then response.write "非法的IP地址不允许进入该系统，请和管理员联系。" response.end else num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1 sql="select count(*) from cnbbr_KillIp where ip_Start <="&num&" and ip_End >="&num&"" set rs=conn.execute(sql) if rs(0)>0 then LockIP=true end if set rs=nothing end if end if end function %> <% Dim cnbbr_CurrentHost,cnbbr_CurrentPath,cnbbr_ComeUrl cnbbr_CurrentHost=Cstr(Request.ServerVariables("SERVER_NAME")) cnbbr_CurrentPath=Cstr(Request.ServerVariables("PATH_INFO")) cnbbr_ComeUrl=Cstr(Request.ServerVariables("HTTP_REFERER")) if cnbbr_ComeUrl<>"" then if InStr(cnbbr_ComeUrl,"PreAucBid.asp")>0 then Cnbbr_ComeUrl=Replace(Cnbbr_ComeUrl,"PreAucBid.asp","AucInfo.asp") end if Dim cnBBR_CurFilePath cnBBR_CurFilePath=Cnbbr_CurrentHost & Cnbbr_CurrentPath cnBBR_CurFilePath=Left(cnBBR_CurFilePath,Len(cnBBR_CurFilePath)-Instr(cnBBR_CurFilePath,"/")) cnBBR_CurFilePath="Http://"& cnBBR_CurFilePath '检查访问来源合法性 JILLIAN Function Cnbbr_CheckPost(pType) If Mid(cnbbr_ComeUrl,8,len(cnbbr_CurrentHost))<>cnbbr_CurrentHost Then if pType=1 then With Response .Write "" & Vbcrlf .Write "" & Vbcrlf .Write "" & Vbcrlf .Write "" & Vbcrlf .Write "" & Vbcrlf .Write "" & Vbcrlf .Write "" & Vbcrlf .Write "" & Vbcrlf .Write "" & Vbcrlf .Write "" & Vbcrlf .Write "


"& Vbcrlf .Write " " .Write " 您的位置：首页 > 信息小贴士" & Vbcrlf .Write "

" & Vbcrlf End With HelpTitle="出错了！" HelpInfo="对不起，你的来源位置非法，请从站内提交当前操作！" HelpList="

登陆首页
返回上页

" & Vbcrlf Cnbbr_Helper HelpTitle,HelpInfo,HelpList,368 Cnbbr_Bottom Response.End else Call AlertInfo("当前地址来源非法，请从系统首页进入后再进行当前操作！","index.asp",1) end if end if End Function Function AlertInfo(Alert_Info,aNextPage,aType) aType=cint(aType) Select Case aType Case 0: Response.Write"" Response.End Case 1: Response.Write"" Response.End Case else: Response.Write"" Response.End End Select End Function Function Rst( psvaluename ) dim stemp stemp = Trim(request.querystring("" & psvaluename)) if len(trim(stemp)) = 0 then stemp = Trim(request.form("" & psvaluename)) end if rst = stemp End Function Function IsNum(stri) IsNum=True if stri="" or isNull(stri) then IsNum=False else Stri=Replace(Stri,",","") For i=1 to len(stri) if isNumeric(mid(stri,i,1)) or mid(stri,i,1)="." then IsNum=True else IsNum=False Exit For end if Next end if End Function Function HTMLEncode(reString) '转换HTML代码 Dim Str:Str=reString If Not IsNull(Str) Then Str = UnCheckStr(Str) Str = Replace(Str, "&", "&") Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") Str = Replace(Str, Chr(32), " ") Str = Replace(Str, Chr(9), " ") Str = Replace(Str, Chr(9), " ") Str = Replace(Str, Chr(34),""") Str = Replace(Str, Chr(39),"'") Str = Replace(Str, Chr(13), "") Str = Replace(Str, Chr(10), "
") HTMLEncode = Str End If End Function Function ReHTMLEncode(reString) '转换HTML代码 Dim Str:Str=reString If Not IsNull(Str) Then Str = CheckStr(Str) Str = Replace(Str, "&" ,"&") Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") Str = Replace(Str, " ", Chr(32)) Str = Replace(Str, " ", Chr(9)) Str = Replace(Str, " ", Chr(9)) Str = Replace(Str, """, Chr(34)) Str = Replace(Str, "'", Chr(39)) Str = Replace(Str, "", Chr(13)) Str = Replace(Str, "
", Chr(10)) ReHTMLEncode = Str End If End Function Function CheckStr(byVal ChkStr) '检查无效字符 Dim Str:Str=ChkStr Str=Trim(Str) If IsNull(Str) Then CheckStr = "" Exit Function End If Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="(\r\n){3,}" Str=re.Replace(Str,"$1$1$1") Set re=Nothing Str = Replace(Str,"'","''") Str = Replace(Str, "select", "select") Str = Replace(Str, "join", "join") Str = Replace(Str, "union", "union") Str = Replace(Str, "where", "where") Str = Replace(Str, "insert", "insert") Str = Replace(Str, "delete", "delete") Str = Replace(Str, "update", "update") Str = Replace(Str, "like", "like") Str = Replace(Str, "drop", "drop") Str = Replace(Str, "create", "create") Str = Replace(Str, "modify", "modify") Str = Replace(Str, "rename", "rename") Str = Replace(Str, "alter", "alter") Str = Replace(Str, "cast", "cast") Dim Sys_Str_words2 Sys_Str_Words2=Split(Sys_Str_Words,"|") For i=0 to Ubound(Sys_Str_Words2) Str=Replace(Str,Sys_Str_Words2(i),"^_^") Next CheckStr=Str End Function Function UnCheckStr(Str) Str = Replace(Str, "select", "select") Str = Replace(Str, "join", "join") Str = Replace(Str, "union", "union") Str = Replace(Str, "where", "where") Str = Replace(Str, "insert", "insert") Str = Replace(Str, "delete", "delete") Str = Replace(Str, "update", "update") Str = Replace(Str, "like", "like") Str = Replace(Str, "drop", "drop") Str = Replace(Str, "create", "create") Str = Replace(Str, "modify", "modify") Str = Replace(Str, "rename", "rename") Str = Replace(Str, "alter", "alter") Str = Replace(Str, "cast", "cast") UnCheckStr=Str End Function function strLength(str) ON ERROR RESUME NEXT dim WINNT_CHINESE WINNT_CHINESE = (len("中国")=2) if WINNT_CHINESE then dim l,t,c dim i l=len(str) t=l for i=1 to l c=asc(mid(str,i,1)) if c<0 then c=c+65536 if c>255 then t=t+1 end if next strLength=t else strLength=len(str) end if if err.number<>0 then err.clear end function Function InterceptString(txt,length) dim x,y,ii txt=trim(txt) x = len(txt) y = 0 if x >= 1 then for ii = 1 to x if asc(mid(txt,ii,1)) < 0 or asc(mid(txt,ii,1)) >255 then '如果是汉字 y = y + 2 else y = y + 1 end if if clng(y) >= clng(length) then '--MODIFIED BY JILLIAN 2006-5-25 START if x>ii then '--MODIFIED BY JILLIAN 2006-5-25 END txt = left(trim(txt),ii) '字符串限长 InterceptString = txt & ".." '--MODIFIED BY JILLIAN 2006-5-25 START end if exit for '--MODIFIED BY JILLIAN 2006-5-25 END else InterceptString = txt end if next else InterceptString = "" end if End Function Function SelectOper(select_str0,select_str1,select_str2) select_str1=Replace(select_str1,"，",",") select_str2=Replace(select_str2,"，",",") select_str1=split(select_str1,",") select_str2=split(select_str2,",") if Ubound(select_str1)<>Ubound(select_str2) then Response.Write "" else For i=0 to Ubound(select_str1) Response.Write ""& vbcrlf Next end if End Function Function RadioOper(radio_str0,radio_str1,radio_str2,radio_name) radio_str1=Replace(radio_str1,"，",",") radio_str2=Replace(radio_str2,"，",",") radio_str1=split(radio_str1,",") radio_str2=split(radio_str2,",") if Ubound(radio_str1)<>Ubound(radio_str2) then Response.Write "" else For i=0 to Ubound(radio_str1) response.write""& radio_str2(i) &" " Next end if End Function Function BoxOper(Box_str0,Box_str1,Box_str2,Box_name) Box_str0=Replace(Box_str0,"，",",") Box_str1=Replace(Box_str1,"，",",") Box_str2=Replace(Box_str2,"，",",") Box_str1=split(Box_str1,",") Box_str2=split(Box_str2,",") if Ubound(Box_str1)<>Ubound(Box_str2) then Response.Write "" else For i=0 to Ubound(Box_str1) response.write""& Box_str2(i) &" " Next end if End Function Function TransParam() Dim sq,sf,skey,i,temp,tempkey sq=request.querystring() sf=request.form() skey=sq&sf if skey<>"" then if sq="" then skey=sq elseif sf="" then skey=sq else skey=sq&"&"&sf end if skey=split(skey,"&") For i=0 to Ubound(skey) tempkey=split(skey(i),"=") if tempkey(0)<>"page" then if temp="" then temp=tempkey(0)&"="&tempkey(1) else temp=temp&"&"&tempkey(0)&"="&tempkey(1) end if end if Next if temp<>"" then temp=temp&"&" end if transparam=temp End Function function JoinChar(strUrl) if strUrl="" then JoinChar="" exit function end if if InStr(strUrl,"?")1 then if InStr(strUrl,"&") 1) Then StrRtn = StrRtn & "|" Next CodeCookie = StrRtn End Function Dim bbrcpy:Bbrcpy="XiaoTong" Function DecodeCookie(Str) Dim i Dim StrArr,StrRtn StrArr = Split(Str,"|") For i = 0 to UBound(StrArr) If isNumeric(StrArr(i)) = True Then StrRtn = Chrw(StrArr(i)) & StrRtn Else StrRtn = Str Exit Function End If Next DecodeCookie = StrRtn End Function Function displaytime(BaseTime) dim date2,date1,sdate,sday,sdate1,shour,sdate2,sminute,sdate3 date2 = basetime date1 = now() sdate = datediff("s", date1, date2) '总秒数 sday = fix(sdate/60/60/24) '天数 sdate1 = sdate mod 60*60*24 '余数 shour = fix(sdate1/60/60) '小时 sdate2 = sdate1 mod 60*60 '余数 sminute = fix(sdate2/60) '分钟 sdate3 = sdate2 mod 60 '余数 if sday>0 then response.write sday & "天" end if if sday=0 and shour>=0 then response.write shour & "小时" end if if sday=0 and shour=0 and sminute>=0 then response.write sminute & "分钟" end if if sday=0 and shour=0 and sminute=0 and sdate3>=0 then response.write sdate3 & "秒" end if if sdate3<0 then response.write "已经结束" end if End Function Function Print_space(Byval space_num) Dim I For I=1 to space_num Print_space=Print_space&" " Next End Function Function comp_check(byval str_class) on error resume next dim obj_check set obj_check = Server.CreateObject(str_class) set obj_check=nothing if err.number<>0 then comp_check=false else comp_check=true end if err.clear() End Function Function ADODB_LoadFile(ByVal File) On Error Resume Next Dim objStream,FSFlag,fs,WriteFile FSFlag = 1 If DEF_FSOString <> "" Then Set fs = Server.CreateObject(DEF_FSOString) If Err Then FSFlag = 0 Err.Clear Set fs = Nothing End If Else FSFlag = 0 End If If FSFlag = 1 Then Set WriteFile = fs.OpenTextFile(Server.MapPath(File),1,True) If Err Then GBL_CHK_TempStr = "
读取文件失败：" & err.description & "
其它可能：确定是否对此文件有读取权限." err.Clear Set Fs = Nothing Exit Function End If If Not WriteFile.AtEndOfStream Then ADODB_LoadFile = WriteFile.ReadAll If Err Then GBL_CHK_TempStr = "
读取文件失败：" & err.description & "
其它可能：确定是否对此文件有读取权限." err.Clear Set Fs = Nothing Exit Function End If End If WriteFile.Close Set Fs = Nothing Else Set objStream = Server.CreateObject("ADODB.Stream") If Err.Number=-2147221005 Then GBL_CHK_TempStr = "

您的主机不支持ADODB.Stream，无法完成操作，请手工进行

" Err.Clear Set objStream = Noting Exit Function End If With objStream .Type = 2 .Mode = 3 .Open .LoadFromFile Server.MapPath(File) .Charset = "GB2312" .Position = 2 ADODB_LoadFile = .ReadText .Close End With Set objStream = Nothing End If If Err Then GBL_CHK_TempStr = "
错误信息：" & err.description & "
其它可能：确定是否对此文件有读取权限." err.Clear Set Fs = Nothing Exit Function End If End Function function fShowPage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit) dim n, i,strTemp,strUrl if totalnumber mod maxperpage=0 then n= totalnumber \ maxperpage else n= totalnumber \ maxperpage+1 end if strTemp= "

" if ShowTotal=true then strTemp=strTemp & "共 " & totalnumber & " " & strUnit & " " end if strUrl=JoinChar(sfilename) if CurrentPage<2 then strTemp=strTemp & "首页上一页 " else strTemp=strTemp & "首页 " strTemp=strTemp & "上一页 " end if if n-currentpage<1 then strTemp=strTemp & "下一页尾页" else strTemp=strTemp & "下一页 " strTemp=strTemp & "尾页" end if strTemp=strTemp & " 页次：" & CurrentPage & "/" & n & "页 " if ShowAllPages=True then strTemp=strTemp & " 转到：" end if strTemp=strTemp & "

" fshowpage=strTemp end function Function DispAlert(Info) Response.Write "

"& Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "

信息小贴士

"& Info &"

" & Vbcrlf End Function Function SplitUserCredit(Sys_UserCredit) Dim Tempii,Tempc Tempc=0 SysUserCredit=0 if Sys_UserCredit="" then SysUserCredit=0 Dim TempCredit TempCredit=Split(Sys_UserCredit,"|") For Tempii=0 to Ubound(TempCredit) if not isNum(TempCredit(Tempii)) then Tempc=1 Exit For end if Next if Tempc=0 then SysUserCredit=TempCredit End Function 'add by jillian 2006-9-22 for index Function Disp_UserCredit_index(userid,credit,BBrFlag) Dim TempUserCredit Dim Tempii Dim a:a=credit if not isNum(a) then Exit Function Call SplitUserCredit(Sys_UserCredit) if isArray(SysUserCredit) then Dim TempDeep:TempDeep=ubound(SysUserCredit) for Tempii=0 to TempDeep if Tempii=TempDeep then if Clng(a)>=Clng(SysUserCredit(Tempii)) then TempUserCredit= Trans_Num(Tempii) &"星级" Exit For end if else if Clng(a)>=Clng(SysUserCredit(Tempii)) and Clng(a)=Clng(SysUserCredit(Tempii)) then TempUserCredit="" Exit For end if else if Clng(a)>=Clng(SysUserCredit(Tempii)) and Clng(a)" Exit For end if end if next end if Disp_UserCredit=TempUserCredit End Function Function Disp_ShopStar(ShopFlag,BBrFlag) Dim TempShopStar Dim TempBBRCredit if BBrFlag=1 then TempBBRCredit="../" else TempBBRCredit="" end if Select Case ShopFlag Case 0: TempShopStar="" Case 1: TempShopStar="" Case 2: TempShopStar="" Case 3: TempShopStar="" Case 4: TempShopStar="" Case 5: TempShopStar="" Case 6: TempShopStar="" Case else: TempShopStar="异常" End Select Disp_ShopStar=TempShopStar End Function Function Trans_Num(cnbbrNumber) Dim TempN TempN="" select case cnbbrNumber case 0: TempN="无" case 1: TempN="一" case 2: TempN="二" case 3: TempN="三" case 4: TempN="四" case 5: TempN="五" case 6: TempN="钻石" case 7: TempN="钻石" case 8: TempN="钻石" case 9: TempN="钻石" case else: TempN="" end select Trans_num=TempN End Function Function Disp_UserIDCard(Cnbbr_UserDegrade,BBrFlag) Dim TempUserIdCard Dim TempBBRIDCard if BBrFlag=1 then TempBBRIDCard="../" else TempBBRIDCard="" end if 'modfied by jillian 2006-11-13 start 'if Cnbbr_UserDegrade="身份证" then if Cnbbr_UserDegrade="Y" then 'modfied by jillian 2006-11-13 end TempUserIdCard="" else TempUserIdCard="" end if Disp_UserIDCard=TempUserIdCard End Function Dim HelpTitle,HelpInfo,HelpList Function Cnbbr_Helper(HelpTitle,HelpInfo,Helplist,Helpwidth) Response.Write "

" & Vbcrlf Response.Write "" & Vbcrlf Response.Write " " & Vbcrlf Response.Write " " & Vbcrlf Response.Write " " & Vbcrlf Response.Write "

" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcr Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "" & Vbcrlf Response.Write "


"& Vbcrlf Response.Write " "& HelpTitle &"" & Vbcrlf Response.Write "

" & Vbcrlf Response.Write " "& HelpInfo &"" & Vbcrlf Response.Write "

" & Vbcrlf Response.Write ""& HelpList &"" & Vbcrlf Response.Write "

" & Vbcrlf Response.Write "

" & Vbcrlf End Function Function CnbbrSiteMenu(Menu_Width,Menu_Left,Menu_Right) Dim LeftTemp,RightTemp,Sitei,Sitej,StrTemp,StrTemp2 Dim SiteMenuStr if Menu_Left<>"" then Menu_Left=Split(Menu_left,"||[menu]||") For Sitei=0 to Ubound(Menu_Left) StrTemp=Menu_Left(Sitei) if StrTemp<>"" then StrTemp=Split(StrTemp,"|[menu]|") if IsArray(StrTemp) then StrTemp2=StrTemp2 &">>>"& StrTemp(1) &"" End if Next end if LeftTemp=StrTemp2 Sitei=0:Sitej=0:StrTemp="":StrTemp2="" if Menu_Right<>"" then Menu_Right=Split(Menu_Right,"||[menu]||") For Sitei=0 to Ubound(Menu_Right) StrTemp=Menu_Right(Sitei) if StrTemp<>"" then StrTemp=Split(StrTemp,"|[menu]|") if IsArray(StrTemp) then StrTemp2=StrTemp2 &" "& StrTemp(1) &"" End if Next end if RightTemp=StrTemp2 SiteMenuStr=SiteMenuStr &"" & Vbcrlf SiteMenuStr=SiteMenuStr &" " & Vbcrlf SiteMenuStr=SiteMenuStr &" " & Vbcrlf SiteMenuStr=SiteMenuStr &" " & Vbcrlf SiteMenuStr=SiteMenuStr &" " & Vbcrlf SiteMenuStr=SiteMenuStr &" " & Vbcrlf SiteMenuStr=SiteMenuStr &" " & Vbcrlf SiteMenuStr=SiteMenuStr &" " & Vbcrlf SiteMenuStr=SiteMenuStr &"


"& Vbcrlf SiteMenuStr=SiteMenuStr &" " SiteMenuStr=SiteMenuStr &" 您的位置：首页"& LeftTemp &"" & Vbcrlf SiteMenuStr=SiteMenuStr &"			"& Vbcrlf if RightTemp<>"" then SiteMenuStr=SiteMenuStr &""& RightTemp & Vbcrlf SiteMenuStr=SiteMenuStr &"

" & Vbcrlf SiteMenuStr=SiteMenuStr &"" & Vbcrlf SiteMenuStr=SiteMenuStr &"" & Vbcrlf SiteMenuStr=SiteMenuStr &"" & Vbcrlf SiteMenuStr=SiteMenuStr &"" & Vbcrlf SiteMenuStr=SiteMenuStr &"

" & Vbcrlf CnbbrSiteMenu=SiteMenuStr End Function Function CnbbrSqlUser(SqlUserID,SqlFlag) Dim RsSqlUser_Name,SqlUserNameStr Sql="Select RegUsername from Users Where RegID="& SqlUserID Set RsSqlUser_Name=Conn.execute(Sql) if RsSqlUser_Name.Eof or RsSqlUser_Name.Bof then SqlUserNameStr="无" else SqlUserNameStr=""& RsSqlUser_Name("RegUserName") &"" end if RsSqlUser_Name.Close Set RsSqlUser_Name=nothing CnbbrSqlUser=SqlUserNameStr End Function Function CnBBR_AucClass_Amount(ClassID,Flag) if isNum(Flag) then if Clng(Flag)=1 then sql="update aucclass set aucAmount=aucAmount+1 where classid in ("&ClassID&")" conn.execute(sql) elseif Clng(Flag)=0 then sql="update aucclass set aucAmount=aucAmount-1 where classid in ("&ClassID&")" conn.execute(sql) else Sql="" end if end if End Function Function Disp_AucImages(AucID,BBrFlag) Dim rs_img,img_url,ImageStr,tempFontUrl sql="select top 1 * from aucimages where aucid="& Aucid &" order by img_order ASC" set rs_img=conn.execute(sql) if rs_img.bof or rs_img.eof then img_url="skins/"& Skins_Folder &"/nopic.gif" else img_url=RePlace(rs_img("img_url"),"\","/") end if rs_img.close set rs_img=nothing if Clng(BBrFlag)=1 then Img_Url="../"& Img_Url tempFontUrl="../" end if ImageStr=ImageStr &"" ImageStr=ImageStr &"

" ImageStr=ImageStr &"" Disp_AucImages=ImageStr End Function Function Read_BBRAucImages(AucID,BBRFlag) 'response.write aucid Dim rs_img,img_url sql="select top 1 * from aucimages where aucid="& Aucid &" order by img_order ASC" set rs_img=conn.execute(sql) if rs_img.bof or rs_img.eof then img_url="skins\"& Skins_Folder &"\nopic.gif" else ' img_url=RePlace(rs_img("img_url"),"/","\") img_url=rs_img("img_url") end if rs_img.close set rs_img=nothing if BBRFlag=1 then Img_Url="../"&Img_Url Read_BBRAucImages=Img_Url End Function Function BBRAucSmallImage(ByVal AucID,ByVal DispType,ByVal BBRFlag,ByVal NotImgPath) 'DispType 参数为是否隐藏图片显示 Dim TempStr,TempFont if BBRFlag=1 then TempFont="../" else TempFont="" end if TempStr="" & vbcrlf Select Case DispType Case 0: TempStr=TempStr & PixelPic(72,72,Read_BBRAucImages(AucID,BBRFlag),NotImgPath) Case 1: TempStr=TempStr &""& Vbcrlf Case else: End Select TempStr=TempStr &"" & vbcrlf BBRAucSmallImage=TempStr End Function 'add by jillian for breed introduce 2006-10-16 Function breedSmallImage(ByVal breedid,ByVal shopid,ByVal DispType,ByVal imageurl,ByVal BBRFlag,ByVal NotImgPath) 'DispType 参数为是否隐藏图片显示 Dim TempStr,TempFont if BBRFlag=1 then TempFont="../" else TempFont="" end if TempStr="" & vbcrlf Select Case DispType Case 0: TempStr=TempStr & PixelPic(96,72,"../"& imageurl ,NotImgPath) Case 1: TempStr=TempStr &""& Vbcrlf Case else: End Select TempStr=TempStr &"" & vbcrlf breedSmallImage=TempStr End Function Function CnbbrLink(LinkOwner,LinkFlag) Dim Templink,RsLink,num TempLink="" if not isNum(LinkOwner) then Exit Function '-----modified by jillian 2006-5-17 start--------- if LinkFlag=0 then '友情链接：新增加的排在后面，有图片的排在无图片的前面 Sql="Select Cnbbr_Lid,Cnbbr_lWebName,Cnbbr_lWebUrl,Cnbbr_lWebLogo,Cnbbr_lDescription,Cnbbr_lisLogo,Cnbbr_lOwnerID from Cnbbr_Link where Cnbbr_lOwnerID="& LinkOwner &" order by Cnbbr_lIsLogo Desc,Cnbbr_Lid" else '-----modified by jillian 2006-5-17 end--------- Sql="Select Cnbbr_Lid,Cnbbr_lWebName,Cnbbr_lWebUrl,Cnbbr_lWebLogo,Cnbbr_lDescription,Cnbbr_lisLogo,Cnbbr_lOwnerID from Cnbbr_Link where Cnbbr_lOwnerID="& LinkOwner &" order by Cnbbr_lIsLogo Desc" '-----modified by jillian 2006-5-17 start--------- end if '-----modified by jillian 2006-5-17 end--------- num=0 Set RsLink=Conn.execute(Sql) if Not RsLink.Eof then Do While Not RsLink.Eof '-------------add by jillian 2006-8-28 start------------- if LinkFlag=0 then if num=0 then TempLink = TempLink & "

" else if num / 7 = int(num/7) then TempLink = TempLink & "

" else TempLink = TempLink & "

" end if end if end if '-------------add by jillian 2006-8-28 end------------- if LinkFlag=0 then '-------------add by jillian 2006-8-28 start------------- if RsLink("Cnbbr_lIsLogo") = 1 then TempLink=TempLink &"

"& Vbcrlf else '-------------add by jillian 2006-8-28 end------------- TempLink=TempLink &""& RsLink("Cnbbr_lWebName") &" "& Vbcrlf end if else TempLink=TempLink &""& RsLink("Cnbbr_lWebName") &"
"& Vbcrlf end if RsLink.MoveNext num = num+1 Loop '-------------add by jillian 2006-8-28 start------------- if LinkFlag=0 then TempLink = TempLink & "

" end if '-------------add by jillian 2006-8-28 end------------- End if RsLink.Close Set RsLink=nothing CnbbrLink=TempLink End Function 'add by jillian 2006-9-25 for index Function CnbbrLink1(LinkOwner,LinkFlag) Dim Templink,RsLink,num TempLink="" if not isNum(LinkOwner) then Exit Function '-----modified by jillian 2006-5-17 start--------- if LinkFlag=0 then '友情链接：新增加的排在后面，有图片的排在无图片的前面 Sql="Select Cnbbr_Lid,Cnbbr_lWebName,Cnbbr_lWebUrl,Cnbbr_lWebLogo,Cnbbr_lDescription,Cnbbr_lisLogo,Cnbbr_lOwnerID from Cnbbr_Link where Cnbbr_lOwnerID="& LinkOwner &" order by Cnbbr_lIsLogo Desc,Cnbbr_Lid" else '-----modified by jillian 2006-5-17 end--------- Sql="Select Cnbbr_Lid,Cnbbr_lWebName,Cnbbr_lWebUrl,Cnbbr_lWebLogo,Cnbbr_lDescription,Cnbbr_lisLogo,Cnbbr_lOwnerID from Cnbbr_Link where Cnbbr_lOwnerID="& LinkOwner &" order by Cnbbr_lIsLogo Desc" '-----modified by jillian 2006-5-17 start--------- end if '-----modified by jillian 2006-5-17 end--------- num=0 Set RsLink=Conn.execute(Sql) if Not RsLink.Eof then Do While Not RsLink.Eof '-------------add by jillian 2006-8-28 start------------- if LinkFlag=0 then if num=0 then TempLink = TempLink & "

" else if num / 7 = int(num/7) then TempLink = TempLink & "

" else TempLink = TempLink & "

" end if '-------------add by jillian 2006-8-28 end------------- End if RsLink.Close Set RsLink=nothing CnbbrLink1=TempLink End Function Function Cnbbr_FiltrateIP Dim User_Ip User_Ip=Request.servervariables("REMOTE_ADDR") Dim IpArray,WhyIpLock IpArray=split(User_Ip,".") Dim IpSQL,IpRS IpSQL="SELECT iplock From Cnbbr_IpLock Where "& _ " (ipsame=4 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" and ip3="&Cint(IpArray(2))&" and ip4="&Cint(IpArray(3))&" ) "& _ " Or (ipsame=3 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" and ip3="&Cint(IpArray(2))&" ) "& _ " Or (ipsame=2 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" ) "& _ " Or (ipsame=1 and ip1="&Cint(IpArray(0))&" ) Order By ipid " Set IpRS=Conn.execute(IpSQL) If Not (IpRS.bof or IpRS.eof) Then WhyIpLock=split(IpRS("iplock"),"|") Response.Write"" & Vbcrlf Response.Write""& SYS_WEBNAME &"" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"

" & vbcrlf Response.Write"" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"

欢迎你访问"& SYS_WEBNAME &"！

" & Vbcrlf Response.Write"

封锁原因:"&WhyIpLock(1) Response.Write"
封锁时间:"&WhyIpLock(0) Response.Write"
你可以通过邮件与管理员联系

" Response.Write"

" & Vbcrlf Response.Write"" & Vbcrlf Response.Write"" & Vbcrlf Response.End End If Set IpRS=Nothing End Function %> <% if Sys_Status=0 then Response.Write"

"& Sys_StatusInfo &"" Response.End end if Cnbbr_FiltrateIP %> <% Sub Jmail(email,topic,mailbody) on error resume next dim JMail Set JMail=Server.CreateObject("JMail.Message") JMail.silent=true JMail.Logging=True JMail.Charset="gb2312" JMail.MailServerUserName = EMAILServerUser '您的邮件服务器登录名（一般为你的邮件地址） JMail.MailServerPassword = EMAILServerPass '您的邮件服务器登录密码 JMail.ContentType = "text/html" JMail.Priority =1 JMail.From = EMAILSENDER JMail.FromName = SYS_WEBNAME JMail.AddRecipient email JMail.Subject=topic JMail.Body=mailbody JMail.Send(EMAILSERVER) Set JMail=nothing if Err Then Response.Write Err.Description end sub %> <% 'Option Explicit '----------------------------------------- 'ASP生成缩略图（无组件） 'CopyRight by Cnbbr.com 22:21 2005-10-19 'Response.Write PixelPic(72,72,"BBR.gif") Function PixelPic(ByVal Old_Width,ByVal Old_Height,ByVal FilePath,ByVal NotImgPath) On Error Resume Next Dim Pho,New_Width,New_Height set Pho=new possible ' New_Width=Pho.readX(Server.MapPath(FilePath)) ' New_Height=Pho.readY(Server.MapPath(FilePath)) 'If New_Width="" Then New_Width=283 'End If 'If New_Height="" Then New_Height=283 'End if 'response.write New_Width&"," if New_Width>Old_Width then New_Height=New_Height * Old_Width / New_Width New_Width=Old_Width elseif New_Height>Old_Height then New_Width=New_Width * Old_Height / New_Height New_Height=Old_Height end if if Err then 'Response.write Err.Description PixelPic="" else PixelPic="" end if End Function '------------------------------------------ '以下为类文件，修改自网络资料 '感谢作者共享此代码 Cnbbrcom Class possible dim aso Private Sub Class_Initialize set aso=CreateObject("Adodb.Stream") aso.Mode=3 aso.Type=1 aso.Open End Sub Private Sub Class_Terminate set aso=nothing End Sub Private Function Bin2Str(Bin) Dim I, Str For I=1 to LenB(Bin) clow=MidB(Bin,I,1) if ASCB(clow)<128 then Str = Str & Chr(ASCB(clow)) else I=I+1 if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow)) end if Next Bin2Str = Str End Function Private Function Num2Str(num,base,lens) dim ret ret = "" while(num>=base) ret = (num mod base) & ret num = (num - num mod base)/base wend Num2Str = right(string(lens,"0") & num & ret,lens) End Function Private Function Str2Num(str,base) dim ret ret = 0 for i=1 to len(str) ret = ret *base + cint(mid(str,i,1)) next Str2Num=ret End Function Private Function BinVal(bin) dim ret,i ret = 0 for i = lenb(bin) to 1 step -1 ret = ret *256 + ascb(midb(bin,i,1)) next BinVal=ret End Function Private Function BinVal2(bin) dim ret,i ret = 0 for i = 1 to lenb(bin) ret = ret *256 + ascb(midb(bin,i,1)) next BinVal2=ret End Function Private Function getImageSize(filespec) dim ret(3),bFlag,p1 aso.LoadFromFile(filespec) bFlag=aso.read(3) select case hex(binVal(bFlag)) case "4E5089": aso.read(15) ret(0)="PNG" ret(1)=BinVal2(aso.read(2)) aso.read(2) ret(2)=BinVal2(aso.read(2)) case "464947": aso.read(3) ret(0)="GIF" ret(1)=BinVal(aso.read(2)) ret(2)=BinVal(aso.read(2)) case "535746": aso.read(5) binData=aso.Read(1) sConv=Num2Str(ascb(binData),2 ,8) nBits=Str2Num(left(sConv,5),2) sConv=mid(sConv,6) while(len(sConv)191 and p1<196 then exit do else aso.read(binval2(aso.Read(2))-2) do:p1=binVal(aso.Read(1)):loop while p1<255 and not aso.EOS loop while true aso.Read(3) ret(0)="JPG" ret(2)=binval2(aso.Read(2)) ret(1)=binval2(aso.Read(2)) case else: if left(Bin2Str(bFlag),2)="BM" then aso.Read(15) ret(0)="BMP" ret(1)=binval(aso.Read(4)) ret(2)=binval(aso.Read(4)) else ret(0)="" end if end select ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &"""" getimagesize=ret End Function Function readX(pic_path) Dim fso1,f1,ext,arr Set fso1 = server.CreateObject("Scripting.FileSystemObject") Set f1 = fso1.GetFile(pic_path) ext=fso1.GetExtensionName(pic_path) select case ext case "gif","bmp","jpg","png": arr=getImageSize(f1.path) case "swf" arr=Pho.getimagesize(f1.path) end Select readX=arr(1) Set f1=nothing Set fso1=nothing End Function Function readY(pic_path) Dim fso1,f1,ext,arr Set fso1 = server.CreateObject("Scripting.FileSystemObject") Set f1 = fso1.GetFile(pic_path) ext=fso1.GetExtensionName(pic_path) select case ext case "gif","bmp","jpg","png": arr=getImageSize(f1.path) case "swf" arr=Pho.getimagesize(f1.path) end select readY=arr(2) Set f1=nothing Set fso1=nothing End Function End Class %> <% '------------------------------------------ '更新函数定义 '----------------------- '处理拍卖结束时间小于系统刷新时间的商品 JILLIAN Sub CnbbrTempAuc() Call CnbbrTimer(0,Update_SYSTimes) End Sub '处理拍卖结束时间到的商品 JILLIAN Sub CnbbrDealWithAuc() 'Call CnbbrTimer(1,Update_SYSTimes+10) Call CnbbrTimer(1,20) 'modified by jillian 2006-10-24 End Sub '拍卖品过期处理 JILLIAN Sub CnbbrDelExpiresAuc() Call CnbbrTimer(2,1) End Sub '处理商品首页推荐 JILLIAN Function CnbbrUpdateStarAuc() Call CnbbrTimer(3,Update_SYSTimes+30) End Function '处理店铺首页推荐 JILLIAN Function CnbbrUpdateStarShop() Call CnbbrTimer(4,Update_SYSTimes+40) End Function '商品首页推荐 JILLIAN Function CnbbrStarAuc() Call CnbbrTimer(5,Update_TempAucTimes) CnbbrStarAuc=AppliCation("CnbbrStarAuc") End Function '店铺首页推荐 JILLIAN Function CnbbrStarShop() Call CnbbrTimer(6,Update_TempAucTimes+Update_TempAucTimes) CnbbrStarShop=AppliCation("CnbbrStarShop") End Function '处理新闻发布 JILLIAN Function CnbbrSysNews() Call CnbbrTimer(7,1) CnbbrSysNews=Application("CnbbrSysNews") End Function '处理将结束商品 JILLIAN Function CnbbrAucClosing() Call CnbbrTimer(8,Update_TempAucTimes+10) CnbbrAucClosing=Application("CnbbrAucClosing") End Function '处理新发布商品 JILLIAN Function CnbbrAucNew() Call CnbbrTimer(9,Update_TempAucTimes+20) CnbbrAucNew=Application("CnbbrAucNew") End Function '处理求购信息 JILLIAN Function CnbbrAucQiuGou() Call CnbbrTimer(10,Update_TempAucTimes+30) CnbbrAucQiuGou=Application("CnbbrAucQiuGou") End Function 'add by jillian for msg 2006-10-20 start '处理短消息 JILLIAN Function CnbbrMessage() Call CnbbrTimer(11,Update_TempAucTimes+30) 'CnbbrMessage=Application("CnbbrMessage") End Function 'add by jillian for msg 2006-10-20 end '-------------------------------------- '定时器函数定义 '----------------------- Sub CnbbrTimer(Content,Times) Dim strLastUpdate Select Case Content Case 0: '处理拍卖结束时间小于系统刷新时间的商品 JILLIAN if not IsDate(Application("CnbbrAK0")) then Application("CnbbrAK0")=Cdate("2000-1-1 00:00:00") strLastUpdate=Application("CnbbrAK0") If (strLastUpdate="") Or (Times "" then sql="select * from msg where msgstatus=0 and ownerid= " & Request.Cookies(super_user)("uid") set rs=server.createobject("adodb.recordset") rs.open sql,conn,1,1 CnbbrConnTimes if Not rs.eof then response.write "您有 " & rs.recordcount & " 条新短消息，请注意查看！ " 'response.write "" 'Response.End else response.write " " end if else response.write " " end if End Sub '将拍卖结束时间小于系统刷新时间的商品ID保存到临时表Cnbbr_TempAuc中 JILLIAN Sub Cnbbr_TempAuc() Sql="Delete"& SqlDiff &"from Cnbbr_TempAuc" Conn.Execute(sql) set rs=server.createobject("adodb.recordset") if IsSqlDataBase=1 then sql="select AucId,AucCloseDate from Auctions where Aucended='N' and DateDiff(s, "& SqlNowString &", AucCloseDate)<="& Update_SysTimes else sql="select AucId,AucCloseDate from Auctions where Aucended='N' and DateDiff('s', "& SqlNowString &", AucCloseDate)<="& Update_SysTimes end if rs.open sql,conn,1,1 CnbbrConnTimes if Not rs.eof then do while not rs.eof Sql="Insert Into Cnbbr_TempAuc (TAucid,TAucCloseDate) values ('"& Rs("AucID") &"','"& Rs("AucCloseDate") &"')" Conn.Execute(sql) rs.movenext loop end if End Sub '处理拍卖结束时间到的商品，成功拍卖的，发邮件(一口价不在这里发邮件)；未成功拍卖的，自动上架 JILLIAN '2006-9-4 取消自动上架功能 JILLIAN Sub Cnbbr_DealWithAuc() If IsSqlDataBase = 1 Then sql="select * from AucTions where AucEnded='N' and (datediff(s,Aucclosedate,"&SqlNowString&")>0) and AucId in (Select TAucID from Cnbbr_TempAuc)" else sql="select * from AucTions where AucEnded='N' and (datediff('s',Aucclosedate,"&SqlNowString&")>0) and AucId in (Select TAucID from Cnbbr_TempAuc)" end if Dim rsup : set rsup=server.createobject("adodb.recordset") rsup.Open sql,conn,1,3 CnbbrConnTimes if not rsup.eof then Do While Not rsup.eof Dim BBR_AucTime if RsUP("aucType")=2 then if RsUp("aucNum")=0 then rsup("aucended")="Y" rsUp("BBR_Auc_Success")=1 rsup("aucnum")=0 rsup("aucclosedate")=now() rsup.update else '到期未拍卖完商品，自动上架，时间累计 JILLIAN '-------------- modified by jillian 2006-9-4 取消自动上架功能 START ----------------- 'BBR_AucTime=Datediff("d",RsUp("aucavaildate"),RsUp("aucCloseDate")) 'BBR_AucTime=DateAdd("d",BBR_AucTime,RsUp("aucClosedate")) 'RsUp("aucCloseDate")=BBR_AucTime 'RsUp.Update rsup("aucended")="Y" rsUp("BBR_Auc_Success")=1 rsup("aucclosedate")=now() rsup.update Call EmailForTODateAuc(RsUp("AucItemTitle"),RsUp("AucID"),RsUp("AucItemOwner")) '-------------- modified by jillian 2006-9-4 取消自动上架功能 end ----------------- end if else Dim BBR_BidTimesCount:BBR_BidTimesCount=Rsup("bidtimes")+Rsup("ykjbidtimes") if rsup("auccurrentbid")>=rsup("aucreserveprice") and BBR_BidTimesCount>0 then '可能有错，没有验证拍卖件数 JILLIAN 2006-4-27 rsup("aucended")="Y" rsUp("BBR_Auc_Success")=1 rsup("aucnum")=0 rsup("aucclosedate")=now() rsup.update sql = "insert into cnBBR_Appraise (Cnbbr_aAucID,Cnbbr_aAucItemTitle,Cnbbr_aAucOwnerID,Cnbbr_aAucBuyerId,Cnbbr_aAucBid,Cnbbr_aAucDate,Cnbbr_aOwnerCredit,Cnbbr_aOwnerContent,Cnbbr_aOwnerDate,Cnbbr_aOwnerStatus,Cnbbr_aBuyerCredit,Cnbbr_aBuyerContent,Cnbbr_aBuyerDate,Cnbbr_aBuyerStatus)" & _ " values ("& rsup("AucID") &", '"& rsup("AucItemTitle") &"', "& Rsup("AucItemOwner") &", "& Rsup("AucCurrentBidder") &","& RsUp("AucCurrentBid") &",'"& now() &"', 0,'未评价', '"& now() &"',0, 0,'未评价', '"& now() &"',0)" conn.execute(sql) CnbbrConnTimes Call EmailForAuc(RsUp("AucItemTitle"),RsUp("AucID"),RsUp("AucItemOwner"),RsUp("AucCurrentBidder")) else '到期未拍卖完商品，自动上架，时间累计 JILLIAN '-------------- modified by jillian 2006-9-4 取消自动上架功能 START ----------------- 'BBR_AucTime=Datediff("d",RsUp("aucavaildate"),RsUp("aucCloseDate")) 'BBR_AucTime=DateAdd("d",BBR_AucTime,RsUp("aucClosedate")) 'RsUp("aucCloseDate")=BBR_AucTime 'RsUp.Update rsup("aucended")="Y" rsUp("BBR_Auc_Success")=1 rsup("aucnum")=0 rsup("aucclosedate")=now() rsup.update Call EmailForTODateAuc(RsUp("AucItemTitle"),RsUp("AucID"),RsUp("AucItemOwner")) '-------------- modified by jillian 2006-9-4 取消自动上架功能 end ----------------- End if end if rsup.movenext Loop end if rsup.close set rsup=nothing End Sub '过期商品处理，删除操作 Sub Cnbbr_DelExpiresAuc() If IsSqlDataBase = 1 Then sql="select aucid,BBR_ClassPath from auctions where datediff(d,aucclosedate,"& SqlNowString &")>"& autodel &" and aucended='Y'" else sql="select aucid,BBR_ClassPath from auctions where datediff('d',aucclosedate,"& SqlNowString &")>"& autodel &" and aucended='Y'" end if Dim Rs_Del,Temp_DelID Set Rs_Del=Server.CreateObject("ADODB.RecordSet") Rs_Del.Open Sql,conn,1,3 CnbbrConnTimes if Not Rs_Del.Eof then Do While Not Rs_Del.Eof Temp_DelID=Temp_DelID & Rs_Del("AucID") & "," Dim BBR_ClassPath BBR_ClassPath=Replace(Rs_Del("BBR_ClassPath"),"|",",") Call CnBBR_AucClass_Amount(BBR_ClassPath,0) Rs_Del.MoveNext Loop Temp_DelID=Left(Temp_DelID,len(Temp_DelID)-1) Sql="delete"& SqlDiff &"from aucImages where AucID in ("& Temp_DelID &")" Conn.Execute(sql) Sql="delete"& SqlDiff &"from Bids where BidItemID in ("& Temp_DelID &")" Conn.Execute(sql) Sql="delete"& SqlDiff &"from YkjBids where YkjBidItemID in ("& Temp_DelID &")" Conn.Execute(sql) Sql="delete"& SqlDiff &"from AucImages where AucID in ("& Temp_DelID &")" Conn.Execute(sql) Sql="delete"& SqlDiff &"from msg where AucID in ("& Temp_DelID &")" Conn.Execute(sql) 'Sql="delete"& SqlDiff &"from pingjia where AucID in ("& Temp_DelID &")" Sql="delete"& SqlDiff &"from Cnbbr_Appraise where Cnbbr_aAucID in ("& Temp_DelID &")" Conn.Execute(sql) Sql="delete"& SqlDiff &"from Auctions where AucID in ("& Temp_DelID &")" Conn.Execute(sql) End if Rs_Del.Close Set Rs_Del=nothing End Sub '处理商品首页推荐 JILLIAN Function Cnbbr_UpdateStarAuc() Sql="Delete"& SqlDiff &"from Cnbbr_TempStarAuc" Conn.Execute(sql) set rs=server.createobject("adodb.recordset") if IsSqlDataBase=1 then Sql="select AucId,BBR_AdminCommend,BBR_AucComBid,BBR_AucComEndTime from Auctions where Aucended='N' and BBR_AdminCommend>=1 and DateDiff(s,"& SqlNowString &",BBR_AucComEndTime)>0" else Sql="select AucId,BBR_AdminCommend,BBR_AucComBid,BBR_AucComEndTime from Auctions where Aucended='N' and BBR_AdminCommend>=1 and DateDiff('s',"& SqlNowString &",BBR_AucComEndTime)>0" end if rs.open sql,conn,1,3 CnbbrConnTimes if Not rs.eof then i=0 do while not rs.eof Dim TempTimeDiff TempTimeDiff=DateDiff("s",Rs("BBR_AucComEndTime"),now()) if TempTimeDiff<0 then Sql="Insert Into Cnbbr_TempStarAuc (Cnbbr_StarAucid,Cnbbr_StarAucBid,Cnbbr_StarAucDate) values ('"& Rs("AucID") &"','"& Rs("BBR_AucComBid") &"','"& Rs("BBR_AucComEndTime") &"')" Conn.Execute(sql) i=i+1 if i>=Cnbbr_IndexStarAucPerRow*Cnbbr_IndexStarAucRow then Exit Do else Rs("BBR_AdminCommend")=0 Rs("BBR_AucComBid")=0 Rs("BBR_AucComEndTime")=now() Rs.Update end if rs.movenext loop end if End Function '处理店铺首页推荐 JILLIAN Function Cnbbr_UpdateStarShop() Sql="Delete"& SqlDiff &"from Cnbbr_TempStarShop" Conn.Execute(sql) set rs=server.createobject("adodb.recordset") if IsSqlDataBase=1 then Sql="select ShopId,BBR_ShopCommend,BBR_ShopComBid,BBR_ShopComEndTime from Shops where BBR_ShopCommend>=1 and DateDiff(s,"& SqlNowString &",BBR_ShopComEndTime)>0" else Sql="select ShopId,BBR_ShopCommend,BBR_ShopComBid,BBR_ShopComEndTime from Shops where BBR_ShopCommend>=1 and DateDiff('s',"& SqlNowString &",BBR_ShopComEndTime)>0" end if rs.open sql,conn,1,1 CnbbrConnTimes if Not rs.eof then i=0 do while not rs.eof Dim TempTimeDiff TempTimeDiff=DateDiff("s",now(),Rs("BBR_ShopComEndTime")) if TempTimeDiff>0 then Sql="Insert Into Cnbbr_TempStarShop (Cnbbr_StarShopid,Cnbbr_StarShopBid,Cnbbr_StarShopDate) values ("& Rs("ShopID") &","& Rs("BBR_ShopComBid") &",'"& Rs("BBR_ShopComEndTime") &"')" Conn.Execute(sql) i=i+1 if i>=Cnbbr_IndexStarShopPerRow*Cnbbr_IndexStarShopRow then Exit Do else Rs("BBR_ShopCommend")=0 Rs("BBR_ShopComBid")=0 Rs("BBR_ShopComEndTime")=now() Rs.Update end if rs.movenext loop end if End Function '/////////////////////////////////////////////////////////////////////////首页推荐 '商品首页推荐 JILLIAN Function Cnbbr_StarAuc() if IsSqlDataBase=1 then Sql="delete "&SqlDiff&" from Cnbbr_TempStarAuc where DateDiff(s,Cnbbr_StarAucDate,"& SqlNowString &")>=0" else Sql="delete "&SqlDiff&" from Cnbbr_TempStarAuc where DateDiff('s',Cnbbr_StarAucDate,"& SqlNowString &")>=0" end if Conn.Execute(Sql) Dim Cnbbr_RowNum,Cnbbr_perRowNum,Cnbbr_AucCommendStr Cnbbr_RowNum=Cnbbr_IndexStarAucRow Cnbbr_PerRowNum=Cnbbr_IndexStarAucPerRow Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" set rs=server.createobject("ADODB.recordset") sql="Select AucId,AucImageurl,AucItemTitle,AucCurrentBid,BBR_AliPayStatus from auctions where aucended='N' and Auctype in ("& SYS_MODEL &") and AucID in (select top "&Cnbbr_RowNum*Cnbbr_PerRowNum&" CnBBR_StarAucID from Cnbbr_TempStarAuc) order by BBR_AdminCommend Desc,BBR_AucComBid Desc,BBR_AucComEndTime Desc" ' response.write sql rs.open sql,conn,1,1 CnbbrConnTimes if rs.eof or rs.bof then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" else i=0 Do while not rs.eof Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" i=i+1 if i>=Cnbbr_RowNum*Cnbbr_PerRowNum then Exit Do if i mod Cnbbr_PerRowNum=0 then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" End if rs.MoveNext Loop j=Cnbbr_PerRowNum-i mod Cnbbr_PerRowNum if j>0 and j" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

商品推荐位置还空着哦,赶快抢先推荐你的商品!

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" 'Cnbbr_AucCommendStr=Cnbbr_AucCommendStr & Disp_AucImages(Rs("AucID"),0) '0:14 2005-10-20 cnbbr.com Cnbbr_AucCommendStr=Cnbbr_AucCommendStr & BBRAucSmallImage(Rs("AucID"),0,0,"Skins/"& SKins_Folder &"/nopic.gif") Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" 'modified by jillian 2006-5-25 start 'k=interceptString(rs("aucItemtitle"),25) k=interceptString(rs("aucItemtitle"),25) 'modified by jillian 2006-5-25 end Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &""& k &"
" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"￥"& FormatNumber(Rs("AucCurrentBid"),2,-1) & Vbcrlf if Rs("BBR_AlipayStatus")=1 then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &" "& Vbcrlf Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"·暂无商品" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Next end if end if Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_StarAuc=Cnbbr_AucCommendStr End Function '商品首页推荐 JILLIAN ADD BY JILLIAN 2006-9-15 Function Cnbbr_StarAuc1() if IsSqlDataBase=1 then Sql="delete "&SqlDiff&" from Cnbbr_TempStarAuc where DateDiff(s,Cnbbr_StarAucDate,"& SqlNowString &")>=0" else Sql="delete "&SqlDiff&" from Cnbbr_TempStarAuc where DateDiff('s',Cnbbr_StarAucDate,"& SqlNowString &")>=0" end if Conn.Execute(Sql) Dim Cnbbr_RowNum,Cnbbr_perRowNum,Cnbbr_AucCommendStr,TempWidth Cnbbr_RowNum=3 Cnbbr_PerRowNum=4 TempWidth=Clng(100/Cnbbr_PerRowNum) Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" set rs=server.createobject("ADODB.recordset") sql="Select AucId,AucImageurl,AucItemTitle,AucCurrentBid,BBR_AliPayStatus from auctions where aucended='N' and Auctype in ("& SYS_MODEL &") and AucID in (select top "&Cnbbr_RowNum*Cnbbr_PerRowNum&" CnBBR_StarAucID from Cnbbr_TempStarAuc) order by BBR_AdminCommend Desc,BBR_AucComBid Desc,BBR_AucComEndTime Desc" ' response.write sql rs.open sql,conn,1,1 CnbbrConnTimes if rs.eof or rs.bof then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" else i=0 Do while not rs.eof Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" i=i+1 if i>=Cnbbr_RowNum*Cnbbr_PerRowNum then Exit Do if i mod Cnbbr_PerRowNum=0 then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" End if rs.MoveNext Loop j=Cnbbr_PerRowNum-i mod Cnbbr_PerRowNum if j>0 and j" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

商品推荐位置还空着哦,赶快抢先推荐你的商品!

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"·暂无商品" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Next end if end if Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_StarAuc1=Cnbbr_AucCommendStr End Function '商品首页推荐 JILLIAN ADD BY JILLIAN 2006-9-20 Function Cnbbr_StarAuc2() if IsSqlDataBase=1 then Sql="delete "&SqlDiff&" from Cnbbr_TempStarAuc where DateDiff(s,Cnbbr_StarAucDate,"& SqlNowString &")>=0" else Sql="delete "&SqlDiff&" from Cnbbr_TempStarAuc where DateDiff('s',Cnbbr_StarAucDate,"& SqlNowString &")>=0" end if Conn.Execute(Sql) Dim Cnbbr_RowNum,Cnbbr_perRowNum,Cnbbr_AucCommendStr,TempWidth Cnbbr_RowNum=2 Cnbbr_PerRowNum=4 TempWidth=Clng(100/Cnbbr_PerRowNum) Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" set rs=server.createobject("ADODB.recordset") sql="Select AucId,AucImageurl,AucItemTitle,AucCurrentBid,BBR_AliPayStatus from auctions where aucended='N' and Auctype in ("& SYS_MODEL &") and AucID in (select top "&Cnbbr_RowNum*Cnbbr_PerRowNum&" CnBBR_StarAucID from Cnbbr_TempStarAuc) order by BBR_AdminCommend Desc,BBR_AucComBid Desc,BBR_AucComEndTime Desc" ' response.write sql rs.open sql,conn,1,1 CnbbrConnTimes if rs.eof or rs.bof then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" else i=0 Do while not rs.eof Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" i=i+1 if i>=Cnbbr_RowNum*Cnbbr_PerRowNum then Exit Do if i mod Cnbbr_PerRowNum=0 then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" End if rs.MoveNext Loop j=Cnbbr_PerRowNum-i mod Cnbbr_PerRowNum if j>0 and j" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

商品推荐位置还空着哦,赶快抢先推荐你的商品!

" 'modified by jillian 2006-5-25 start 'k=interceptString(rs("aucItemtitle"),25) k=interceptString(rs("aucItemtitle"),12) 'modified by jillian 2006-5-25 end Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &""& k &"
" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"￥"& FormatNumber(Rs("AucCurrentBid"),2,-1) & Vbcrlf if Rs("BBR_AlipayStatus")=1 then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &" "& Vbcrlf Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"·暂无商品" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Next end if end if Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_StarAuc2=Cnbbr_AucCommendStr End Function '新进商品图片显示 2006-9-27 add by jillian Function display_aucnew_pic() Dim Cnbbr_RowNum,Cnbbr_perRowNum,Cnbbr_AucCommendStr,TempWidth Cnbbr_RowNum=3 Cnbbr_PerRowNum=6 TempWidth=Clng(100/Cnbbr_PerRowNum) Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" set rs=server.createobject("ADODB.recordset") sql="Select top "&Cnbbr_RowNum*Cnbbr_PerRowNum&" AucId,AucImageurl,AucItemTitle,AucCurrentBid,BBR_AliPayStatus from auctions where aucended<>'Y' and aucImageURL<>0 order by aucavaildate desc" ' response.write sql rs.open sql,conn,1,1 'CnbbrConnTimes if rs.eof or rs.bof then 'Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" else i=0 Do while not rs.eof Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" i=i+1 if i>=Cnbbr_RowNum*Cnbbr_PerRowNum then Exit Do if i mod Cnbbr_PerRowNum=0 then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" End if rs.MoveNext Loop j=Cnbbr_PerRowNum-i mod Cnbbr_PerRowNum if j>0 and j" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

商品推荐位置还空着哦,赶快抢先推荐你的商品!

" 'modified by jillian 2006-5-25 start 'k=interceptString(rs("aucItemtitle"),25) k=interceptString(rs("aucItemtitle"),25) 'modified by jillian 2006-5-25 end Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

"& k &"
" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"￥"& FormatNumber(Rs("AucCurrentBid"),2,-1) & Vbcrlf if Rs("BBR_AlipayStatus")=1 then Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"	"& Vbcrlf Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"·暂无商品" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"

" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Next end if end if Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" Cnbbr_AucCommendStr=Cnbbr_AucCommendStr &"" display_aucnew_pic= Cnbbr_AucCommendStr End Function '店铺首页推荐 JILLIAN Function Cnbbr_StarShop() if IsSqlDataBase=1 then Sql="delete "&SqlDiff&" from Cnbbr_TempStarShop where DateDiff(s,Cnbbr_StarShopDate,"& SqlNowString &")>=0" else Sql="delete "&SqlDiff&" from Cnbbr_TempStarShop where DateDiff('s',Cnbbr_StarShopDate,"& SqlNowString &")>=0" end if Conn.Execute(Sql) Dim Cnbbr_RowNum,Cnbbr_perRowNum,Cnbbr_ShopCommendStr Cnbbr_RowNum=Cnbbr_IndexStarShopRow Cnbbr_PerRowNum=Cnbbr_IndexStarShopPerRow Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" sql="Select ShopID,ShopImage,ShopName from Shops where BBR_ShopCommend>=1 and ShopID in (select top "&Cnbbr_RowNum*Cnbbr_PerRowNum&" CnBBR_StarShopID from Cnbbr_TempStarShop) order by BBR_SHopCommend Desc,BBR_ShopComBid Desc,BBR_ShopComEndTime Desc" set rs=conn.execute(sql) CnbbrConnTimes if rs.eof or rs.bof then if IsSqlDataBase=1 then Sql="update shops set BBR_ShopCommend=0 where BBR_ShopCommend>=1 and DateDiff(s,BBR_ShopComEndTime,"& SqlNowString &")>0" else Sql="update shops set BBR_ShopCommend=0 where BBR_ShopCommend>=1 and DateDiff('s',BBR_ShopComEndTime,"& SqlNowString &")>0" end if Conn.execute(Sql) Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" else i=0 Do while not rs.eof Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" i=i+1 rs.MoveNext if i>Cnbbr_RowNum*Cnbbr_PerRowNum then Exit Do if i mod Cnbbr_PerRowNum=0 then Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" end if Loop k=Cnbbr_PerRowNum-i mod Cnbbr_PerRowNum if k>0 and k" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

首页店铺位置还空着呢，赶快推荐你的店铺哦！

" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " 'modified by jillian 2006-5-25 start 'k=interceptString(rs("shopname"),20) k=interceptString(rs("shopname"),28) 'modified by jillian 2006-5-25 end Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

" if IsNull(Rs("ShopImage")) then Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" else Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

" End if Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

"& k &"

" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

你的店铺位置

首页店铺位置还空着呢，赶快推荐你的店铺哦！

" if IsNull(Rs("ShopImage")) then Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" else Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

" End if Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

"& k &"

" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &" " Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"

你的店铺位置

" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" Next end if end if Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" Cnbbr_ShopCommendStr=Cnbbr_ShopCommendStr &"" Cnbbr_StarShop1=Cnbbr_ShopCommendStr End Function '--------------------------------------------- '处理将结束商品 JILLIAN Function Cnbbr_AucClosing() Dim EndAucStr set rs=server.createobject("adodb.recordset") sql="select top 10 aucitemtitle,aucavaildate,aucid,aucclick from auctions where aucended<>'Y' and auctype In (" & SYS_MODEL & ") order by aucClosedate" rs.open sql,conn,1,1 CnbbrConnTimes if rs.eof then EndAucStr=EndAucStr &" 还没有商品" else i=1 Dim Content do while not rs.eof content=InterCeptString(rs("aucitemtitle"),BBR_StrLen) EndAucStr=EndAucStr &" "& content &"
" i=i+1 if i>indexperpage then exit do rs.movenext loop end if Cnbbr_AucClosing=EndAucStr End Function '处理新发布商品 JILLIAN Function Cnbbr_AucNew() Dim AucNewStr set rs=server.createobject("adodb.recordset") sql="select top 10 aucitemtitle,aucavaildate,aucid,aucclick from auctions where aucended<>'Y' and auctype In (" & SYS_MODEL & ") order by aucavaildate desc" rs.open sql,conn,1,1 CnbbrConnTimes if rs.eof then AucNewStr=AucNewStr &" 还没有商品" else i=1 Dim Content do while not rs.eof content=InterCeptString(rs("aucitemtitle"),BBR_StrLen) AucNewStr=AucNewStr &" "& content &"
" i=i+1 if i>indexperpage then exit do rs.movenext loop end if Cnbbr_AucNew=AucNewStr End Function '处理新闻发布 JILLIAN Function Cnbbr_SysNews() Dim SysNewsStr set rs=server.createobject("adodb.recordset") sql="select top 10 * from news where newsauthor=0 and BBR_IsHelp=0 order by updatetime desc" rs.open sql,conn,1,1 CnbbrConnTimes if rs.eof then SysNewsStr=SysNewsStr &"· 还没有新闻" else i=1 Dim Content do while not rs.eof content=InterCeptString(rs("newstitle"),38) SysNewsStr=SysNewsStr &"·"& content &"
" i=i+1 if i>5 then exit do rs.movenext loop end if Cnbbr_SysNews=SysNewsStr End Function '处理供求信息 JILLIAN Function Cnbbr_AucQiuGou() Dim QiuGouStr set rs=server.createobject("adodb.recordset") sql="select top 10 * from qiugou order by qgupdatetime Desc,qgclick Desc" rs.open sql,conn,1,1 CnbbrConnTimes if rs.eof then QiuGouStr=QiuGouStr &" 还没有求购信息" else i=1 Dim Content do while not rs.eof content=InterCeptString(rs("qgtitle"),BBR_StrLen) QiuGouStr=QiuGouStr &" "& content &"
" i=i+1 if i>indexperpage then exit do rs.movenext loop end if Cnbbr_AucQiuGou=QiuGouStr End Function '-------------------------- '系统模板更新 '-------------------------- Function Cnbbr_Head_Function Dim Rs_BBRTemplate Dim Cnbbr_Head_Str,Second_Str,Cnbbr_Head_EndStr Set Rs_BBRTemplate=Conn.Execute("Select BBR_TemplateID,BBR_TemplatePath,BBR_TempLateTop from Cnbbr_Template where BBR_TemplatePath='"& Skins_Folder &"'") CnbbrConnTimes if Rs_BBRTemplate.Eof then Response.Write "当前模板 "& Skins_Folder &" 配置有误，请检查！" Response.End else Cnbbr_Head_Str=Rs_BBRTemplate("BBR_TemplateTop") Cnbbr_Head_Str=HtmlEncode(Cnbbr_Head_Str) if Instr(Cnbbr_Head_Str,"|||")=0 or Instr(Cnbbr_Head_Str,"|||")=null then Response.Write "当前模板语法有误，请检查Top|||！" Response.End else Cnbbr_Head_Str=Split(Cnbbr_Head_Str,"|||") For i=0 to Ubound(Cnbbr_Head_Str) if Instr(Cnbbr_Head_Str(i),"|@|")=0 or Instr(Cnbbr_Head_Str(i),"|@|")=null then Response.Write "当前模板语法有误，请检查Top|@|！" Response.End else Second_Str=Split(Cnbbr_Head_Str(i),"|@|") if i<2 then Cnbbr_Head_EndStr=Cnbbr_Head_EndStr & Second_Str(1) else Cnbbr_Head_EndStr=Replace(Cnbbr_Head_EndStr,Second_Str(0),Second_Str(1)) end if end if Next End if Cnbbr_Head_EndStr=ReHtmlEncode(Cnbbr_Head_EndStr) end if Cnbbr_Head_Function=Cnbbr_Head_EndStr Rs_BBRTemplate.Close Set Rs_BBRTemplate=nothing End Function Function Cnbbr_Bottom_Function Dim Rs_BBRTemplate Dim Cnbbr_Bottom_Str,Second_Str,Cnbbr_Bottom_EndStr Set Rs_BBRTemplate=Conn.Execute("Select BBR_TemplateID,BBR_TemplatePath,BBR_TempLateBottom from Cnbbr_Template where BBR_TemplatePath='"& Skins_Folder &"'") CnbbrConnTimes if Rs_BBRTemplate.Eof then Response.Write "当前模板 "& Skins_Folder &" 配置有误，请检查！" Response.End else Cnbbr_Bottom_Str=Rs_BBRTemplate("BBR_TemplateBottom") Cnbbr_Bottom_Str=HtmlEncode(Cnbbr_Bottom_Str) if Instr(Cnbbr_Bottom_Str,"|||")=0 or Instr(Cnbbr_Bottom_Str,"|||")=null then Response.Write "当前模板语法有误，请检查Bottom|||！" Response.End else Cnbbr_Bottom_Str=Split(Cnbbr_Bottom_Str,"|||") For i=0 to Ubound(Cnbbr_Bottom_Str) if Instr(Cnbbr_Bottom_Str(i),"|@|")=0 or Instr(Cnbbr_Bottom_Str(i),"|@|")=null then Response.Write "当前模板语法有误，请检查Bottom|@|！" Response.End else Second_Str=Split(Cnbbr_Bottom_Str(i),"|@|") if i<2 then Cnbbr_Bottom_EndStr=Cnbbr_Bottom_EndStr & Second_Str(1) else Cnbbr_Bottom_EndStr=Replace(Cnbbr_Bottom_EndStr,Second_Str(0),Second_Str(1)) end if end if Next End if Cnbbr_Bottom_EndStr=ReHtmlEncode(Cnbbr_Bottom_EndStr) end if Cnbbr_Bottom_Function=Cnbbr_Bottom_EndStr Rs_BBRTemplate.Close Set Rs_BBRTemplate=nothing End Function Function BBR_SysSkinsContent() Dim RsAdminSkins,TempSkins Sql="Select Cnbbr_Skins.BBR_SkinsID,Cnbbr_Skins.BBR_TemplateID,Cnbbr_Skins.BBR_SkinsCssName,Cnbbr_Skins.BBR_SkinsCssPath,Cnbbr_Skins.BBR_SkinsCssUrl,Cnbbr_Template.BBR_TemplateName,Cnbbr_Template.BBR_TemplatePath from Cnbbr_Skins left join Cnbbr_Template on Cnbbr_Skins.BBR_TemplateID=Cnbbr_Template.BBR_TemplateID" Set RsAdminSkins=Conn.Execute(Sql) CnbbrConnTimes if RsAdminSkins.Bof or RsAdminSkins.Eof then TempSkins="没有找到相应的系统模板，请先添加系统模板" else TempSkins=TempSkins &" "& Vbcrlf TempSkins=TempSkins &"

"& Vbcrlf TempSkins=TempSkins &" "& Vbcrlf TempSkins=TempSkins &" "& Vbcrlf TempSkins=TempSkins &" "& Vbcrlf TempSkins=TempSkins &" "& Vbcrlf Do While Not RsAdminSkins.Eof TempSkins=TempSkins &" "& Vbcrlf TempSkins=TempSkins &" "& Vbcrlf TempSkins=TempSkins &" "& Vbcrlf RsAdminSkins.MoveNext Loop TempSkins=TempSkins &"

"& Vbcrlf TempSkins=TempSkins &" "& RsAdminSkins("BBR_SkinsCssName") &"---"& RsAdminSkins("BBR_TemplateName") &"
"& Vbcrlf TempSkins=TempSkins &"

"& Vbcrlf TempSkins=TempSkins &"

"& Vbcrlf end if RsAdminSkins.Close Set RsAdminSkins=nothing BBR_SysSkinsContent=Trim(TempSkins) End Function %> <% CnbbrTempAuc CnbbrDealWithAuc CnbbrUpdateStarAuc CnbbrUpdateStarShop Function seller_payforauc(sellerid,boughtprice) Dim Rs_PayFor set rs_payfor=server.createobject("ADODB.recordset") sql="select bbrmoney from users where regid="& sellerid rs_payfor.open sql,conn,1,3 if Not rs_payfor.eof then pay_money=cdbl(boughtprice*0.03) if rs_payfor("bbrmoney")>=pay_money then rs_payfor("bbrmoney")=rs_payfor("bbrmoney")-pay_money rs_payfor.update else rs_payfor("bbrmoney")=0 rs_payfor.update end if end if rs_payfor.close set rs_payfor=nothing End Function '发送商品到期信息邮件 JILLIAN 2006-9-4 Function EmailForTODateAuc(AucTitle,AucID,SellerID) Dim Rs_Users set rs_Users=server.createobject("ADODB.recordset") sql="select regid,regusername,regemail from users where regid = " & SellerID rs_Users.open sql,conn,1,1 if rs_Users.eof or rs_Users.RecordCount< 1 then rs_Users.close set rs_Users=nothing Exit Function else Dim RegEmail_S,UName_S RegEmail_s=Rs_Users("RegEmail") UName_s=Rs_Users("RegUserName") rs_Users.close set rs_Users=nothing AucTitle=AucTitle if SendAucEmail=1 then Dim MailTo,MailTopic,MailBody MailTo=RegEmail_S MailTopic="你在"& SYS_WEBNAME &"上的商品已经到期！" MailBody="" MailBody=MailBody & "" MailBody=MailBody & ""&SYS_WEBNAME&"商品到期提醒邮件" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & "

"& SYS_WEBNAME &"" MailBody=MailBody & " | 帮助中心

" MailBody=MailBody & "
" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

请确认您的商品相关信息

亲爱的"& UName_S &"，您好：

" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

"& SYS_WEBNAME &"已经收到您的商品到期信息！
以下是您的该商品相关信息，如果这些信息不正确的话，请删除此信。" MailBody=MailBody & "
" MailBody=MailBody & "
" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

" MailBody=MailBody & "商品名称："& AucTitle &"
" MailBody=MailBody & "

" MailBody=MailBody & " 你的商品已经到拍卖结束日期，现无人参与竞价，若要继续拍卖该商品，请尽快登陆网站将该商品重新上架或重新发布商品信息！谢谢你的支持！" MailBody=MailBody & "

方法：登陆网站后，点击<我的店铺> --> <我是卖家> --> <未拍卖成功商品>，选择你要重新上架的商品，点击<重新上架> 按钮。" MailBody=MailBody & "

" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & " " MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

该邮件由"& SYS_WEBNAME &"系统发出，系统不接受回信，因此请勿直接回复。" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" Dim SendBBRMail SendBBRMail=True if comp_check("JMAIL.SMTPMail") then Call JMail(MailTo,MailTopic,MailBody) elseif comp_check("CDONTS.NewMail") then Call CDonts(MailTo,MailTopic,MailBody) elseif comp_check("ASPMAIL.ASPMailCtrl.1") then Call AspEmail(MailTo,MailTopic,MailBody) else SendBBRMail=False end if end if End if End Function '发送交易信息邮件 JILLIAN Function EmailForAuc(AucTitle,AucID,SellerID,BuyerID) Dim Rs_Users set rs_Users=server.createobject("ADODB.recordset") '-------DELETED BY JILLIAN 2006-4-27 'sql="select regusername,regemail from users where regid in ("& SellerID &","& BuyerID &")" '------------------------------- '-------ADDED BY JILLIAN 2006-4-27 sql="select regid,regusername,regemail from users where regid in ("& SellerID &","& BuyerID &")" '------------------------------- rs_Users.open sql,conn,1,1 if rs_Users.eof or rs_Users.RecordCount<2 then rs_Users.close set rs_Users=nothing Exit Function else Dim RegEmail_S,RegEmail_B,UName_S,UName_B '定义买家和卖家的邮件地址，处理上有漏洞 JILLIAN 2006-4-27 DELETED ' RegEmail_S=Rs_Users("RegEmail") ' UName_S=Rs_Users("RegUserName") ' ' Rs_Users.MoveNext ' ' RegEmail_B=Rs_Users("RegEmail") ' UName_B=Rs_Users("RegUserName") '----------------------------------------------------------------------------------------------------------------- '定义买家和卖家的邮件地址 JILLIAN 2006-4-27 ADDED Rs_Users.MoveFirst Do While Not Rs_Users.eof if Rs_Users("RegId") = SellerID then RegEmail_S=Rs_Users("RegEmail") UName_S=Rs_Users("RegUserName") else RegEmail_B=Rs_Users("RegEmail") UName_B=Rs_Users("RegUserName") end if Rs_Users.MoveNext Loop '----------------------------------------------------------------------------------------------------------------- rs_Users.close set rs_Users=nothing AucTitle=AucTitle if SendAucEmail=1 then Dim MailTo,MailTopic,MailBody MailTo=RegEmail_S MailTopic="你在"& SYS_WEBNAME &"上的商品已经被用户"& Uname_B &"成功拍下！" MailBody="" MailBody=MailBody & "" MailBody=MailBody & ""&SYS_WEBNAME&"商品交易提醒邮件" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & "

"& SYS_WEBNAME &"" MailBody=MailBody & " | 帮助中心

请确认您的交易相关信息

亲爱的"& UName_S &"，您好：

" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

"& SYS_WEBNAME &"已经收到您的交易信息！请你主动与对方取得联系并完成交易！
以下是您此次交易相关信息，如果这些信息不正确的话，请删除此信。" MailBody=MailBody & "
" MailBody=MailBody & "
" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

" MailBody=MailBody & "商品名称："& AucTitle &"
" MailBody=MailBody & "

" MailBody=MailBody & " 你的商品已经被用户"& UName_B &"成功拍下，请尽快登陆系统查看对方联系方式，并完成交易！谢谢你的支持！" MailBody=MailBody & "

" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & " " MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

该邮件由"& SYS_WEBNAME &"系统发出，系统不接受回信，因此请勿直接回复。" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & " " MailBody=MailBody & "

"& SYS_WEBNAME &"" MailBody=MailBody & " | 帮助中心

恭喜你，竞拍成功！请确认您的交易相关信息

亲爱的"& UName_B &"，您好：

" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

" MailBody=MailBody & "商品名称："& AucTitle &"
" MailBody=MailBody & "

" MailBody=MailBody & " 你参与竞拍的商品已经成功拍下，请尽快登陆系统查看对方联系方式，并完成交易！谢谢你的支持！" MailBody=MailBody & "

" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & " " MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

该邮件由"& SYS_WEBNAME &"系统发出，系统不接受回信，因此请勿直接回复。" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "

" MailBody=MailBody & "

" MailBody=MailBody & "" MailBody=MailBody & "" MailBody=MailBody & "" if comp_check("JMAIL.SMTPMail") then Call JMail(MailTo,MailTopic,MailBody) end if end if End if End Function %> <% Dim TempPathInfo TempPathInfo=Cnbbr_CurrentPath if len(TempPathInfo) then TempPathInfo=Lcase(TempPathInfo) if Instr(TempPathInfo,"index.asp")>0 then SYS_Bodywidth="772" end if if Application("Cnbbr_Head")="" then Application.Lock Application("Cnbbr_Head")=Cnbbr_Head_Function Application.UnLock end if if Application("Cnbbr_Bottom")="" then Application.Lock Application("Cnbbr_Bottom")=Cnbbr_Bottom_Function Application.UnLock end if if Application("SYS_BBRSkins")="" then Application.Lock Application("SYS_BBRSkins")=BBR_SysSkinsContent() Application.UnLock end if Dim SYS_BBRSkins SYS_BBRSkins=Application("SYS_BBRSkins") Dim UserLoginStatus if Request.Cookies(Super_User)("UName")="" then UserLoginStatus="来宾|||[ 登录 | 注册 ]" else UserLoginStatus=Request.Cookies(Super_User)("UName") & "|||[ 重新登录 | 退出 ]" end if UserLoginStatus=Split(UserLoginStatus,"|||") %>

欢迎您， <% =UserLoginStatus(0) %><%=UserLoginStatus(1)%>

[论坛] [帮助]

动态 | 行情 | 人物 | 企业 | 科技 | 设备 | 法规 | 博客 | 论坛 | 视频 | 会展 | 气象
农资 | 水稻 | 小麦 | 玉米 | 蔬菜 | 水果 | 花卉 | 草木 | 大豆 | 棉花 | 蚕桑 | 糖茶

	高级搜索
	热门搜索： <% Dim SearchHotKey if InStr(Search_HotKey,"\|")=0 then Response.write" "& search_hotkey &" " else SearchHotKey=split(Search_HotKey,"\|") For i=0 to Ubound(searchhotkey) Response.write" "& searchhotkey(i) &" " Next Response.Write" 更多..." end if %>

<% Response.Flush Function Cnbbr_Bottom Response.Flush Cnbbr_Bottom=Application("Cnbbr_Bottom") ProcessEndTime=Timer()*1000-ProcessStartTime*1000 ProcessEndTime=FormatNumber(ProcessEndTime,0,-1) Cnbbr_Bottom=Replace(Cnbbr_Bottom,"${BBR_ProcessTime}",ProcessEndTime) Cnbbr_Bottom=Replace(Cnbbr_Bottom,"${BBR_ConnTimes}",ConnTimesCount) Cnbbr_Bottom=Replace(Cnbbr_Bottom,"${BBR_SysName}",SYS_WebName) Cnbbr_Bottom=Replace(Cnbbr_Bottom,"${BBR_SysDomain}",SYS_WebUrl) Cnbbr_Bottom=Replace(Cnbbr_Bottom,"${BBR_SysEmail}",SYS_WebEmail) Cnbbr_Bottom=Replace(Cnbbr_Bottom,"${BBR_SysQQ}",SYS_WebOicq) Cnbbr_Bottom=Replace(Cnbbr_Bottom,"${BBR_SKINSFOLDER}",Skins_Folder) Cnbbr_Bottom=Replace(Cnbbr_Bottom,"${BBR_BodyWidth}",SYS_BodyWidth) Response.Write Cnbbr_Bottom CnbbrDelExpiresAuc End Function %> 品种介绍 - 中国种子拍卖网

您现在的位置：首页 >> 视频 >> 品种介绍

资讯搜索

推荐资讯

热点资讯

·vv

图文焦点

品种介绍

更多...

·vv	2009/01/14

每页30条 1/1页首页上页 [1] 下页尾页

<% Cnbbr_bottom %>