⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 titleb.asp

📁 Art2008 CMS是一款具有强大的功能的基于ASP语言的网站管理软件
💻 ASP
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
'**************************************************
Function ChkClng(ByVal str)
	    On error resume next
		If IsNumeric(str) Then
			ChkClng = CLng(str)
		Else
			ChkClng = 0
		End If
		If Err Then ChkClng=0
	End Function
	
'**************************************************
'功能:获取IP函数	      
'**************************************************
Function GetIP() 
			Dim strIPAddr 
			If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" Or InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then 
				strIPAddr = Request.ServerVariables("REMOTE_ADDR") 
			ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then 
				strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1) 
			ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then 
				strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
			Else 
				strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
			End If 
			getIP = Replace(Trim(Mid(strIPAddr, 1, 30)), "'", "")
			getIP = Replace(getIP,";","")
			getIP = Replace(getIP,"-","")
			getIP = Replace(getIP,"(","")
			getIP = Replace(getIP,")","")
			getIP = Replace(getIP,">","")
			getIP = Replace(getIP,"<","")
			getIP = Replace(getIP,"=","")
			getIP = Replace(getIP,"*","")
		End Function
		
'****************************************************
	  '功能:发送邮件函数
	  '参数:
	  'Subject     : 邮件标题
	  'MailAddress : 发件服务器的地址,如smtp.163.com
	  'LoginName     ----登录用户名(不需要请填写"")
	  'LoginPass     ----用户密码(不需要请填写"")
	  'Email       : 收件人邮件地址
	  'Sender      : 发件人姓名
	  'Content     : 邮件内容
	  'Fromer      : 发件人的邮件地址
'****************************************************
Function SendMail(MailAddress, LoginName, LoginPass, Subject, Email, Sender, Content, Fromer)
	   on error resume next
		Dim JMail
		  Set jmail = Server.CreateObject("JMAIL.Message") '建立发送邮件的对象
			jmail.silent = true '屏蔽例外错误，返回FALSE跟TRUE两值j
			jmail.Charset = "gb2312" '邮件的文字编码为国标
			jmail.ContentType = "text/html" '邮件的格式为HTML格式
			jmail.AddRecipient Email '邮件收件人的地址
			jmail.From = Fromer '发件人的E-MAIL地址
			jmail.FromName = Sender
			  If LoginName <> "" And LoginPass <> "" Then
				JMail.MailServerUserName = LoginName '您的邮件服务器登录名
				JMail.MailServerPassword = LoginPass '登录密码
			  End If
			jmail.Subject = Subject '邮件的标题 
			JMail.Body = Content
			JMail.Priority = 1'邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值
			jmail.Send(MailAddress) '执行邮件发送（通过邮件服务器地址）
			jmail.Close() '关闭对象
		Set JMail = Nothing
		If Err Then
			SendMail = Err.Description
			Err.Clear
		Else
			SendMail = "OK"
		End If
	  End Function

