char.asp

网上商城的源码

%>
<a name=top></a>
</td></td>
</table>
<br>
<%
end sub

'统计留言
function newincept()
rs=conn.execute("Select Count(id) From Message Where flag=0 and issend=1 and delR=0 And incept='"& membername &"'")
    newincept=rs(0)
	set rs=nothing
	if isnull(newincept) then newincept=0
end function
function inceptid(stype)
	set rs=conn.execute("Select top 1 id,sender From Message Where flag=0 and issend=1 and delR=0 And incept='"& membername &"'")
	if stype=1 then
	inceptid=rs(0)
	else
	inceptid=rs(1)
	end if
	set rs=nothing
end function

Rem 获得版面用户组权限配置
function GetBoardPermission()
	dim pmrs
	GetBoardPermission=false
	set pmrs=conn.execute("select PSetting from BoardPermission where Boardid="&Boardid&" and GroupID="&UserGroupID)
	if not (pmrs.eof and pmrs.bof) then
		GetBoardPermission=true
		GroupSetting=split(pmrs(0),",")
	else
		GetBoardPermission=false
	end if
	if FoundUser then
	set pmrs=conn.execute("select uc_Setting from UserAccess where uc_BoardID="&BoardID&" and uc_UserID="&userID)
	if not(pmrs.eof and pmrs.bof) then
		UserPermission=split(pmrs(0),",")
		GroupSetting=split(pmrs(0),",")
		FoundUserPer=true
	end if
	end if
	set pmrs=nothing
end function


Rem 判断数字是否整形
function isInteger(para)
       on error resume next
       dim str
       dim l,i
       if isNUll(para) then 
          isInteger=false
          exit function
       end if
       str=cstr(para)
       if trim(str)="" then
          isInteger=false
          exit function
       end if
       l=len(str)
       for i=1 to l
           if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
              isInteger=false 
              exit function
           end if
       next
       isInteger=true
       if err.number<>0 then err.clear
end function

function allonline()
dim tmprs
tmprs=conn.execute("Select count(*) from online") 
allonline=tmprs(0) 
set tmprs=nothing 
if isnull(allonline) then allonline=0
end function

'**********************************************
'	vbs Cache类
'
'	属性valid，是否可用，取值前判断
'	属性name，cache名，新建对象后赋值
'	方法add(值,到期时间)，设置cache内容
'	属性value，返回cache内容
'	属性blempty，是否未设置值
'	方法makeEmpty，释放内存，测试用
'	方法equal(变量1)，判断cache值是否和变量1相同
'	方法expires(time)，修改过期时间为time
'	木鸟  2002.12.24
'	http://www.aspsky.net/
'**********************************************

class Cache
	private obj			'cache内容
	private expireTime		'过期时间
	private expireTimeName	'过期时间application名
	private cacheName		'cache内容application名
	private path			'uri
	
	private sub class_initialize()
		path=request.servervariables("url")
		path=left(path,instrRev(path,"/"))
	end sub
	
	private sub class_terminate()
	end sub
	
	public property get blEmpty
		'是否为空
		if isempty(obj) then
			blEmpty=true
		else
			blEmpty=false
		end if
	end property
	
	public property get valid
		'是否可用(过期)
		if isempty(obj) or not isDate(expireTime) then
			valid=false
		elseif CDate(expireTime)<now then
				valid=false
		else
			valid=true
		end if
	end property
	
	public property let name(str)
		'设置cache名
		cacheName=str & path
		obj=application(cacheName)
		expireTimeName=str & "expires" & path
		expireTime=application(expireTimeName)
	end property
	
	public property let expires(tm)
		'重设置过期时间
		expireTime=tm
		application.lock
		application(expireTimeName)=expireTime
		application.unlock
	end property
	
	public sub add(var,expire)
		'赋值
		if isempty(var) or not isDate(expire) then
			exit sub
		end if
		obj=var
		expireTime=expire
		application.lock
		application(cacheName)=obj
		application(expireTimeName)=expireTime
		application.unlock
	end sub
	
	public property get value
		'取值
		if isempty(obj) or not isDate(expireTime) then
			value=null
		elseif CDate(expireTime)<now then
			value=null
		else
			value=obj
		end if
	end property
	
	public sub makeEmpty()
		'释放application
		application.lock
		application(cacheName)=empty
		application(expireTimeName)=empty
		application.unlock
		obj=empty
		expireTime=empty
	end sub
	
	public function equal(var2)
		'比较
		if typename(obj)<>typename(var2) then
			equal=false
		elseif typename(obj)="Object" then
			if obj is var2 then
				equal=true
			else
				equal=false
			end if
		elseif typename(obj)="Variant()" then
			if join(obj,"^")=join(var2,"^") then
				equal=true
			else
				equal=false
			end if
		else
			if obj=var2 then
				equal=true
			else
				equal=false
			end if
		end if
	end function
end class

