function.asp

. 缓存处理技术

	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,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
end function



Function CodeCookie(str)

	Dim i
	Dim StrRtn
	For i = Len(Str) to 1 Step -1
		StrRtn = StrRtn & Ascw(Mid(Str,i,1))
		If (i <> 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 Re(u)
  Response.Redirect u
End Function
Function Print_space(Byval space_num)
Dim I
For I=1 to space_num
  Print_space=Print_space&"&nbsp;"
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 = "<br>读取文件失败：" & err.description & "<br>其它可能：确定是否对此文件有读取权限."
			err.Clear
			Set Fs = Nothing
			Exit Function
		End If
		If Not WriteFile.AtEndOfStream Then
			ADODB_LoadFile = WriteFile.ReadAll
			If Err Then
				GBL_CHK_TempStr = "<br>读取文件失败：" & err.description & "<br>其它可能：确定是否对此文件有读取权限."
				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 = "<div align='center'>您的主机不支持ADODB.Stream，无法完成操作，请手工进行</div>"
			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 = "<br>错误信息：" & err.description & "<br>其它可能：确定是否对此文件有读取权限."
		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= "<table align='center'><tr><td>"
	if ShowTotal=true then 
		strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
	end if
	strUrl=JoinChar(sfilename)
  	if CurrentPage<2 then
    		strTemp=strTemp & "首页 上一页&nbsp;"
  	else
    		strTemp=strTemp & "<a href='" & strUrl & "page=1'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
  	end if

  	if n-currentpage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾页</a>"
  	end if
   	strTemp=strTemp & "&nbsp;页次：" & CurrentPage & "/" & n & "页 "

	if ShowAllPages=True then
		strTemp=strTemp & "&nbsp;转到：<select name='page' size='1' onchange=""javascript:window.location='" & strUrl & "page=" & "'+this.options[this.selectedIndex].value;"">"   
    	for i = 1 to n   
    		strTemp=strTemp & "<option value='" & i & "'"
			if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
			strTemp=strTemp & ">第" & i & "页</option>"   
	    next
		strTemp=strTemp & "</select>"
	end if
	strTemp=strTemp & "</td></tr></table>"
	fshowpage=strTemp
end function


















Function DispAlert(Info)
  Response.Write "<BR><BR><BR>"& Vbcrlf
  Response.Write "<table cellpadding=0 cellspacing=1 width=368 border=0 align=center class=tablebg>" & Vbcrlf
  Response.Write "<tr>" & Vbcrlf
  Response.Write "<td class=titletd align=center><b>信息小贴士</b></td>" & Vbcrlf
  Response.Write "</tr>" & Vbcrlf
  Response.Write "<tr>" & Vbcrlf
  Response.Write "<td class=td align=center>"& Info &"</td>" & Vbcrlf
  Response.Write "</tr>" & Vbcrlf
  Response.Write "</table>" & 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







Function Disp_UserCredit(userid,credit,BBrFlag)
	Dim TempUserCredit
	Dim Tempii
	Dim TempBBRCredit

	if BBrFlag=1 then
	   TempBBRCredit="../"
	else
	   TempBBRCredit=""
	end if
	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="<a href="& TempBBRCredit &"usercredit.asp?bbrid="& userid &"><img alt="""& Trans_Num(Tempii) &"星级用户：建议您出价前点击其星级查看信用详情。"" border=0 src="""& TempBBRCredit &"skins/"& Skins_Folder &"/star_"&Tempii&".gif""></a>"
		   Exit For
		end if
	     else
		if Clng(a)>=Clng(SysUserCredit(Tempii)) and Clng(a)<Clng(SysUserCredit(Tempii+1)) then
	 	   TempUserCredit="<a href="& TempBBRCredit &"usercredit.asp?bbrid="& userid &"><img alt="""& Trans_Num(Tempii) &"星级用户：建议您出价前点击其星级查看信用详情。"" border=0 src="""& TempBBRCredit &"skins/"& Skins_Folder &"/star_"&Tempii&".gif""></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="<img src="""& TempBBRCredit &"Skins/"& Skins_Folder &"/star_0.gif"" border=""0"" alt=""无星级"">"
    Case 1: TempShopStar="<img src="""& TempBBRCredit &"Skins/"& Skins_Folder &"/star_1.gif"" border=""0"" alt=""一星级"">"
    Case 2: TempShopStar="<img src="""& TempBBRCredit &"Skins/"& Skins_Folder &"/star_2.gif"" border=""0"" alt=""二星级"">"
    Case 3: TempShopStar="<img src="""& TempBBRCredit &"Skins/"& Skins_Folder &"/star_3.gif"" border=""0"" alt=""三星级"">"
    Case 4: TempShopStar="<img src="""& TempBBRCredit &"Skins/"& Skins_Folder &"/star_4.gif"" border=""0"" alt=""四星级"">"
    Case 5: TempShopStar="<img src="""& TempBBRCredit &"Skins/"& Skins_Folder &"/star_5.gif"" border=""0"" alt=""五星级"">"
    Case 6: TempShopStar="<img src="""& TempBBRCredit &"Skins/"& Skins_Folder &"/star_6.gif"" border=""0"" alt=""钻石级"">"
    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="../"