📄 const.asp

📁 OFFICE办公自动化
💻 ASP
📖 第 1 页 / 共 2 页
字号:
12 下一页
<!--#include file="FormatTime.asp"-->
<%
'功能：自定义函数集与常量集
'作者：展亮
'日期: 2003-11-30 17:21
'【函数目录】---------------------------------------------
'取用户姓名	Function GetUserName(ID)
'取多个用户姓名	Function GetUserNames(ID,Splitchar)
'取字段值	Function GetTableValue(TableName,Field,ValueField,Value)
'取记录个数	Function GetTableNum(TableName,Where)
'判断字段唯一性	Function FindItem(TableName, FieldName, Value, Sid)
'删除一个文件	sub DeleteOneFile (FilePathName)
'处理表单参数	Function cRequest(strName)
'处理参数-替换单引号	Function cString(strName)
'处理HTML代码	Function HtmlOut(str)
'分页处理-GET	Function Paging(rs,maxmessage,currentpage,getstr)
'分页处理-POST	Function SearchPaging(rs,maxmessage,currentpage,Search)
'部门人员列表(下拉菜单组件调用)	Function GetMember(id,department,title)
'输出提示信息	Public Function MsgOut(Msg,href,mode)
'验证权限	Function CheckUserRight(Rights,Userright)
'下拉菜单	Function Options(TableName,Field,Selected)
'递归下拉菜单	Function pOptions(TableName,Field,ParentID,Selected,Heads)
'处理selected框默认选项	Function selected(tvalue,fvalue)
'通过表单名取流程名	Function formnametoflowname(formname)
'通过用户名取姓名	Function UserNameToName(UserName)
'通过用户ID取用户职位	Function GetUserRole(UserID)
'加入OA精灵系统消息提醒	Function AgentSysMsg(userid,body)
'取目录树ID Function GetTreeId(TableName,Field,ParentField,ParentID)
'【常量目录】---------------------------------------------
'公司名称	Corp

'=========================================================
'''''''''''''''
'  函数定义   '
'''''''''''''''
'---------------------------------------------------------
Function GetUserName(ID)
'取用户姓名(用户ID)----------------------------------------
	dim RsTmp
	if Isnumeric(ID) and ID<>"" and ID<>0 then
		Set RsTmp = Server.Createobject("Adodb.recordset")
		strSql = "Select Name from tbioaUser where ID="& ID
		Rstmp.open strSql,oConn,1,1
		If not Rstmp.eof then
			GetUserName=trim(Rstmp("Name"))
		else
			GetUserName=""
		end if
		Rstmp.close
		set RsTmp = Nothing
	else
		GetUserName=""
	end if
End Function

'---------------------------------------------------------
Function GetUserNames(ID,Splitchar)
'取多个用户姓名(用户ID列表,分割符)------------------------
	if trim(ID)="" then
		GetUserNames=""
		exit function
	end if
	dim rs
	set rs=server.CreateObject("adodb.recordset")
	dim slb
	dim sresult
	slb=replace("0,"&trim(ID),splitchar,",")
	sresult=""
	if len(slb)>2 then
		rs.Open "Select name from tbioaUser where id in(" & slb & ")",oConn,1,1
		do while not rs.EOF
			sresult=sresult & Splitchar & rs(0)
			rs.MoveNext
		loop
		rs.Close
	end if
	if sresult<>"" then
		sresult=mid(sresult,2)
	end if
	set rs=nothing
	GetUserNames=sresult
End Function

'---------------------------------------------------------
Function GetJylx(ID)
'取经营户类型(ID)----------------------------------------
	select case id
	case 1
		GetJylx="农资经营户"
	case 2
		GetJylx="食品经营户"
	case 0
		GetJylx="其他"
	case else
		GetJylx="未知"
	end select
End Function
'---------------------------------------------------------
Function GetLx(ID)
'取企业类型(ID)----------------------------------------
	select case id
	case 1
		GetLx="企业"
	case 0
		GetLx="个体工商户"
	case else
		GetLx="未知"
	end select
End Function
'---------------------------------------------------------
Function GetXydjColor(ID)
'取信用登记颜色(ID)----------------------------------------
	select case id
	case "A"
		GetXydjColor="green"
	case "B"
		GetXydjColor="blue"
	case "C"
		GetXydjColor="darkorange"
	case "D"
		GetXydjColor="black"
	case else
		GetXydjColor=""
	end select
End Function
'---------------------------------------------------------
Function GetAdMod(ID)
'取广告登记状态(ID)----------------------------------------
	select case id
	case 1
		GetAdMod="待审查"
	case 2
		GetAdMod="待审核"
	case 3
		GetAdMod="待发证"
	case 4
		GetAdMod="已发证"
	case 0
		GetAdMod="退回"
	case else
		GetAdMod="未知"
	end select