sub DispPageNum(CurPage, PageCount, URLPrefix, URLPostfix)
	dim p,ii
	if PageCount=0 then
		response.write "无 "
	else
		p=(CurPage-1) \ 10
		if CurPage=1 then
			response.write "<SPAN class=pagenumstatic><font face=webdings color="&Forum_body(8)&">9</font></SPAN>  "
		else
			response.write "<SPAN class=pagenum><a href="&URLPrefix&"1"&URLPostfix&" title=首页><font face=webdings>9</font></a></SPAN> "
		end if
		if p>0 then response.write "<SPAN class=pagenum><a href="&URLPrefix&Cstr(p*10)&URLPostfix&" title=上十页><font face=webdings>7</font></a></SPAN> "
		response.write "<b>"
		for ii=p*10+1 to P*10+10
			if ii=CurPage then
		  	response.write "<SPAN class=pagenumstatic><B><font color="&Forum_body(8)&">"+Cstr(ii)+"</font></B></SPAN> "
			else
				response.write "<SPAN class=pagenum><a href="&URLPrefix&Cstr(ii)&URLPostfix&">"+Cstr(ii)+"</a></SPAN> "
			end if
			if ii=PageCount then exit for
		next
		if ii>p*10+10 then ii=ii-1
		response.write "</b>"
		if ii<PageCount then response.write "<SPAN class=pagenum><a href="&URLPrefix&Cstr(ii+1)&URLPostfix&" title=下十页><font face=webdings>8</font></a></SPAN> "
		if CurPage=PageCount then
			response.write "<SPAN class=pagenumstatic><font face=webdings color="&Forum_body(8)&">:</font></SPAN>"
		else
			response.write "<SPAN class=pagenum><a href="&URLPrefix&Cstr(PageCount)&URLPostfix&" title=尾页><font face=webdings>:</font></a></SPAN> "
		end if
	end if
end sub
function GetVisualStr(CurVisualStr,CurVisualSex,CurVisualPeriod)
	dim VisualStr,VisualSex,VisualPeriod
	dim VisualSplit,PeriodSplit
	dim i,TempSplit
	VisualStr=CurVisualStr
	VisualSex=CurVisualSex
	VisualPeriod=CurVisualPeriod
	if isnull(VisualStr) or VisualStr="" then
		if VisualSex=1 then
			VisualStr="||||||14.7|13.8|12.9||11.11||10.13|9.14||||8.18|||||||"
		else
			VisualStr="||||||7.7|6.8|5.9||4.11||3.13|2.14||||1.18|||||||"
		end if
	else
		if ubound(split(VisualStr,"|"))<>24 then
			if VisualSex=1 then
				VisualStr="||||||14.7|13.8|12.9||11.11||10.13|9.14||||8.18|||||||"
			else
				VisualStr="||||||7.7|6.8|5.9||4.11||3.13|2.14||||1.18|||||||"
			end if
		else
			if not isnull(VisualPeriod) then
				PeriodSplit=split(VisualPeriod,"|")
				if ubound(PeriodSplit)=24 then
					VisualSplit=split(VisualStr,"|")
					VisualStr=""
					for i=0 to 24
						if VisualSplit(i)<>"" then
							TempSplit=split(VisualSplit(i),".")
							if cint(TempSplit(0))>20 then
								if PeriodSplit(i)<>"" then
									TempSplit=split(PeriodSplit(i),",")
									if ubound(TempSplit)=1 then
										if len(TempSplit(0))=6 and isnumeric(TempSplit(0)) and isnumeric(TempSplit(1)) then
											if datediff("d",CDate("20"&left(TempSplit(0),2)&"-"&mid(TempSplit(0),3,2)&"-"&right(TempSplit(0),2)),now())>cint(TempSplit(1)) and cint(TempSplit(1))>0 then
												select case i
												case 6
													if VisualSex=1 then
														VisualSplit(i)="14.7"
													else
														VisualSplit(i)="7.7"
													end if
												case 7
													if VisualSex=1 then
														VisualSplit(i)="13.8"
													else
														VisualSplit(i)="6.8"
													end if
												case 8
													if VisualSex=1 then
														VisualSplit(i)="12.9"
													else
														VisualSplit(i)="5.9"
													end if
												case 10
													if VisualSex=1 then
														VisualSplit(i)="11.11"
													else
														VisualSplit(i)="4.11"
													end if
												case 12
													if VisualSex=1 then
														VisualSplit(i)="10.13"
													else
														VisualSplit(i)="3.13"
													end if
												case 13
													if VisualSex=1 then
														VisualSplit(i)="9.14"
													else
														VisualSplit(i)="2.14"
													end if
												case 17
													if VisualSex=1 then
														VisualSplit(i)="8.18"
													else
														VisualSplit(i)="1.18"
													end if
												case else
													VisualSplit(i)=""
												end select
											end if
										end if
									end if
								end if
							end if
						end if
						if i>0 then VisualStr=VisualStr&"|"
						VisualStr=VisualStr&VisualSplit(i)
					next
				end if
			end if
		end if
	end if
	GetVisualStr=VisualStr
end function
function GetLayerStr(CurVisualSplit)
	dim i,LayerStr
	LayerStr=""
	for i=0 to ubound(CurVisualSplit)
		if not isnull(CurVisualSplit(i)) and trim(CurVisualSplit(i))<>"" then
			if LayerStr<>"" then LayerStr=LayerStr&"_"
			LayerStr=LayerStr&(i+1)
		end if
	next
	GetLayerStr=LayerStr
end function
function isCanShowVisual(CurVisualSplit)
	dim TempSplit
	if CurVisualSplit(6)="" or CurVisualSplit(7)="" or CurVisualSplit(8)="" or CurVisualSplit(10)="" or CurVisualSplit(12)="" or CurVisualSplit(13)="" or CurVisualSplit(17)="" then
		isCanShowVisual=False
		exit function
	end if
	TempSplit=split(CurVisualSplit(7),".")
	if TempSplit(0)="6" or TempSplit(0)="13" then
		isCanShowVisual=False
		exit function
	end if
	TempSplit=split(CurVisualSplit(8),".")
	if TempSplit(0)="5" or TempSplit(0)="12" then
		isCanShowVisual=False
		exit function
	end if
	isCanShowVisual=True
end function
%>