function.asp

动感系统XP Access版,服务器需要安装Jmail 组件 配置SendMessages.asp 最后部分的参数

<%
'****************************************************************
'超级管理员身份验证函数

function chkMaster(ChkUser) 
	chkMaster=false
        set chkrs=server.createobject("adodb.recordset")
        sql="select isAdmin from Admin_UserInfo where CategoryName='"&CategoryName&"' and UserName='"&ChkUser&"'"
        chkrs.open sql,conn,1,1 
        if not (chkrs.bof and chkrs.eof) then 
			if chkrs("isAdmin") then chkMaster=true		
        end if
	chkrs.close
	set chkrs=nothing
end function

'****************************************************************
'检验用户的发布和管理权限函数，在用户查看权限及管理员设置用户权限时用。
function chk_isflag(selID,strFlag)
	chk_isflag=false
	splFlag=split(strFlag,",")
	for i=0 to ubound(splFlag)
		if trim(splFlag(i))=trim(selID) then
			chk_isflag=true
			exit for
		end if
	next
end function

function getuserflag(cUserName,isType)
	getuserflag=""
	set temRs=server.createobject("adodb.recordset")
        sql="select SoftDown_Addflag,Article_Addflag from Admin_UserInfo where UserName='"&cUserName&"'"
        temRs.open sql,conn,1,1 
        if not (temRs.bof and temRs.eof) then
			if isType="soft" then
				getuserflag=temRs("SoftDown_Addflag")
			elseif isType="article" then
				getuserflag=temRs("Article_Addflag")
			end if
		else
			getuserflag=""		
        end if
	temRs.close
	set temRs=nothing
end function
'******************************************************************
'检验用户的发布和管理权限函数，在用户发布和管理文章时用。

function chkPubUser(ChkUser,SubCateID) '检验发布权限
	chkPubUser=false
	set chkrs=server.createobject("adodb.recordset")
	sql="select CatePub,isActive from Admin_UserInfo where CategoryName='"&CategoryName&"' and UserName='"&ChkUser&"'"
	chkrs.open sql,conn,1,1 
	if not (chkrs.bof and chkrs.eof) then 
		temps_pub=split(chkrs("CatePub"), ",")
		for i = 0 to ubound(temps_pub)
		if trim(temps_pub(i))=trim(SubCateID) and chkrs("isActive")=true then
			chkPubUser=true
		exit for
        end if
		next
	end if
	chkrs.close
	set chkrs=nothing
end function


function chkAdmUser(ChkUser,SubCateID) '检验管理权限
	chkAdmUser=false

        set chkrs=server.createobject("adodb.recordset")
        sql="select CateAdm,isActive from Admin_UserInfo where CategoryName='"&CategoryName&"' and UserName='"&ChkUser&"'"
        chkrs.open sql,conn,1,1 
        if not (chkrs.bof and chkrs.eof) then 
	temps_Adm=split(chkrs("CateAdm"), ",")
	for i = 0 to ubound(temps_Adm)
	if trim(temps_Adm(i))=trim(SubCateID) and chkrs("isActive")=true then
		chkAdmUser=true
		exit for
        end if
	next
        end if
	chkrs.close
	set chkrs=nothing
end function


'******************************************************************
'检验用户对软件的修改权。

function chkSoftEdit(ChkUser,SoftID)
	chkSoftEdit=false
	set chkrs=server.createobject("adodb.recordset")
	sql="select isAdmin from Admin_UserInfo where CategoryName='"&CategoryName&"' and UserName='"&ChkUser&"'"
	chkrs.open sql,conn,1,1 
	if not (chkrs.bof and chkrs.eof) then 
		if chkrs("isAdmin") then chkSoftEdit=true		
	end if
	chkrs.close
 
	sql="select SoftID from "&CategoryName&"_SoftInfo where username='"&trim(ChkUser)&"' and SoftID="&SoftID
	set chkrs=server.createobject("adodb.recordset")
	chkrs.open sql,conn,1,1
	if not (chkrs.bof and chkrs.eof) then chkSoftEdit=True
	chkrs.close
	set chkrs=nothing
end function
'******************************************************************
'检验用户对文章的修改权。