End Function
'---------------------------------------------------------
Function GetHtBaMod(ID)
'取合同条款备案状态(ID)----------------------------------------
	select case id
	case 1
		GetHtBaMod="待审核"
	case 2
		GetHtBaMod="审核通过"
	case 0
		GetHtBaMod="退回"
	case else
		GetHtBaMod="未知"
	end select
End Function
'---------------------------------------------------------
Function GetHtZyMod(ID)
'取合同条款备案状态(ID)----------------------------------------
	select case id
	case 1
		GetHtZyMod="待审核"
	case 2
		GetHtZyMod="调解中"
	case 3
		GetHtZyMod="已完成"
	case 0
		GetHtZyMod="退回"
	case else
		GetHtZyMod="未知"
	end select
End Function
'---------------------------------------------------------
Function GetPmMod(ID)
'取合同条款备案状态(ID)----------------------------------------
	select case id
	case 0
		GetPmMod="处理中"
	case 1
		GetPmMod="指派"
	case 2
		GetPmMod="登记"
	case 3
		GetPmMod="<font color=red>已完成</font>"
	case else
		GetPmMod="未知"
	end select
End Function
'---------------------------------------------------------
Function GetEconoLxaMod(ID)
'取合同条款备案状态(ID)----------------------------------------
	select case id
	'备案登记状态
	case -1
		GetEconoLxaMod="<font color=red>已退回</font>"
	case 0
		GetEconoLxaMod="已录入"
	case 1
		GetEconoLxaMod="处理中"	
	case 2
		GetEconoLxaMod="<font color=red>备案</font>-承办机构意见"
	'case 3
		'GetEconoLxaMod="核审机构意见"
	case 4
		GetEconoLxaMod="<font color=red>备案</font>-局领导意见"
	case 5
		GetEconoLxaMod="<font color=red>备案完成</font>"
	'提请审批状态
	case 6
		GetEconoLxaMod="提请审批"
	case 7
		GetEconoLxaMod="<font color=red>审批</font>-承办机构意见"
	case 8
		GetEconoLxaMod="<font color=red>审批</font>-局领导意见"	
	'核审状态	
	case 9
		GetEconoLxaMod="已提请核审"
	case 10
		GetEconoLxaMod="<font color=red>核审</font>-承办人报处意见"
	case 11
		GetEconoLxaMod="<font color=red>核审</font>-办案机构处罚建议"
	case 12
		GetEconoLxaMod="<font color=red>核审</font>-核审机构意见"
	case 13
		GetEconoLxaMod="<font color=red>核审</font>-局领导意见"
	case 14 
		GetEconoLxaMod="送达告知书"
	'处罚决定状态
	case 15
		GetEconoLxaMod="等待处罚决定"
	case 16
		GetEconoLxaMod="<font color=red>决议</font>-办案机构意见"
	case 17
		GetEconoLxaMod="<font color=red>决议</font>-核审机构意见"
	case 18
		GetEconoLxaMod="<font color=red>决议</font>-局领导意见"
	case 19
		GetEconoLxaMod="<font color=red>确定完成</font>"
	case else
		GetEconoLxaMod="未知"
	end select
End Function
'---------------------------------------------------------
Function GetLxaType(ID)
'取合同条款备案状态(ID)----------------------------------------
	select case id
	case 0
		GetLxaType="销案"
	case 1
		GetLxaType="立案"
	case else
		GetLxaType="未知"
	end select
End Function

'---------------------------------------------------------
Function GetTableValue(TableName,Field,ValueField,Value)
'取字段值(目的表名,目的字段名,源字段名,源字值)------------
	dim RsTmp,strSql
	if TableName<>"" and Value<>"" then
		Set RsTmp = Server.Createobject("Adodb.recordset")
		strSql = "Select "& Field &" from "& TableName &" where "& ValueField &"='"& Value &"'"
		Rstmp.open strSql,oConn,1,1
		If not Rstmp.eof then
			GetTableValue=trim(Rstmp(Field))
		else
			GetTableValue=""
		end if
		Rstmp.close
		set RsTmp = Nothing
	else
		GetTableValue=""
	end if
End Function

'---------------------------------------------------------
Function GetTableNum(TableName,Where)
'取记录个数(表名,查询条件)------
	dim RsTmp
	Set RsTmp = Server.Createobject("Adodb.recordset")
	strSql="select count(*) from "& TableName & " " &where
	RsTmp.open strSql,oConn,1,1
	GetTableNum=Rstmp(0)
	RsTmp.close
	set RsTmp=nothing
