📄 function.asp

📁 内容丰富的太阳能网站整站程序,适合制作中小企业网站.
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
    if err.number<>0 then err.clear
end function

'------------------检查某一目录是否存在-------------------
Function CheckDir(FolderPath)
	dim fso
	folderpath=Server.MapPath(".")&"\"&folderpath
	Set fso1 = Server.CreateObject("Scripting.FileSystemObject")
	If fso.FolderExists(FolderPath) then
	'存在
		CheckDir = True
	Else
	'不存在
		CheckDir = False
	End if
	Set fso = nothing
End Function

'-------------根据指定名称生成目录---------
Function MakeNewsDir(foldername)
	dim fso,f
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
    Set f = fso.CreateFolder(foldername)
    MakeNewsDir = True
	Set fso = nothing
End Function


'****************************************************
'函数名：SendMail
'作  用：用Jmail组件发送邮件
'参  数：MailtoAddress  ----收信人地址
'        MailtoName    -----收信人姓名
'        Subject       -----主题
'        MailBody      -----信件内容
'        FromName      -----发信人姓名
'        MailFrom      -----发信人地址
'        Priority      -----信件优先级
'****************************************************
function SendMail(MailtoAddress,MailtoName,Subject,MailBody,FromName,MailFrom,Priority)
	on error resume next
	Dim JMail
	Set JMail=Server.CreateObject("JMail.Message")
	if err then
		SendMail= "<br><li>没有安装JMail组件</li>"
		err.clear
		exit function
	end if
	JMail.Charset="gb2312"          '邮件编码
	JMail.silent=true
	JMail.ContentType = "text/html"     '邮件正文格式
	'JMail.ServerAddress=MailServer     '用来发送邮件的SMTP服务器
   	'如果服务器需要SMTP身份验证则还需指定以下参数
	JMail.MailServerUserName = MailServerUserName    '登录用户名
   	JMail.MailServerPassWord = MailServerPassword        '登录密码
  	JMail.MailDomain = MailDomain       '域名（如果用“name@domain.com”这样的用户名登录时，请指明domain.com
	JMail.AddRecipient MailtoAddress,MailtoName     '收信人
	JMail.Subject=Subject         '主题
	JMail.HMTLBody=MailBody       '邮件正文（HTML格式）
	JMail.Body=MailBody          '邮件正文（纯文本格式）
	JMail.FromName=FromName         '发信人姓名
	JMail.From = MailFrom         '发信人Email
	JMail.Priority=Priority              '邮件等级，1为加急，3为普通，5为低级
	JMail.Send(MailServer)
	SendMail =JMail.ErrorMessage
	JMail.Close
	Set JMail=nothing
end function

'****************************************************
'过程名：WriteErrMsg
'作  用：显示错误提示信息
'参  数：无
'****************************************************
sub WriteErrMsg()
	dim strErr
	strErr=strErr & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
	strErr=strErr & "<link href='style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbcrlf
	strErr=strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbcrlf
	strErr=strErr & "  <tr align='center' class='title'><td height='22'><strong>错误信息</strong></td></tr>" & vbcrlf
	strErr=strErr & "  <tr class='tdbg'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & errmsg &"</td></tr>" & vbcrlf
	strErr=strErr & "  <tr align='center' class='tdbg'><td><a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a></td></tr>" & vbcrlf
	strErr=strErr & "</table>" & vbcrlf
	strErr=strErr & "</body></html>" & vbcrlf
	response.write strErr
end sub

'****************************************************
'过程名：WriteSuccessMsg
'作  用：显示成功提示信息
'参  数：无
'****************************************************
sub WriteSuccessMsg(SuccessMsg)
	dim strSuccess
	strSuccess=strSuccess & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
	strSuccess=strSuccess & "<link href='style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbcrlf
	strSuccess=strSuccess & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbcrlf
	strSuccess=strSuccess & "  <tr align='center' class='title'><td height='22'><strong>恭喜你！</strong></td></tr>" & vbcrlf
	strSuccess=strSuccess & "  <tr class='tdbg'><td height='100' valign='top'><br>" & SuccessMsg &"</td></tr>" & vbcrlf
	strSuccess=strSuccess & "  <tr align='center' class='tdbg'><td>&nbsp;</td></tr>" & vbcrlf
	strSuccess=strSuccess & "</table>" & vbcrlf
	strSuccess=strSuccess & "</body></html>" & vbcrlf
	response.write strSuccess
end sub

'**************************************************
'函数名：CheckUserLogined
'作  用：检查用户是否登录
'参  数：无
'返回值：True ----已经登录
'        False ---没有登录
'**************************************************
function CheckUserLogined()
	dim Logined,UserName,Password,UserLevel,rs,sql
	Logined=True
	UserName=Request.Cookies("asp163")("UserName")
	Password=Request.Cookies("asp163")("Password")
	UserLevel=Request.Cookies("asp163")("UserLevel")
	if UserName="" then
		Logined=False
	end if
	if Password="" then
		Logined=False
	end if
	if UserLevel="" then
		Logined=False
	end if
	if Logined=True then
		username=replace(trim(username),"'","")
		password=replace(trim(password),"'","")
		UserLevel=Cint(trim(UserLevel))
		set rs=server.createobject("adodb.recordset")
		sql="select * from [User] where LockUser=False and username='" & username & "' and password='" & password &"'"
		rs.open sql,conn,1,1
		if rs.bof and rs.eof then
			Logined=False
		else
			if password<>rs("password") or UserLevel<rs("UserLevel") then
				Logined=False
			end if
		end if
		rs.close
		set rs=nothing
	end if
	CheckUserLogined=Logined