function chkArticleEdit(ChkUser,ArticleID)
	chkArticleEdit=false
	set chkrs=server.createobject("adodb.recordset")
	sql="select isAdmin from Admin_UserInfo where CategoryName='"&CategoryName&"' and UserName='"&ChkUser&"'"
	chkrs.open sql,conn,1,1 
	if not (chkrs.bof and chkrs.eof) then 
		if chkrs("isAdmin") then chkArticleEdit=true		
	end if
	chkrs.close
 
	sql="select ArticleID from Info_Article where username='"&trim(ChkUser)&"' and ArticleID="&SoftID
	set chkrs=server.createobject("adodb.recordset")
	chkrs.open sql,conn,1,1
	if not (chkrs.bof and chkrs.eof) then chkArticleEdit=True
	chkrs.close
	set chkrs=nothing
end function

'******************************************************************
'日期格式转换函数

function DateTimeFormat(DateTime,Format) 
select case Format
case "1"
	DateTimeFormat=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日"
case "2"
	DateTimeFormat=""&month(DateTime)&"月"&day(DateTime)&"日"
case "3" 
	DateTimeFormat=""&year(DateTime)&"/"&month(DateTime)&"/"&day(DateTime)&""
case "4"
	DateTimeFormat=""&month(DateTime)&"/"&day(DateTime)&""
case "5"
	DateTimeFormat=""&month(DateTime)&"月"&day(DateTime)&"日 "&FormatDateTime(DateTime,4)&""
case "6"
	DateTimeFormat=""&year(DateTime)&"."&month(DateTime)&"."&day(DateTime)&""
case "7"
	DateTimeFormat=""&month(DateTime)&"."&day(DateTime)&""
case "8"
	temp="周日,周一,周二,周三,周四,周五,周六"
	temp=split(temp,",") 
	DateTimeFormat=temp(Weekday(DateTime)-1)
case else
	DateTimeFormat=DateTime
end select
if FormatDateTime(DateTime,1)=FormatDateTime(Now(),1) then DateTimeFormat="<FONT color=red>"&DateTimeFormat&"</FONT>"
end function

'************************************************
function cutStr(str,strlen)
	dim l,t,c
	l=len(str)
	t=0
	for i=1 to l
	c=Abs(Asc(Mid(str,i,1)))
	if c>255 then
		t=t+2
	else
		t=t+1
	end if
	if t>=strlen then
		cutStr=left(str,i)&".."
	exit for
	else
		cutStr=str
	end if
	next
	cutStr=replace(cutStr,chr(10),"")
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 get_browser(info)
    if Instr(info,"NetCaptor 6.5.0")>0 then
        get_browser="NetCaptor 6.5.0"
    elseif Instr(info,"MyIe 3.1")>0 then
        get_browser="MyIe 3.1"
    elseif Instr(info,"NetCaptor 6.5.0RC1")>0 then
        get_browser="NetCaptor 6.5.0RC1"
    elseif Instr(info,"NetCaptor 6.5.PB1")>0 then
        get_browser="NetCaptor 6.5.PB1"
    elseif Instr(info,"MSIE 5.5")>0 then
        get_browser="Internet Explorer 5.5"
    elseif Instr(info,"MSIE 6.0")>0 then
        get_browser="Internet Explorer 6.0"
    elseif Instr(info,"MSIE 6.0b")>0 then
        get_browser="Internet Explorer 6.0b"
    elseif Instr(info,"MSIE 5.01")>0 then
        get_browser="Internet Explorer 5.01"
    elseif Instr(info,"MSIE 5.0")>0 then
        get_browser="Internet Explorer 5.00"
    elseif Instr(info,"MSIE 4.0")>0 then
        get_browser="Internet Explorer 4.01"
    else
        get_browser="其它"
    end if
end function

function get_system(info)
    if Instr(info,"NT 5.2")>0 then
        get_system="Windows 2003"
    elseif Instr(info,"NT 5.1")>0 then
        get_system="Windows XP"
    elseif Instr(info,"Tel")>0 then
        get_system="Telport"
	elseif Instr(info,"webzip")>0 then
        get_system="webzip"
	elseif Instr(info,"flashget")>0 then
        get_system="flashget"
	elseif Instr(info,"offline")>0 then
        get_system="offline"
    elseif Instr(info,"NT 5")>0 then
        get_system="Windows 2000"
    elseif Instr(info,"NT 4")>0 then
        get_system="Windows NT4"
    elseif Instr(info,"98")>0 then
        get_system="Windows 98"
    elseif Instr(info,"95")>0 then
        get_system="Windows 95"
	elseif instr(info,"unix") or instr(info,"linux") or instr(info,"SunOS") or instr(info,"BSD") then
	    get_system="类Unix"
    elseif instr(thesoft,"Mac") then
	    get_system="Mac"
    else
        get_system="其它"
    end if