'**************************************************
'功能:会员点券明细出入函数	      
'参数:Channelid-模块ID,InfoID-信息ID，UserName-用户名,InOrOutFlag-操作类型1收入2支出,Point-交易点数,User-操作员,Descript-操作备注
'**************************************************
Public Function PointInOrOut(ChannelID,InfoID,UserName,InOrOutFlag,Point,User,Descript)
	  If Not IsNumeric(InOrOutFlag) Or Not IsNumeric(Point) Then PointInOrOut=false:Exit Function
	  Dim PointParam
	  If InOrOutFlag=1 Then 
	     PointParam="Set Score=Score+" & Point
	  ElseIF InOrOutFlag=2 Then
	     PointParam="Set Score=Score-" & Point
	  Else
	    PointInOrOut=false:Exit Function
	  End If
	  on error resume next
	  Conn.Execute("Update Art_User " & PointParam & " Where UserName='" & UserName & "'")
	  Conn.Execute("Insert into Art_LogPoint(ChannelID,InfoID,UserName,InOrOutFlag,Point,Times,[User],Descript,Adddate,IP) values(" & ChannelID & "," & InfoID & ",'" & UserName & "',"& InOrOutFlag & "," & Point & ",1,'" & replace(User,"'","""") & "','" & replace(Descript,"'","""") & "',"& NowString &",'" & replace(GetIP,"'","""") & "')")
	  IF Err Then PointInOrOut=false Else PointInOrOut=true
	End Function
'**************************************************
'功能:会员资金明细出入函数	      
'参数:UserName-用户名,ClientName-客户名，Moneys-交易资金，MoneyType-资金类型，IncomeOrPayOut-操作类型1收入2支出,OrderID-订单支付的订单ID,PaymentID-在线支付的支付单ID，Inputer-操作员,Remark-操作备注
'**************************************************
Public Function MoneysInOrOut(UserName,ClientName,Moneys,MoneyType,IncomeOrPayOut,OrderID,PaymentID,Inputer,Remark)
	  If Not IsNumeric(IncomeOrPayOut) Or Not IsNumeric(Moneys) Then MoneysInOrOut=false:Exit Function
	  Dim MoneysParam
	  If IncomeOrPayOut=1 Then 
	     MoneysParam="Set Moneys=Moneys+" & Moneys
	  ElseIF IncomeOrPayOut=2 Then
	     MoneysParam="Set Moneys=Moneys-" & Moneys
	  Else
	    MoneysParam=false:Exit Function
	  End If
	  on error resume next
	  Conn.Execute("Update Art_User " & MoneysParam & " Where UserName='" & UserName & "'")
	  Conn.Execute("Insert into Art_LogMoney([UserName],[ClientName],[Money],[MoneyType],[IncomeOrPayOut],[OrderID],[PaymentID],[Inputer],[Remark],[PayTime],LogTime,IP) values('" & UserName & "','" & ClientName & "'," & Moneys & ","& MoneyType & "," & IncomeOrPayOut & ", '"& OrderID &"',"& PaymentID &",'" & replace(Inputer,"'","""") & "','" & replace(Remark,"'","""") & "',"& NowString &","& NowString &",'" & replace(GetIP,"'","""") & "') ")
	  IF Err Then MoneysInOrOut=false Else  MoneysInOrOut=true
	End Function
'**************************************************
'取得会员组选项--下拉列表  参数：Selected--默认选项
'**************************************************
	Public Function GetUserGroup_Option(Selected)
	 Dim RSObj:Set RSObj=Server.CreateObject("Adodb.Recordset")
	  RSObj.Open "Select GroupID,GroupSetting From Art_Group",Conn,1,1
			Do While Not RSObj.Eof
			Dim GroupName:GroupName=Split(RSObj(1),"^@$@^")(0)
		   IF Selected=RSObj(0) Then
			GetUserGroup_Option=GetUserGroup_Option & "<option value=""" & RSObj(0) & """ Selected>" & GroupName & "</option>"
		   Else
			GetUserGroup_Option=GetUserGroup_Option & "<option value=""" & RSObj(0) & """>" & GroupName & "</option>"
		   End If
		RSObj.MoveNext
		Loop
	  RSObj.Close:Set RSObj=Nothing
	End Function

'**************************************************
'功能:列出会员组	      
'参数:OptionName-复选框名称,SelectArr，RowNum-每行排列数
'**************************************************
 	Public Function GetGroup_CheckBox(OptionName,SelectArr,RowNum)
	  On  Error  Resume  Next 
	   Dim n:n=0
	   Dim RSGroup,GroupName:Set RSGroup=Server.CreateObject("Adodb.Recordset")
	   IF RowNum<=0 Then RowNum=3
	   RSGroup.Open "Select GroupID,GroupSetting From Art_Group",Conn,1,1
	   GetGroup_CheckBox="<table width=""100%"" align=""center"" border=""0"">"
	   Do While Not RSGroup.Eof
	        GetGroup_CheckBox=GetGroup_CheckBox & "<TR>"
	     For N=1 To RowNum
		    GroupName=Split(RSGroup(1),"^@$@^")(0)
		    GetGroup_CheckBox=GetGroup_CheckBox & "<TD WIDTH=""" & CInt(100 / CInt(RowNum)) & "%"">"
			If Instr(SelectArr,RSGroup(0))<>0 Then
			 GetGroup_CheckBox=GetGroup_CheckBox & "<input id="& OptionName&RSGroup(0)&" type=""checkbox"" checked name=""" & OptionName & """ value=""" & RSGroup(0) & """><label for="& OptionName&RSGroup(0) &">" & GroupName & "</label>&nbsp;&nbsp;&nbsp;&nbsp;"
			Else
			 GetGroup_CheckBox=GetGroup_CheckBox & "<input id="& OptionName&RSGroup(0)&" type=""checkbox"" name=""" & OptionName & """ value=""" & RSGroup(0) & """><label for="& OptionName&RSGroup(0) &">" & GroupName & "</label>&nbsp;&nbsp;&nbsp;&nbsp;"
			End IF
			GetGroup_CheckBox=GetGroup_CheckBox & "</TD>"
		 	RSGroup.MoveNext
			If RSGroup.Eof Then Exit For
		Next
		GetGroup_CheckBox=GetGroup_CheckBox & "</TR>"
		If RSGroup.Eof Then Exit Do
	   Loop
	   GetGroup_CheckBox=GetGroup_CheckBox & "</TABLE>"
	   RSGroup.Close:Set RSGroup=Nothing
	End Function 
'**************************************************
	'管理员权限检测
	'函数名：ChkAdmin
	'作  用：检查普通管理员所具备的权限
'**************************************************
Function ChkAdmin(flag)
	On Error Resume Next
	Dim Adminflag,m_intAdminGrade
	ChkAdmin = False
	AdminFlag = Replace(Request.Cookies(Art2008)("OSKEY"), "'", "''")
	m_intAdminGrade = ChkNumeric(Request.Cookies(Art2008)("purview"))
	If flag = "" Then Exit Function
	If AdminFlag = "" Or IsEmpty(AdminFlag) Then Exit Function
	If CInt(m_intAdminGrade) = 99999 Then
		ChkAdmin = True
		Exit Function
	Else
		If Adminflag = "" Then
			ChkAdmin = False
			Exit Function
		Else
			Adminflag = "," & Adminflag & ","
			flag = "," & flag & ","
			If Instr(Adminflag,flag)=0 then
				ChkAdmin = False
			Else
				ChkAdmin = True
			End If
		End If
	End If
End Function
'**************************************************
	'只读管理员检测
	'函数名：AdminReadonly
	'作  用：检查只读管理员提交的内容
'**************************************************
Sub AdminReadonly()
	'Dim sPathInfo:sPathInfo = LCase(Request.ServerVariables("PATH_INFO"))
	'If InStr(sPathInfo,"admin/admin_admin.asp") > 0 Then Exit Sub
	If Request.Form <> "" Then
		Response.Redirect (config("path") &"admin/"& "showerr.asp?action=1&Message=" & Server.URLEncode("<li>后台管理为只读模式，不能进行此操作。</li><li>如果有什么问题，请联系管理员。</li>") & "")
		Response.End
	End If
	'If LCase(Trim(Request("action"))) = "del" Or LCase(Trim(Request("action"))) = "delall"Or LCase(Trim(Request("action"))) = "delall" Or   LCase(Trim(Request("delid"))) <>"" Or LCase(Trim(Request("del"))) <>""  Then
	If Instr(LCase(Trim(Request("action"))),"del") >0  Or LCase(Trim(Request("action"))) = "Lock" Or Instr(LCase(Trim(Request("action"))),"copy") >0 Or Instr(LCase(Trim(Request("Action"))),"set") >0 Or LCase(Trim(Request("delid"))) <>"" Or LCase(Trim(Request("del"))) <>"" Or  LCase(Trim(Request("op"))) <>"" Or LCase(Trim(Request("jy"))) <>"" Or LCase(Trim(Request("cls"))) <>""   Or  LCase(Trim(Request("jsop"))) <>"" Or  LCase(Trim(Request("adids"))) <>""Then
		Response.Redirect (config("path") &"admin/" & "showerr.asp?action=1&Message=" & Server.URLEncode("<li>后台管理为只读模式，不能进行此操作。</li><li>如果有什么问题，请联系管理员。</li>") & "")
		Response.End
	End If
End Sub
'******************************************************
'　作用：格式化时间(显示)。
'　参数：二个，一个是时间，另外一个是格式化的参数，也就是要用那种形式参数：n_Flag
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' 6:"10/1/2005"
' 7:"yyyymmddhhmm"
' 8:"mm月dd日
' 9:dd日
'　返回：相应的日期格式
'　注意：调用时要注意，使用本函数的相关返回值.
'******************************************************
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1' yyyy-mm-dd hh:mm:ss
  Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2' yyyy-mm-dd
  Format_Time = y & "-" & m & "-" & d
Case 3' hh:mm:ss
  Format_Time = h & ":" & mi & ":" & s
Case 4 ' yyyy年mm月dd日
  Format_Time = y & "年" & m & "月" & d & "日"
case 5'yyyymmdd
  Format_time= y&m&d
case 6 'yyyymmddhhmmss10/1/2005
 ' Format_time=y&m&d&h&mi&s
  Format_Time = d & "/" & m & "/" & y
case 7 'yyyymmddhhmm
  Format_time=y&m&d&h&mi
case 8
  Format_time=m & "月" & d & "日"
case 9
  Format_time=d & "日"
case 10
  Format_time=m&"-"& d
End Select
End Function 


'******************************************************
'//SaveHtmlFile:生成静态函数
'LocalFileName---等转换的动态文件名称
'RemoteFileUrl---要转换为静态文件路径
'******************************************************
function SaveHtmlFile(LocalFileName,RemoteFileUrl)
Dim Ads, Retrieval, GetRemoteData,my_asp_file
my_asp_file="http://"&Request.ServerVariables("SERVER_NAME")&RemoteFileUrl 
On Error Resume Next
Set Retrieval = Server.CreateObject("Microso" & "ft.XM" & "LHTTP")
With Retrieval
.Open "Get", my_asp_file, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set Ads = Server.CreateObject("Ado" & "db.Str" & "eam")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile Server.MapPath(LocalFileName), 2
.Cancel()
.Close()
End With
Set Ads=nothing
if err <> 0 then
SaveHtmlFile = false
err.clear
else
SaveHtmlFile = true
end if
End function

		
%>
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -