checkright.asp

来自「投资管理系统, asp+ mssql server」· ASP 代码 · 共 1,233 行 · 第 1/4 页
ASP
1,233 行

	TempUpdateValue = TempUpdateValue + ObjID + "="

	if ObjIDValue <> "" then
		if HaveYing then
			TempUpdateValue = TempUpdateValue + "'" + ObjIDValue + "'"
		else
			TempUpdateValue = TempUpdateValue + ObjIDValue
		end if
	else
		TempUpdateValue = TempUpdateValue + "null"
	end if

	GetUpdateValue = TempUpdateValue
end function


'=======================================================================================================
SUB PutHtmlSelectObject(SelObjName,PutTypeStr,OptionStr,OptionValue,CompValue,EventStr)
	response.write "<select name=""" & SelObjName & """" & chr(13)

	if trim(EventStr)<>"" then
		response.write " " & EventStr
	end if

	response.write ">"
	if trim(PutTypeStr)<>"" then
		response.write "<option value="""">" & PutTypeStr & "</option>" & chr(13)
	end if

	arrOptionStr = split(OptionStr,",")
	arrOptionValue = split(OptionValue,",")
	for OptionNum = 0 to UBound(arrOptionStr)
		response.write "     <option value=""" & arrOptionValue(OptionNum) & """"
		if cstr(arrOptionValue(OptionNum)) = cstr(CompValue) then
			Response.Write " selected"
		end if
		Response.Write ">" & arrOptionStr(OptionNum) & "</option>" & chr(13)
	next
	response.write "</select>"
END SUB

'
'
'=================================================================================================
SUB PutParentData(SelectObjName,ParentData)
	PutHtmlSelectObject SelectObjName,"--请选择所在模块--","个人资料保管箱,个人记事簿,个人通讯录,日程安排","DataKeep,Notepad,AddressList,Calendar",ParentData,""
END SUB

'
'
'=================================================================================================
SUB PutRecProType(SelectObjName,ParentValue)
	PutHtmlSelectObject SelectObjName,"--全部--","已阅办,未阅办","E,D",ParentValue,"OnChange=""JavaScript:{form1.h_submit.value='S';form1.submit();}"""
END SUB
'=======================================================================================================
'私有
'=======================================================================================================
function GetParentData(DataEnglish)
	select case DataEnglish
	case "DataKeep"
		GetParentData = "个人资料保管箱"
	case "Notepad"
		GetParentData = "个人记事簿"
	case "AddressList"
		GetParentData = "个人通讯录"
	case "Calendar"
		GetParentData = "日程安排"
	end select
end function


'=======================================================================================================
function GetCurrentTime(TimeStr,TimeType,dpType,tpType)
	dim tmpTimeStr,rtnTimeStr
	if TimeStr <> "" then
		tmpTimeStr = TimeStr
	else
		tmpTimeStr = now()
	end if

	select case UCase(TimeType)
	case "DATE"
		if dpType = "C" or dpType = "" then
			rtnTimeStr = year(tmpTimeStr) & "年" & month(tmpTimeStr) & "月" & day(tmpTimeStr) & "日"
		else
			rtnTimeStr = year(tmpTimeStr) & dpType & month(tmpTimeStr) & dpType & day(tmpTimeStr) & dpType
		end if
	case "TIME"
		select case tpType
		case "C"
			rtnTimeStr = hour(tmpTimeStr) & "时" & minute(tmpTimeStr) & "分" & second(tmpTimeStr) & "秒"
		case ""
			rtnTimeStr = hour(tmpTimeStr) & ":" & minute(tmpTimeStr) & ":" & second(tmpTimeStr)
		case else
			rtnTimeStr = hour(tmpTimeStr) & tpType & minute(tmpTimeStr) & tpType & second(tmpTimeStr)
		end select
	case "DATETIME"
		if dpType = "C" or dpType = "" then
			rtnTimeStr = year(tmpTimeStr) & "年" & month(tmpTimeStr) & "月" & day(tmpTimeStr) & "日"
		else
			rtnTimeStr = year(tmpTimeStr) & dpType & month(tmpTimeStr) & dpType & day(tmpTimeStr) & dpType
		end if

		rtnTimeStr = rtnTimeStr & "&nbsp;"

		select case tpType
		case "C"
			rtnTimeStr = rtnTimeStr & hour(tmpTimeStr) & "时" & minute(tmpTimeStr) & "分" & second(tmpTimeStr) & "秒"
		case ""
			rtnTimeStr = rtnTimeStr & hour(tmpTimeStr) & ":" & minute(tmpTimeStr) & ":" & second(tmpTimeStr)
		case else
			rtnTimeStr = rtnTimeStr & hour(tmpTimeStr) & tpType & minute(tmpTimeStr) & tpType & second(tmpTimeStr)
		end select
	case else
		if dpType = "C" or dpType = "" then
			rtnTimeStr = year(tmpTimeStr) & "年" & month(tmpTimeStr) & "月" & day(tmpTimeStr) & "日"
		else
			rtnTimeStr = year(tmpTimeStr) & dpType & month(tmpTimeStr) & dpType & day(tmpTimeStr) & dpType
		end if

		rtnTimeStr = rtnTimeStr & "&nbsp;"
		
		select case tpType
		case "C"
			rtnTimeStr = rtnTimeStr & hour(tmpTimeStr) & "时" & minute(tmpTimeStr) & "分" & second(tmpTimeStr) & "秒"
		case ""
			rtnTimeStr = rtnTimeStr & hour(tmpTimeStr) & ":" & minute(tmpTimeStr) & ":" & second(tmpTimeStr)
		case else
			rtnTimeStr = rtnTimeStr & hour(tmpTimeStr) & tpType & minute(tmpTimeStr) & tpType & second(tmpTimeStr)
		end select
	end select

	GetCurrentTime = rtnTimeStr
