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

📄 function.asp

📁 官方最新的南方数据v12生成静态商业版。全站生成静态。
💻 ASP
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
	ON ERROR RESUME NEXT
	dim WINNT_CHINESE
	WINNT_CHINESE    = (len("中国")=2)
	if WINNT_CHINESE then
        dim l,t,c
        dim i
        l=len(str)
        t=l
        for i=1 to l
        	c=asc(mid(str,i,1))
            if c<0 then c=c+65536
            if c>255 then
                t=t+1
            end if
        next
        strLength=t
    else 
        strLength=len(str)
    end if
    if err.number<>0 then err.clear
end function

'****************************************************
'函数名：SendMail
'作  用：用Jmail组件发送邮件
'参  数：ServerAddress  ----服务器地址
'        AddRecipient  ----收信人地址
'        Subject       ----主题
'        Body          ----信件内容
'        Sender        ----发信人地址
'****************************************************
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>" & vbcrlf
	strErr=strErr & "<table cellpadding=2 cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
	strErr=strErr & "  <tr align='center'><td height='20' class='title'><strong>错误信息</strong></td></tr>" & vbcrlf
	strErr=strErr & "  <tr><td height='100' class='tdbg' valign='top'><b>产生错误的可能原因：</b><br>" & errmsg &"</td></tr>" & vbcrlf
	strErr=strErr & "  <tr align='center'><td class='title'><a href='javascript:history.go(-1)'>【返回】</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>" & vbcrlf
	strSuccess=strSuccess & "<table cellpadding=2 cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
	strSuccess=strSuccess & "  <tr align='center'><td height='20' class='title'><strong>恭喜你！</strong></td></tr>" & vbcrlf
	strSuccess=strSuccess & "  <tr><td height='100' class='tdbg' valign='top'><br>" & SuccessMsg &"</td></tr>" & vbcrlf
	strSuccess=strSuccess & "  <tr align='center'><td class='title'><a href='javascript:history.go(-1)'>【返回】</a></td></tr>" & vbcrlf
	strSuccess=strSuccess & "</table>" & vbcrlf
	strSuccess=strSuccess & "</body></html>" & vbcrlf
	response.write strSuccess
end sub

function getFileExtName(fileName)
    dim pos
    pos=instrrev(filename,".")
    if pos>0 then 
        getFileExtName=mid(fileName,pos+1)
    else
        getFileExtName=""
    end if
end function 


