📄 const.asp

📁 OFFICE办公自动化
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
   if int(currentpage)<rs.pagecount then Str = Str & "<a href=javascript:GoURL('?page="&rs.pagecount&"')>末页</a>　"

   SearchPaging = Str
end function
Function SearchScrip(Search)
'显示查询结果要调用的脚本(POST)
   dim Str
   Str = "<form name=pagefrm method=POST style='display:none'><input type=hidden name=Search value="""&Server.HTMLEncode(Search)&"""></form>"
   Str = Str+"<script language=javascript>function GoURL(url){pagefrm.action=url; pagefrm.submit();}</script>"
   SearchScrip=Str
end function

'---------------------------------------------------------
Function GetMember(id,department,title)
'部门人员列表-下拉菜单组件(当前ID值,当前部门,菜单标题)----
	dim i
	set rs_member=Server.CreateObject("ADODB.RECORDSET")
	rs_member.Open "select * from tbioaUser where Department='"& department &"'",oconn
	i=0
	if title<>"" then
		response.write("group["&id&"][0]= new Option('"&title&"','');")
		i=i+1
	end if
	while rs_member.EOF<>true
		response.write("group["&id&"]["&i&"]= new Option('"& Server.HTMLEncode(rs_member("Name")) &"','"& rs_member("ID") &"');")
		rs_member.MoveNext
		i=i+1
	wend
	rs_member.close
End Function

'---------------------------------------------------------
Public Function MsgOut(Msg,href,mode)
'输出提示信息(信息,返回URL,显示样式[0|1])-----------------
	if mode=1 then
		Response.Write "<html><meta http-equiv=Content-Type content=text/html; charset=gb2312><SCRIPT LANGUAGE=javascript>alert('" & Msg & " ');window.open('"  & href & "','_self'); </SCRIPT></html>"
	elseif mode=2 then
		Response.Write "<html><meta http-equiv=Content-Type content=text/html; charset=gb2312><head><meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312""></head>"
		Response.Write "<body><BR> <BR><p align=""center"">" & Msg & "</p>"
		Response.Write "<p align=""center""><a href=""" & href & """>返回</a></p></body></html>"
	end if
End Function

'---------------------------------------------------------
Function CheckUserRight(Rights,Userright)
'验证权限(权限集,当前权限值)------------------------------
   tempright=split(rights,",")
   for i=0 to ubound(tempright)
	if tempright=userright then
	   result=true
	end if
  next
End Function

'-------------------------------------------------------
Function Options(TableName,Field,Selected)
'下拉菜单(表名,字段名,选中字段值)-----------------------
	if selected="" then selected=0
	set Rstmp=server.createobject("adodb.recordset")
	str = "select * from "& TableName &" order by id"
	Rstmp.open str,oConn,1,1
	while not Rstmp.eof
		if cint(Rstmp("id"))= cint(selected) then
			response.write "<option value="&Rstmp("id")&" selected>"&server.htmlencode(trim(Rstmp(field)))  & vbcrlf
		else
			response.write "<option value="&Rstmp("id")&">"&server.htmlencode(trim(Rstmp(field)))  & vbcrlf
		end if
		Rstmp.MoveNext
	wend
	Rstmp.close
	set Rstmp=nothing
End Function

'-----------------------------------------------------------
Function pOptions(TableName,Field,ParentID,Selected,Heads)
'递归下拉菜单(表名,字段名,选中字段ID,起始字段ID,分割头)-----
	set rs_department=Server.CreateObject("ADODB.RecordSet")
	sql="select * from "& TableName &" where ParentID="& ParentID &" order by ID"
	rs_department.open sql,oConn,1,1
	while not rs_department.EOF '循环
		if Selected="" then Selected=0
		if rs_department("ID")= cint(Selected) then
			response.write "<option value='"&rs_department("ID")&"' selected>"& Heads & rs_department(Field)&"</option>" & vbcrlf
		else
			response.write "<option value='"&rs_department("ID")&"'>"& Heads & rs_department(Field)&"</option>" & vbcrlf
		end if
		Call pOptions(TableName,Field,rs_department("ID"),Selected,Heads&"├-")
	rs_department.MoveNext: wend
	rs_department.close
End Function
'-----------------------------------------------------------

Function pOptions2(TableName,Field,ParentID,Selected,Heads,ParentField)
'递归下拉菜单(表名,字段名,选中字段ID,起始字段ID,分割头,上级栏目字段名)-----
	set rs_department=Server.CreateObject("ADODB.RecordSet")
	sql="select * from "& TableName &" where "&ParentField&" = "& ParentID &" order by ID"
	rs_department.open sql,oConn,1,1
	while not rs_department.EOF '循环
		if Selected="" then Selected=0
		if rs_department("ID")= cint(Selected) then
			response.write "<option value='"&rs_department("ID")&"' selected>"& Heads & rs_department(Field)&"</option>" & vbcrlf
		else
			response.write "<option value='"&rs_department("ID")&"'>"& Heads & rs_department(Field)&"</option>" & vbcrlf
		end if
		Call pOptions2(TableName,Field,rs_department("ID"),Selected,Heads&"├-",ParentField)
	rs_department.MoveNext: wend
	rs_department.close
End Function



Function selected(tvalue,fvalue)
'处理selected框默认选项
	if tvalue=fvalue then selected=" selected"
End Function

'-----------------------------------------------------------
Function formnametoflowname(formname)
'通过表单名取流程名（表单名）
	if formname<>"" then
		Set RsTmp = Server.Createobject("Adodb.recordset")
		strSql = "Select flow_name from workflow_form_name where form_name='"& form_name &"'"
		Rstmp.open strSql,oConn,1,1
		If not Rstmp.eof then
			formnametoflowname=trim(Rstmp("flow_name"))
		else
			formnametoflowname=""
		end if
		Rstmp.close
		set RsTmp = Nothing
	else
		formnametoflowname=""
	end if
End Function

'----------------------------------------------------
Function GetUserRole(UserID)
'通过用户ID取用户职位
	if Isnumeric(UserID) and UserID<>"" and UserID<>0 then
		Role=GetTableValue("tbioaUser","RoleID","id",UserID)
		if len(Role)>0 then
			TmpSQL="Select RoleName  from tbioaRole where id in (" & role & ")"
			Set RsTmp = Server.Createobject("Adodb.recordset")
			Rstmp.open TmpSQL,oConn,1,1
			do while not Rstmp.eof
				Rolename=Rolename & Rstmp("RoleName") & " "
				Rstmp.MoveNext
			loop
			Rstmp.close
			Set Rstmp=nothing
			GetUserRole=Rolename
		else
			GetUserRole=""
		end if
	else
		GetUserRole=UserID
	end if
End Function
'----------------------------------------------------
Function AgentSysMsg(userid,body)
'加入OA精灵系统消息提醒
	oConn.Execute "INSERT INTO tbioaAgent (userid,body) VALUES ("&userid&",'"&replace(body,"'","''")&"')" '提醒内容
End Function
'-----------------------------------------------------------
Function UserNameToName(UserName)
'通过用户名取姓名（用户名）
	if UserName<>"" then
		Set RsTmp = Server.Createobject("Adodb.recordset")
		strSql = "Select Name from tbioaUser where LoginName='"& UserName & "'"
		Rstmp.open strSql,oConn,1,1
		If not Rstmp.eof then
			UserNameToName=trim(Rstmp("Name"))
		else
			UserNameToName=""
		end if
		Rstmp.close
		set RsTmp = Nothing
	else
		UserNameToName=""
	end if
End Function

''''''''''''''''''''转换日期，将时间格式化字符串'''''''''''''''''''''''''
function DateToStr(dtDateTime)
    DateToStr = year(dtDateTime) & doublenum(Month(dtdateTime)) & doublenum(Day(dtdateTime)) & doublenum(Hour(dtdateTime)) & doublenum(Minute(dtdateTime)) & doublenum(Second(dtdateTime)) & ""
end function

function doublenum(fNum)
    if fNum > 9 then
        doublenum = fNum
    else
        doublenum = "0" & fNum
    end if
end function

function GetDate(dtDateTime)
    if dtDateTime<>"" then
    	GetDate = right(year(dtDateTime),2) &"."& Month(dtdateTime) &"."& Day(dtdateTime)
    else
    	GetDate = "--"
    end if
end function
function GetDay(dtDateTime)
    if dtDateTime<>"" then
    	GetDay = Month(dtdateTime) &"."& Day(dtdateTime)
    else
    	GetDay = "-"
    end if
end function

'''''''''''''''''''''''删除文件'''''''''''''''''''''''''''''
'  FilePath：文件路径及文件名
Sub DelFile(FilePath)
	        Set Fso = CreateObject("Scripting.FileSystemObject")
	        FilePathTemp=Server.mappath(FilePath)
		if Fso.fileExists(FilePathTemp)=true then
			Set F1 = fso.GetFile(FilePathTemp)
			F1.Delete
		end if
		Set F1=nothing
		Set Fso=nothing
End sub

''''''''''''''''''''''返回当前用户是否有文件操作权限'''''''''''''''''''''
Function ReturnManage(managemod,ArchivesID,SField,STable)
''''''''''''''''''''''列表类型,id号，查找字段，查找表名
'返回用户是否有管理/查看权限
dim i,ManageStr
if ArchivesID<>"" and IsNumeric(ArchivesID) then
	select case managemod		'管理/查看列表类型  0：所有用户 1：部门2：职务
		case "0"
			ReturnManage=true
		case "1"
			TmpSQL="select "&SField&" from " & STable & " where id="&ArchivesID	'取得管理/查看权限
			set TmpRS=Server.CreateObject("ADODB.RecordSet")
			TmpRS.open TmpSQL,oconn,1,1
			if TmpRS.eof then
				TmpRS=close
				set TmpRS=nothing
				ReturnManage=false
			else
				ManageStr=TmpRS(SField)
				TmpRS.close
				set TmpRS = nothing
				if len(ManageStr)>0 then
					if Instr(1,","&ManageStr&",",","&session("DepID")&",", 1)>0 then '判断管理/查看权限中是否包含有当前用户部门ID
						ReturnManage=true
					else
						ReturnManage=false
					end if
				else
					ReturnManage=false
				end if
			end if
		case "2"
			TmpSQL="select "&SField&" from " & STable & " where id="&ArchivesID	'取得管理/查看权限
			set TmpRS=Server.CreateObject("ADODB.RecordSet")
			TmpRS.open TmpSQL,oconn,1,1
			if TmpRS.eof then
				ReturnManage=false
			else
				ManageStr=TmpRS(SField)
				TmpRS=close
				TmpSQL="select roleID from tbioaUser where id="&session("LoginID")	'取得当前用户职务
				set TmpRS=Server.CreateObject("ADODB.RecordSet")
				TmpRS.open TmpSQL,oconn,1,1
				if TmpRS.eof then
					TmpRS.close
					set TmpRS=nothing
					ReturnManage=false
				else
					RoleArr=split(TmpRS("RoleID"),",")
					TmpRS.close
					set TmpRS=nothing
					ReturnManageR=false
					for i=0 to UBound(RoleArr)
						if instr(1,","&ManageStr&",",","&RoleArr(i)&",")>0 then	'判断管理/查看权限中是否包含有当前用户职务
							ReturnManageR=true
						end if
					next
					ReturnManage=ReturnManageR
				end if
			end if
		case else
			ReturnManage=false
	end select
else
	ReturnManage=false
end if
end Function

'上传文件－保存文件
function SaveFile(FileName,FileBody)
  if trim(FileBody)<>"" then
	Set dr = CreateObject("Adodb.Stream")
	dr.Mode = 3:dr.Type = 1:dr.Open
	dr.write FileBody
	dr.SaveToFile FileName, 2
	dr.Close:Set dr = Nothing
	SaveFile=true
  else
  	SaveFile=false
  end if
end function

''''''''''''''''''''''判断用户操作权限'''''''''''''''''''''
function getRights()
	'取用户权限
	dim UserRights,LoginID,i
	LoginID=trim(session("LoginID")) : if LoginID="" then LoginID=0 '当前用户ID
	RoleID=GetTableValue("tbioaUser","RoleID","ID",LoginID)
	Roles=split(RoleID,",")
	for i=0 to ubound(Roles)
		rights=GetTableValue("tbioaRole","rights","ID",Roles(i))
		if rights<>"" then UserRights=UserRights+rights+", "
	next
	getRights=UserRights
end function

function checkqx(smenuid)
	'判断权限 输出错误提示
	userRights=getRights()'取用户权限
	'response.write userRights
	dim i
	sqx="X"
	amenuid=split(smenuid,",")
	for i=0 to ubound(amenuid)
		if GetTableValue("tbioaRoleRights","Mod","Number",amenuid(i))<>"X" then
			if instr(userRights,amenuid(i))>=1 then sqx=amenuid(i)
			'Response.Write "BH" & amenuid(i) & ":" & sqx & "<br>"
			if sqx<>"X" then exit function
		end if
	next
	if sqx="X" then
		response.write "<Script language=""vbscript"">" & vbCrLf
		response.write "	msgbox ""您无权限进行此模块的操作，请和管理人员联系！"",vbExclamation,""权限受限""" & vbCrLf
		response.write "</Script>" & vbCrLf
		Response.End
	end if