end function

'=======================================================================================================
'
'=======================================================================================================
FUNCTION blnFolderExists(Pfs)

	dim FolderPhyPath

	FolderPhyPath = Server.MapPath("../PersonDataFiles")
	if Pfs.FolderExists(FolderPhyPath) then
		blnFolderExists = true
	else
		Pfs.CreateFolder(FolderPhyPath)
		blnFolderExists = false
	end if
END FUNCTION

'=======================================================================================================

'=======================================================================================================
FUNCTION GetUploadFileName(Pfs,PUploadFileName)

	dim FilePhyPath,FolderPhyPath,blnChineseFlag,FilePhyName
	dim i,strCurrentTime,strFileExe,FileSQLName,strChAsc,tmpCharAsc
	flagFileExists = false
	strChAsc = ""

	'判断当前用户文件夹是否已经存在，如不存在则创建
	FolderPhyPath = Server.MapPath("../PersonDataFiles/" & session("briefname"))
	if not Pfs.FolderExists(FolderPhyPath) then
		Pfs.CreateFolder(FolderPhyPath)
	end if

	if PUPloadFileName <> "" then

		'判断文件名是否存在
		blnFileExists = false
		FilePhyName = PUploadFileName
		FileSQLName = "/" & session("briefname") & "/" & PUploadFileName
		if Pfs.FileExists(FolderPhyPath & "/" & FilePhyName) then
			blnFileExists = true
		end if
	
		'文件名是否有汉字的标志变量
		blnChineseFlag = FALSE
		for i=1 to len(PUploadFileName)
			tmpCharAsc = asc(mid(PUploadFileName,i,1))
			if tmpCharAsc>127 or tmpCharAsc<0 then
				blnChineseFlag = TRUE
			end if
			strChAsc = strChAsc & cstr(tmpCharAsc)
		next

		'如果文件名已经存在或文件名中有汉字存在
		if blnFileExists or blnChineseFlag then
			strFileExe=right(PUploadFileName,len(PUploadFileName)-inStr(PUploadFileName,".")+1)
		
			'更名为由当前时间加当前教师ID构成的文件名
			strCurrentTime="Per" & year(now()) & month(now()) & day(now()) & hour(now()) & minute(now()) & second(now) & Session("briefname") & strChAsc
			FilePhyName = strCurrentTime & strFileExe
			FileSQLName = "/" & session("briefname") & "/" & strCurrentTime & strFileExe
		end if

		GetUploadFileName = FilePhyName & "," & FileSQLName
	else
		GetUploadFileName = ""
	end if

END FUNCTION