End Function

'---------------------------------------------------------
Function FindItem(TableName, FieldName, Value, Sid)
'判断字段唯一性(表名,字段名,字段值,不包含该ID的字段)------
	Set RsTmp = Server.Createobject("Adodb.recordset")
	strSql="select ID from "& TableName &" where "& FieldName &"='"& Value &"'"
	if Sid then strSql=strSql & " and id<>" & Sid
	RsTmp.open strSql,oConn,1,1
	If not Rstmp.eof then
		FindItem=true
	else
		FindItem=false
	end if
	RsTmp.close
	set RsTmp=nothing
End Function

'---------------------------------------------------------
sub DeleteOneFile (FilePathName)
'删除一个文件(文件路径)-----------------------------------
	FilePathName=Server.Mappath(FilePathName)
	dim fs
	Set fs = server.CreateObject("Scripting.FileSystemObject")
	if trim(FilePathName)<>"" and fs.FileExists(FilePathName) then
		fs.DeleteFile FilePathName
	end if
	set fs=nothing
end sub

'---------------------------------------------------------
Function cRequest(strName)
'处理Request参数(要处理的字符串)--------------------------
	cRequest=replace(trim(Request(trim(strName))),"'","''")
End Function

'---------------------------------------------------------
Function cString(strName)
'处理参数-替换单引号(要处理的字符串)--------------------------
	cString=replace(trim(strName),"'","''")
End Function

'---------------------------------------------------------
Function HtmlOut(str)
'将文字转化为它的源代码格式(要处理的字符串)---------------
   dim guest
   if isnull(str) or str="" then
   	htmlOut=str
   	exit function
   end if
   guest=str
   guest=Replace(Guest,"  ","　")
   guest=Replace(Guest," ","`nbsp;")

   Guest=server.htmlencode(Guest)
   guest=Replace(Guest,"`nbsp;"," ")
   guest=Replace(Guest,vbcrlf,"<BR>")
   HtmlOut=guest
end function

'---------------------------------------------------------
Function Paging(rs,maxmessage,currentpage,getstr)
'显示页码-GET(记录集,每页显示记录数,当前页码,传递值)------
   dim Str,i,ps,pe
   if currentpage="" then currentpage=1 '当前页码
   if getstr<>"" then getstr = getstr & "&" 'GET参数
   rs.pagesize=maxmessage '设置每页显示记录数
   if not rs.EOF then rs.AbsolutePage=currentpage '设置当前页码
   Str = " 共" & rs.recordcount & "条记录，分" & rs.pagecount & "页显示，每页" & maxmessage & "条　"

   if int(currentpage)>1 then Str = Str & "<a href=?" & getstr & "page=1>首页</a> "
   Str = Str & "["
   ps=int(currentpage)-5:if ps<1 then ps=1
   pe=ps+11:if pe>rs.pagecount then pe=rs.pagecount
   for i=ps to pe
     if i=int(currentpage) then
     	str=str & "<b>" & i & "</b>"
     else
     	str=str & "<a href=?" & getstr & "page=" & i & ">" & i & "</a>"
     end if
     if i<>rs.pagecount then str=str & " "
   next
   Str = Str & "]"
   if int(currentpage)<rs.pagecount then Str = Str & " <a href=?" & getstr & "page=" & rs.pagecount & ">末页</a>　"

   Paging = Str
end function

'---------------------------------------------------------
Function SearchPaging(rs,maxmessage,currentpage,Search)
'显示页码-POST(记录集,每页显示记录数,当前页码,传递值)-----
   dim Str,i,ps,pe
   Str=SearchScrip(Search) '#调用表单和脚本
   if currentpage="" then currentpage=1 '当前页码
   rs.pagesize=maxmessage '设置每页显示记录数
   if not rs.EOF then rs.AbsolutePage=currentpage '设置当前页码
   Str=Str+" 共" & rs.recordcount & "条/" & rs.pagecount & "页，每页" & maxmessage & "条　"

   if int(currentpage)>1 then Str = Str & "<a href=javascript:GoURL('?page=1')>首页</a>　"
   ps=int(currentpage)-5:if ps<1 then ps=1
   pe=ps+11:if pe>rs.pagecount then pe=rs.pagecount
   for i=ps to pe
     if i=int(currentpage) then
     	str=str & "<b>" & i & "</b> "
     else
     	str=str & "<a href=javascript:GoURL('?page="&i&"')>" & i & "</a> "
     end if
   next
12 下一页
⌨️ 快捷键说明

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