一个很好的ASP和java商城购物系统

源代码在线查看: const.asp

软件大小: 8031 K
上传用户: lqlm521
关键词: java 商城
下载地址: 免注册下载 普通下载 VIP

相关代码

				
								If Session("flag") "" Then Dvbbs.Master = True
				'UpUserFaceFolder 
				'如是独立的虚拟目录,则要写成"/uploadFace"如果是论坛目录下的普通目录,则写成""
				'Const UpUserFaceFolder=""
				Const UpUserFaceFolder="/uploadFace/"
				MyDbPath = "../"
				If IsNumeric(Dvbbs.UserHidden) = 0 or Dvbbs.Userhidden = "" Then Dvbbs.UserHidden = 2
				If IsNumeric(Dvbbs.UserID) = 0 Or Dvbbs.UserID="" Then Dvbbs.UserID=0
				Dvbbs.UserID = Clng(Dvbbs.UserID)
				Dvbbs.MemberClass = Dvbbs.checkStr(Request.Cookies(Dvbbs.Forum_sn)("userclass"))
				
				Set MyBoardOnline=new Cls_UserOnlne 
				'获得论坛基本信息和检测用户登陆状态
				Dvbbs.GetForum_Setting
				Dvbbs.CheckUserLogin
				'重新赋予用户是否可进入后台权限		已移至Admin_login.asp验证,轻飘飘
				'If Dvbbs.GroupSetting(70)="1" Then
				'	Dvbbs.Master = True
				'Else
				'	Dvbbs.Master = False
				'End If
				
				'后台信息和函数部分
				Dim AllPostTable
				Dim AllPostTableName
				Dim FoundErr
				FoundErr=False 
				Dim ErrMsg
				'Dim Rs,sql
				Dvbbs.LoadTemplates("")
				'Set Rs=Dvbbs.Execute("Select H_Content From Dv_Help Where H_ID=1")
				'template.value = Rs(0)
				
				'检测管理权限
				Sub CheckAdmin(flag)
					If Not Dvbbs.Master Or Session("flag")="" Then
						Response.Redirect "../showerr.asp?action=OtherErr&ErrCodes=本页面为管理员专用,请登录后进入。"
					End If
				
					If Instr(","&session("flag")&",",flag)=0 and flag"" then
						Errmsg=ErrMsg +	"本页面为管理员专用,请登录后进入。您没有管理本页面的权限。"
						Dvbbs_error()
					End If
				End Sub
				
				
				
				Sub AllPostTable1()
					Dim Trs
					Set Trs=Dvbbs.Execute("select * from [Dv_TableList]")
					AllPostTable=""
					Do While Not TRs.EOF
						If AllPostTable=""  Then 
							AllPostTable=TRs("TableName")
							AllPostTableName=TRs("TableType")
						Else
							AllPostTable=AllPostTable&"|"&TRs("TableName")
							AllPostTableName=AllPostTableName&"|"&TRs("TableType")
						End If
					TRs.MoveNext
					Loop 
					Trs.Close
				End Sub
				
				AllPostTable1
				AllPostTableName=Split(AllPostTableName,"|")
				AllPostTable=Split(AllPostTable,"|")
				Dim NowUseBbs
				NowUseBbs=Dvbbs.NowUseBbs
				
				Sub Footer()
					Response.Write ""
					SaveLog()
					Set Dvbbs=Nothing 
				End Sub
				
				Sub Head()
				%>
				
				
				
				-管理页面
				
				
				
				
									Dim XMLDOM
					Set XMLDOM=Application(Dvbbs.CacheName&"_boardlist").cloneNode(True)
					Response.Write ""
					Response.Write "var boardxml='';var ISAPI_ReWrite="&IsUrlreWrite&";"
					'Response.Write "var boardxml='"& replace(XMLDom.documentElement.XML ,"'","\'")&"';var ISAPI_ReWrite="&IsUrlreWrite&";"
					Response.Write ""
					Response.Write ""
					Response.Write Chr(10)
				
				End Sub
				
				Sub Dv_suc(info)
					Dim UrlArr
					UrlArr = Request.ServerVariables("HTTP_REFERER")
					If UrlArr="" Or InStr(UrlArr,Dvbbs.CacheData(33,0)&"index.asp")>0 Then UrlArr="javascript:window.history.go(-1)"
					Response.Write""
					Response.Write""
					Response.Write""
					Response.Write"成功信息"
					Response.Write""
					Response.Write""
					Response.Write""
					Response.Write""
					Response.Write info
					Response.Write""
					Response.Write""
					Response.Write"					Response.Write""
				End Sub
				'页面错误提示信息
				Sub dvbbs_error()
					Response.Write""
					Response.Write""
					Response.Write""
					Response.Write"错误信息"
					Response.Write""
					Response.Write""
					Response.Write""
					Response.Write""
					Response.Write ErrMsg
					Response.Write""
					Response.Write""
					Response.Write"					Response.Write""
					footer()
					Response.End 
				End Sub
				Function fixjs(Str)
					If Str "" Then
						str = replace(str,"\", "\\")
						Str = replace(str, chr(34), "\""")
						Str = replace(str, chr(39),"\'")
						Str = Replace(str, chr(13), "\n")
						Str = Replace(str, chr(10), "\r")
						str = replace(str,"'", "'")
					End If
					fixjs=Str
				End Function
				Function enfixjs(Str)
					If Str "" Then
						Str = replace(str,"'", "'")
						Str = replace(str,"\""" , chr(34))
						Str = replace(str, "\'",chr(39))
						Str = Replace(str, "\r", chr(10))
						Str = Replace(str, "\n", chr(13))
						Str = replace(str,"\\", "\")
					End If
					enfixjs=Str
				End Function
				
				Function Reload_All_Board_Cache()
					'更新版面列表缓存
					ReloadBoardListAll
					'更新单个版面缓存(循环)
					Dim BoardListAll,BoardListNum,myBoardID
					Dim i,Rs
					BoardListAll=myCache.value
					BoardListNum=Ubound(BoardListAll,2)
					For i=0 To BoardListNum
						myBoardID=BoardListAll(0,i)
						ReloadBoardInfo(myBoardID)
						Set rs=Dvbbs.Execute("Select ParentStr from board where boardid="&myBoardID)
						If not rs.eof Then
							Dvbbs.ReloadBoardParentStr(rs(0))
						End If
						Rs.close
						Set Rs=nothing
					Next
				End Function
				Sub SaveLog()
					On Error Resume Next
					Dim RequestStr
					Dim Sql
					RequestStr= Request("action")
					If RequestStr"" Then 
						RequestStr="action="&RequestStr
						RequestStr=Dvbbs.checkStr(RequestExp(RequestStr))
						RequestStr=Left(RequestStr,250)
						sql="insert into [Dv_log] (l_touser,l_username,l_content,l_ip,l_type) values ('"&Dvbbs.ScriptName&"','"&Dvbbs.membername&"','"&RequestStr&"','"&Dvbbs.UserTrueIP&"',0)"		
						Dvbbs.Execute(sql)
					End If
					If request.form"" Then
						RequestStr=Dvbbs.checkStr(request.form)
						RequestStr=Left(RequestExp(RequestStr),250)
						sql="insert into [Dv_log] (l_touser,l_username,l_content,l_ip,l_type) values ('"&Dvbbs.ScriptName&"','"&Dvbbs.membername&"','"&RequestStr&"','"&Dvbbs.UserTrueIP&"',1)"		
						Dvbbs.Execute(sql)
					End If
				End Sub
				
				Public Function RequestExp(Textstr)
					Dim Str,re
					Str = Textstr
					Set re=new RegExp
					re.IgnoreCase =True
					re.Global=True
						re.Pattern = "(password|answer)([^=]*)=([^(&|&)]*)"
						str = re.Replace(str,"$1$2=******")
					Set Re = Nothing
					RequestExp = Str
				End Function
				%>			

相关资源