sub UploadFile(objUP,strUploadFileName,strUpdateHomeDirectory,strIndividualUploadDirectory )

	strPhysicalHomeDirectory = server.mappath(strUpdateHomeDirectory)
	dim fso,existFolderflag,Folder,flagFileExists,f
	set fso=Server.CreateObject("Scripting.FileSystemObject")
		if not fso.FolderExists(strPhysicalHomeDirectory) then
			Response.write "<p align=center><font color=red>上传文件的主目录必须存在！请先建好主目录" & strUpdateHomeDirectory & "</font></p>"
			response.end
		end if
		' to check that whether the individual dirctory exists or else create it
		existFolderflag = false
		if strIndividualUploadDirectory <> "" then
			Folder = strPhysicalHomeDirectory & "\" &  strIndividualUploadDirectory
		else
			Folder = strPhysicalHomeDirectory
		end if
		if not fso.FolderExists(Folder) then
			set f= fso.CreateFolder(Folder)
		end if

		'end checking the directory
		objUP.Maxsize=20000000		'设定最大上传值（单位：Bit）
		objUP.Path=Folder		'设定上传的目录
		objUP.Upload
		if ObjUP.FileName("fjmc1")  <> "" then
			fjmc = ObjUP.FileName("fjmc1")
			if fso.FileExists (Folder & "\" & fjmc) then
				response.write "<script language='JavaScript'>" & chr(13)
				response.write " alert('附件1的文件名称已经存在，原文件将以.bak的形式备份\n如需要恢复请与系统管理员联系！');  "
				response.write "</script>" & chr(13)
				fso.CopyFile Folder & "\" & fjmc,Folder & "\" & fjmc &".bak",1
			end if
		end if
		if ObjUP.FileName("fjmc2")  <> "" then
			fjmc = ObjUP.FileName("fjmc2")
			if fso.FileExists (Folder & "\" & fjmc) then
				response.write "<script language='JavaScript'>" & chr(13)
				response.write " alert('附件2的文件名称已经存在，原文件将以.bak的形式备份\n如需要恢复请与系统管理员联系！');  "
				response.write "</script>" & chr(13)
				fso.CopyFile Folder & "\" & fjmc,Folder & "\" & fjmc &".bak",1
			end if
		end if
		if ObjUP.FileName("fjmc3")  <> "" then
			fjmc = ObjUP.FileName("fjmc3")
			if fso.FileExists (Folder & "\" & fjmc) then
				response.write "<script language='JavaScript'>" & chr(13)
				response.write " alert('附件3的文件名称已经存在，原文件将以.bak的形式备份\n如需要恢复请与系统管理员联系！');  "
				response.write "</script>" & chr(13)
				fso.CopyFile Folder & "\" & fjmc,Folder & "\" & fjmc &".bak",1
			end if
		end if
		objUP.SaveAll
	    set fso = nothing
end sub

function SplitAttachment(strFjmc)
	if strFjmc <> "" then
		dim arryAttach
		arryAttach = split(strFjmc,";",-1,1)
		for i = 0 to ubound(arryAttach)
			strNewFjmc = strNewFjmc & "<a href='../uploadfiles/"& arryAttach(i) &"' target='_new'>"& right(arryAttach(i),len(arryAttach(i))-instr(arryAttach(i),"/")) &"</a>&nbsp;&nbsp;"
		next
	end if
	SplitAttachment = strNewFjmc
end function


sub putLayer()
Response.write("<div id =""mylayer"" style=""position:absolute; top:250; left:100; z-index:50; visibility:hidden"" >")
Response.write("<TABLE WIDTH=50% height=100 BORDER=0 CELLSPACING=2 CELLPADDING=0>")
Response.write("<TR><TD bgcolor=#3333FF >")
Response.write("<TABLE WIDTH=100% height=100 BORDER=0 CELLSPACING=2 CELLPADDING=0 align=center><TR>")
Response.write("<td  bgcolor=#eeeeee align=center>正在上传文件，请稍候...</td>")
Response.write("</tr></table>")
Response.write("</td></tr>")
Response.write("</table>")
Response.write("</div>")
end sub

sub CreateUserDefaultCss()
	targetPath = server.mappath("css")

	newfile = targetPath & "\" & Session("Briefname") & ".css"
	'response.write newfile 
	set fso=Server.CreateObject("Scripting.FileSystemObject")
		if not fso.FileExists(newfile) then
			fso.CopyFile targetPath & "\admin.css" ,newfile,1
		end if
	set fso= nothing
end sub
%>

<%
'-------------------前台调用-----
'intRightType-----权限类型----
'strModule--------模快名称----
<%
chkright "strModule",intRightType
%>

%>
checkright.asp - 源码说明

本页面展示了「投资管理系统, asp+ mssql server」中的 checkright.asp 源码文件，采用 ASP 编程语言编写，共 1,233 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。
虫虫开发者社区收录了大量与投资管理相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。
⌨️ 快捷键说明

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