end function


function returnqx(smenuid)
	'判断权限 不输出错误提示
	userRights=getRights()'取用户权限
	'response.write userRights
	dim i
	sqx="X"
	'If Right(smenuid,1)<>"," Then smenuid=smenuid&","
	amenuid=split(smenuid,",")
	for i=0 to ubound(amenuid)
		if GetTableValue("tbioaRoleRights","Mod","Number",amenuid(i))<>"X" then
			if instr(userRights,amenuid(i))>=1 then sqx=amenuid(i)
			'Response.Write "BH" & amenuid(i) & ":" & sqx & "<br>"
			if sqx<>"X" then returnqx=true:exit function
		end if
	next
	returnqx=false
end function

'---------------------------------------------------------------------------------
Function GetTreeId(TableName,Field,ParentField,ParentID)
'取目录树ID(表名,字段名,上级栏目字段名,字段ID)-----
	GetTreeId=ParentID&TreeId(TableName,Field,ParentField,ParentID)
End Function
Function TreeId(TableName,Field,ParentField,ParentID)
'取下级栏目ID(表名,字段名,上级栏目字段名,字段ID)-----
	dim rs_temp,ids
	ids=""
	set rs_temp=Server.CreateObject("ADODB.RecordSet")
	sql="select "&Field&" from "& TableName &" where "&ParentField&" = "& ParentID &" order by "&Field
	rs_temp.open sql,oConn,1,1
	while not rs_temp.EOF '循环
		ids=ids&","&rs_temp("id")
		ids=ids&TreeId(TableName,Field,ParentField,rs_temp("id"))
		rs_temp.MoveNext
	wend
	rs_temp.close
	set rs_temp=nothing
	TreeId=ids
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'=========================================================
'''''''''''''''
'  常量定义   '
'''''''''''''''
const Corp="卓耀科技 网络办公系统 电话:13438368506 QQ:15921667"
const qx_zhyw="1117" '编辑所有综合业务信息
const qx_jjwfaj="1218" '编辑所有经济违法案件信息
const qx_htgl="1311" '编辑所有合同信息
%> <font face="宋体" size=2>
上一页 12
⌨️ 快捷键说明

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