'=================================================
'过程名：ShowPrevNews
'作  用：显示上一篇新闻
'参  数：TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowPrevNews(TitleLen)
	dim rsPrev,sqlPrev
	sqlPrev="Select Top 1 * From 0791idc_News Where BigClassName='"&BigClass&"' and ID<" & rsnews("ID")& " order by ID DESC"
	Set rsPrev= Server.CreateObject("ADODB.Recordset")
	rsPrev.open sqlPrev,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsPrev.Eof then
	  	response.write "没有了"
	else
	
	   If ISHTML = 1 Then
	     AutoLink = ""&NewName&""&Separated&""&rsPrev("ID")&"."&HTMLName&""
       Else
	    response.write "<a href='Shownews.asp?ID=" & rsPrev("ID")& "&BigClass="&BigClass&"' title='新闻标题：" & rsPrev("Title") & vbcrlf & "作    者：" & rsPrev("User") & vbcrlf & "更新时间：" & rsPrev("AddDate") & vbcrlf & "点击次数：" & rsPrev("Hits") &"'>" &gotTopic(rsPrev("Title"),TitleLen)  &"</a>"
       End If
    response.write "<a href="""&AutoLink&""">"&gotTopic(rsPrev("Title"),TitleLen)&"</a>"&VbCrLf
	
		
	end if
	rsPrev.close
	set rsPrev=nothing
end sub

'=================================================
'过程名：ShowNextNews
'作  用：显示上一篇新闻
'参  数：TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowNextNews(TitleLen)
	dim rsNext,sqlNext
	sqlNext="Select Top 1 * From 0791idc_News Where BigClassName='"&BigClass&"' and ID>" & rsnews("ID")& " order by ID ASC"
	Set rsNext= Server.CreateObject("ADODB.Recordset")
	rsNext.open sqlNext,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsNext.Eof then
	 	response.write "没有了"
	else
	  	If ISHTML = 1 Then
	     AutoLink = ""&NewName&""&Separated&""&rsNext("ID")&"."&HTMLName&""
       Else
	    response.write "<a href='Shownews.asp?ID="&rsNext("ID")& "&BigClass="&BigClass&"' title='新闻标题：" & rsNext("Title") & vbcrlf & "作    者：" & rsNext("User") & vbcrlf & "更新时间：" & rsNext("AddDate") & vbcrlf & "点击次数：" & rsNext("Hits") &"'>" &gotTopic(rsNext("Title"),TitleLen) &"</a>"
       End If
    response.write "<a href="""&AutoLink&""">"&gotTopic(rsNext("Title"),TitleLen)&"</a>"&VbCrLf
	
	  	
	end if
	rsNext.close
	set rsNext=nothing
end sub


'=================================================
'过程名：ShowPrevProduct
'作  用：显示上一个产品
'参  数：TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowPrevProduct(TitleLen)

	dim rsPrev,sqlPrev
	sqlPrev="Select Top 1 * From 0791idc_Product Where ID<"&ID&" order by ID DESC"
	Set rsPrev= Server.CreateObject("ADODB.Recordset")
	rsPrev.open sqlPrev,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsPrev.Eof then
	  	response.write "没有了"
	else
	 If ISHTML = 1 Then
	   AutoLink = ""&ProName&""&Separated&""&rsPrev("ID")&"."&HTMLName&""
	   response.write "<a href="""&AutoLink&""">"&gotTopic(rsPrev("Title"),TitleLen)&"</a>"&VbCrLf
     Else
	  response.write "<a href='ProductShow.asp?ID=" & rsPrev("ID")& "&ClassID="&ClassID&"' title='产品名称：" & rsPrev("Title") & vbcrlf & "更新时间：" & rsPrev("UpdateTime") & vbcrlf & "点击次数：" & rsPrev("Hits") &"'>" &gotTopic(rsPrev("Title"),TitleLen)  &"</a>"
     End If		
	end if
	rsPrev.close
	set rsPrev=nothing
end sub

'=================================================
'过程名：ShowNextProduct
'作  用：显示上一个产品
'参  数：TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowNextProduct(TitleLen)
	dim rsNext,sqlNext
	sqlNext="Select Top 1 * From 0791idc_Product Where ID>"&ID&" order by ID ASC"
	Set rsNext= Server.CreateObject("ADODB.Recordset")
	rsNext.open sqlNext,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsNext.Eof then
	 	response.write "没有了"
	else
	
	 If ISHTML = 1 Then
	  AutoLink = ""&ProName&""&Separated&""&rsNext("ID")&"."&HTMLName&""
	  response.write "<a href="""&AutoLink&""">"&gotTopic(rsNext("Title"),TitleLen)&"</a>"&VbCrLf
     Else
	  response.write "<a href='ProductShow.asp?ID="&rsNext("ID")& "&ClassID="&ClassID&"' title='产品名称：" & rsNext("Title") & vbcrlf & "更新时间：" & rsNext("UpdateTime") & vbcrlf & "点击次数：" & rsNext("Hits") &"'>" &gotTopic(rsNext("Title"),TitleLen) &"</a>"
     End If     
	
	  	
	end if
	rsNext.close
	set rsNext=nothing
end sub

'==================================================
'过程名：MenuJS
'作  用：生成下拉菜单相关的JS代码
'参  数：无
'==================================================
sub MenuJS()
	response.write "<script type='text/javascript' language='JavaScript1.2' src='Inc/Southidcmenu.js'></script>"
end sub

dim pNum,pNum2
pNum=1
pNum2=0
'=================================================
'过程名：ShowRootClass_Menu
'作  用：显示一级栏目（下拉菜单效果）
'参  数：无
'=================================================
sub ShowRootClass_Menu()
	response.write "<script type='text/javascript' language='JavaScript1.2'>" & vbcrlf & "<!--" & vbcrlf
	response.write "stm_bm(['uueoehr',400,'','images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
	response.write "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
	response.write "stm_ai('p0i0',[0,'','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
	If ISHTML = 1 then
	response.write "stm_aix('p0i1','p0i0',[0,'<strong>&nbsp;&nbsp;首 页</strong>','','',-1,-1,0,'index.html ','_self','index.html','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体 ']);" & vbcrlf
	else
		response.write "stm_aix('p0i1','p0i0',[0,'<strong>&nbsp;&nbsp;首 页</strong>','','',-1,-1,0,'index.asp ','_self','index.asp','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体 ']);" & vbcrlf
    end if		
	response.write "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf

	dim sqlRoot,rsRoot,j
	sqlRoot="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From 0791idc_MenuClass"
	sqlRoot= sqlRoot & " where Depth=0 and ShowOnTop="&TrueType&" order by RootID"
	Set rsRoot= Server.CreateObject("ADODB.Recordset")
	rsRoot.open sqlRoot,conn,1,1
	if not(rsRoot.bof and rsRoot.eof) then 
		j=3
		do while not rsRoot.eof
			if rsRoot(4)<>"" then
				response.write "stm_aix('p0i"&j&"','p0i0',[1,'<strong>" & rsRoot(1) & " </strong>','','',-1,-1,0,'" & rsRoot(4) & "','_self','" & rsRoot(4) & "','" & rsRoot(6) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体']);" & vbcrlf							
			end if
			if rsRoot(5)>0 then
				call GetClassMenu(rsRoot(0),0)
			end if
			j=j+1
			response.write "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf 			
			j=j+1
			rsRoot.movenext
		loop
	end if
	rsRoot.close
	set rsRoot=nothing
	response.write "stm_em();" & vbcrlf
	response.write "//-->" & vbcrlf & "</script>" & vbcrlf	
end sub

sub GetClassMenu(ID,ShowType)
	dim sqlClass,rsClass,k
	'1,4,0,4,2,3,6,7,100前4个数字控制菜单位置和大小,第4个“4”控制菜单离工具栏高度，第一个“1”控制是横向显示 
	if pNum=1 then
		response.write "stm_bp('p" & pNum & "',[1,4,0,4,2,3,6,7,100,'progid:DXImageTransform.Microsoft.Fade(overlap=.5,enabled=0,Duration=0.43)',-2,'',-2,67,2,3,'#999999','#EBEBEB','',3,1,1,'#aca899']);" & vbcrlf
		'#EBEBEB菜单背景色
	else
		if ShowType=0 then
			response.write "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,4,0,0,2,3,6]);" & vbcrlf
		else
			response.write "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,2,-2,-3,2,3,0]);" & vbcrlf
		end if
	end if
	
	k=0
	sqlClass="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From 0791idc_MenuClass"
	sqlClass= sqlClass & " where ParentID=" & ID & " order by OrderID asc"
	Set rsClass= Server.CreateObject("ADODB.Recordset")
	rsClass.open sqlClass,conn,1,1
	do while not rsClass.eof
		if rsClass(4)<>"" then
			if rsClass(5)>0 then
				response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(4) & "','_self','" & rsClass(4) & "','" & rsClass(6) & "','','',6,0,0,'images/arrow_r.gif','images/arrow_w.gif',7,7,0,0,1,'#FFFFFF',0,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbcrlf
				pNum=pNum+1
				pNum2=pNum2+1
				call GetClassMenu(rsClass(0),1)
			else
				response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(4) & "','_self','" & rsClass(4) & "','" & rsClass(6) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#FFFFFF',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbcrlf
			end if			
		end if
		k=k+1
		rsClass.movenext
	loop
	rsClass.close
	set rsClass=nothing
	response.write "stm_ep();" & vbcrlf	
end sub



'==================================================
'过程名：ShowAnnounce
'作  用：显示本站公告信息
'        AnnounceNum  ----最多显示多少条公告
'==================================================
sub ShowAnnounce(AnnounceNum)
	dim sqlAnnounce,rsAnnounce,i
	if AnnounceNum>0 and AnnounceNum<=10 then
		sqlAnnounce="select top " & AnnounceNum
	else
		sqlAnnounce="select top 10"
	end if
	sqlAnnounce=sqlAnnounce & " * from 0791idc_affiche order by ID Desc"	
	Set rsAnnounce= Server.CreateObject("ADODB.Recordset")
	rsAnnounce.open sqlAnnounce,conn,1,1
	if rsAnnounce.bof and rsAnnounce.eof then 
		AnnounceCount=0
1234

⌨️ 快捷键说明

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