end function

'**************************************************
'函数名：ReplaceBadChar
'作  用：过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
function ReplaceBadChar(strChar)
	if strChar="" then
		ReplaceBadChar=""
	else
		ReplaceBadChar=replace(replace(replace(replace(replace(replace(replace(strChar,"'",""),"*",""),"?",""),"(",""),")",""),"<",""),".","")
	end if
end function


'=================================================
'过程名：ShowSearchForm
'作  用：显示文章搜索表单
'参  数：ShowType ----显示方式。1为简洁模式，2为标准模式，3为高级模式
'=================================================
sub ShowSearchForm(Action,ShowType,Classid,Classname)
	if ShowType<>1 and ShowType<>2 and ShowType<>3 then
		ShowType=1
	end if
	response.write "<table border='0' cellpadding='0' cellspacing='0' align=center>"
	response.write "<form method='Get' name='SearchForm' action='" & Action & "'>"
'	response.write "<tr align='center'>"
	if ShowType=1 then
		response.write "<td height='28' align='center'><input type='text' name='keyword'  size='15' value='关键字' maxlength='50' onFocus='this.select();'>&nbsp;</td>"
		response.write "<td><input type='hidden' name='field' value='Title'></td>"
		response.write "<td><input type='submit' name='Submit'  value='搜索'>"
		'response.write "<br><br>高级搜索</td></tr>"
	else
'	elseif Showtype=2 then
'		response.write "<tr height='30'><td><select name='Field' size='1'>"
 '   	response.write "<option value='Title' selected>标题</option>"
'	    response.write "<option value='Content'>内容</option>"
 '   	response.write "<option value='Author'>作者</option>"
'		response.write "</select>&nbsp;</td></tr>"
'		if Classid<> "" and Classname<> "" and ClassID<>75 then
'	sql1="select ClassID,ClassName,ParentID,ParentPath From ArticleClass where ClassID="&ClassID&""
'	set rss1=server.CreateObject("adodb.recordset")
'	rss1.open sql1,conn,1,1
'
'	search1=split(rss1("ParentPath"),",")
'	search2=Lbound(search1)
'	search3=(search1(search2))
'
'	if (search1(search2))=0 then
'		search3=ClassName
'	else
'		sqlsearch1="select ClassID,ClassName From ArticleClass where ClassID="&search3&""
'		set rssearch1=server.CreateObject("adodb.recordset")
'		rssearch1.open sqlsearch1,conn,1,1
'		search3=rssearch1("ClassName")
'		search4=rssearch1("ClassID")
'	end if			
'	
'		response.write "<tr height='30'><td><select name='ClassID'><option value="&search4&">"&search3&"</option>"
'		else
'		response.write "<tr height='30'><td><select name='ClassID'><option value=''>所有栏目</option>"
'		end if
'		call Admin_ShowClass_Option2(1,0)
'		response.write "</select>&nbsp;</td></tr><tr height='30'><td><input type='text' name='keyword'  size='20' value='关键字' maxlength='50' onFocus='this.select();'>&nbsp;</td></tr>"
'		response.write "<tr height='30'><td><input src='images/search.gif' type='image' name='Submit'  value='  '></td></tr>"
'	elseif Showtype=3 then
		response.write "<tr height='30'><td><select name='Field' size='1'>"
    	response.write "<option value='Title' selected>标题</option>"
	    response.write "<option value='Content'>内容</option>"
    	response.write "<option value='Author'>作者</option>"
    	'response.write "<option value='Editor'>编辑姓名</option>"
		response.write "</select>&nbsp;</td></tr>"
		if Classid<> "" and Classname<> "" then

	'dim sql1,rss1,search1,search2,search3,sqlsearch1,rssearch1,search4
	sql1="select ClassID,ClassName,ParentID,ParentPath From ArticleClass where ClassID="&ClassID&""
	set rss1=server.CreateObject("adodb.recordset")
	rss1.open sql1,conn,1,1

	search1=split(rss1("ParentPath"),",")
	search2=Lbound(search1)
	search3=(search1(search2))

	if (search1(search2))=0 then
		search3=ClassName
	else
		sqlsearch1="select ClassID,ClassName From ArticleClass where ClassID="&search3&""
		set rssearch1=server.CreateObject("adodb.recordset")
		rssearch1.open sqlsearch1,conn,1,1
		search3=rssearch1("ClassName")
		search4=rssearch1("ClassID")
	end if	

		News_ID=search4
		response.write "<tr height='30'><td><select name='ClassID'><option value="&search4&">"&search3&"</option>"
		else
		response.write "<tr height='30'><td><select name='ClassID'><option value=''>所有栏目</option>"
		end if
		call Admin_ShowClass_Option2(3,0)
		response.write "</select>&nbsp;</td></tr><tr height='30'><td><input type='text' name='keyword'  size='17' value='关键字' maxlength='50' onFocus='this.select();'>&nbsp;</td></tr>"
		response.write "<tr height='30'><td><input src='images/search.gif' type='image' name='Submit'  value='  '></td></tr>"
	end if
	response.write "</form></table>"
end sub

%>
上一页 12
💿 文件大小 1592 K
👤 上传用户 novelty1234
📂 所属分类其他
🏷️ 相关标签

#太阳能 #企业网站 #网站 #程序
⌨️ 快捷键说明

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