end function


public function translate(sourceStr,fieldStr)
rem 处理逻辑表达式的转化问题
  dim  sourceList
  dim resultStr
  dim i,j
  if instr(sourceStr," ")>0 then 
     dim isOperator
     isOperator = true
     sourceList=split(sourceStr)
     '--------------------------------------------------------
     rem Response.Write "num:" & cstr(ubound(sourceList)) & "<br>"
     for i = 0 to ubound(sourceList)
        rem Response.Write i 
    Select Case ucase(sourceList(i))
    Case "AND","&","和","与"
        resultStr=resultStr & " and "
        isOperator = true
    Case "OR","|","或"
        resultStr=resultStr & " or "
        isOperator = true
    Case "NOT","!","非","！","！"
        resultStr=resultStr & " not "
        isOperator = true
    Case "(","（","（"
        resultStr=resultStr & " ( "
        isOperator = true
    Case ")","）","）"
        resultStr=resultStr & " ) "
        isOperator = true
    Case Else
        if sourceList(i)<>"" then
            if not isOperator then resultStr=resultStr & " and "
            if inStr(sourceList(i),"%") > 0 then
                resultStr=resultStr&" "&fieldStr& " like '" & replace(sourceList(i),"'","''") & "' "
            else
                resultStr=resultStr&" "&fieldStr& " like '%" & replace(sourceList(i),"'","''") & "%' "
            end if
                isOperator=false
        End if    
    End Select
        rem Response.write resultStr+"<br>"
     next 
     translate=resultStr
  else '单条件
     if inStr(sourcestr,"%") > 0 then
         translate=" " & fieldStr & " like '" & replace(sourceStr,"'","''") &"' "
     else
    translate=" " & fieldStr & " like '%" & replace(sourceStr,"'","''") &"%' "
     End if
     rem 前后各加一个空格，免得连sql时忘了加，而出错。
  end if  
end function

Copyright = Copyright & vbcrlf & "<!--" & vbcrlf
Copyright = Copyright & "'****************************************************************" & vbcrlf
Copyright = Copyright & "'*  ActiveDown System XP Advanced Edition Ver2.0  Build 0513" & vbcrlf
Copyright = Copyright & "'*" & vbcrlf
Copyright = Copyright & "'*  动感下载系统XP Access版 Ver2.0  Build 1120" & vbcrlf
Copyright = Copyright & "'*" & vbcrlf
Copyright = Copyright & "'*  系统特性：批量生成静态页面，功能强大，用户访问速度极度优化，减轻服务器负担。" & vbcrlf
Copyright = Copyright & "'*  版权所有: 动感网络(mesky.net)" & vbcrlf
Copyright = Copyright & "'*  程序制作: 小张" & vbcrlf
Copyright = Copyright & "'*  程序修改: 小小宇" & vbcrlf
Copyright = Copyright & "'*  联系方式: email:[e-mail]  QQ:7924817 " & vbcrlf
Copyright = Copyright & "'*  主页地址: http://202.116.83.50/shaoli/  香巴拉" & vbcrlf
Copyright = Copyright & "'*  理想论坛: http://202.116.83.50/shaoli/bbs/" & vbcrlf
Copyright = Copyright & "'*                " & vbcrlf
Copyright = Copyright & "'****************************************************************" & vbcrlf
Copyright = Copyright & "'*" & vbcrlf
Copyright = Copyright & "'*  ActiveDown System XP Advanced Edition Ver2.0  Build 1120" & vbcrlf
Copyright = Copyright & "'*" & vbcrlf
Copyright = Copyright & "'*  Copyright 2001-2003 mesky.net - All Rights Reserved." & vbcrlf
Copyright = Copyright & "'*" & vbcrlf