📄 db_bak.inc
字号:
'-------------------------------
function getValFromLOV(sVal, aArr)
Dim i
Dim sRes : sRes = ""
if (ubound(aArr) mod 2) = 1 then
for i = 0 to ubound(aArr) step 2
if cstr(sVal) = cstr(aArr(i)) then sRes = aArr(i+1)
next
end if
getValFromLOV = sRes
end function
'-------------------------------
' Process Errors
'-------------------------------
function ProcessError()
if cn.Errors.Count > 0 then
ProcessError = cn.Errors(0).Description & " (" & cn.Errors(0).Source & ")"
elseif not (Err.Description = "") then
ProcessError = Err.Description
else
ProcessError = ""
end if
end Function
'-------------------------------
' Verify user's security level and redirect to login page if needed
'-------------------------------
function CheckSecurity(iLevel)
if Session("UserID") = "" then
cn.Close
Set cn = Nothing
response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME")))
else
if CLng(Session("UserRights")) < CLng(iLevel) then
cn.Close
Set cn = Nothing
response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME")))
end if
End if
end function
'===============================
'===============================
' GlobalFuncs begin
Function todayCn()
Dim strDate : strDate = year(date) & "年" & month(date) & "月" & day(date) & "日" & " 星期"
Select Case Weekday(date, vbMonday)
Case 1
strDate = strDate & "一"
Case 2
strDate = strDate & "二"
Case 3
strDate = strDate & "三"
Case 4
strDate = strDate & "四"
Case 5
strDate = strDate & "五"
Case 6
strDate = strDate & "六"
Case 7
strDate = strDate & "日"
End Select
todayCn = strDate
End Function
function TotalRecords(sSQL)
'response.write "<br>1:" & ssql
Dim rs
Dim iTmpI : iTmpI = 0
Dim iTmpJ : iTmpJ = 0
Dim sCountSQL : sCountSQL = ""
Dim nCount : nCount = 0
iTmpI = instr(lcase(sSQL), "select")
iTmpJ = instr(lcase(sSQL), " from ")
if iTmpI >= 1 and iTmpJ >= 1 then
sCountSQL = replace(sSQL, left(sSQL, iTmpJ+5), "select count(*) from ")
iTmpI = instr(lcase(sCountSQL), "order by")
if iTmpI > 1 then sCountSQL = left(sCountSQL, iTmpI - 1)
openrs rs, sCountSQL
nCount = CLng(rs.fields(0).value) ' 页数(有可能是小数)
rs.close
Set rs = nothing
end if
TotalRecords = nCount
end function
' =========================================================================================
' 函数名称：checkmenu(item_id)
' 函数功能：检查当前用户对某一个项目的操作权限，以便确定用户对与该项目对应的菜单的可见性。
' 输入参数：role_id,即当前用户在T_account中对应的role_id,
' item_id，即操作项目在T_item表中对应的item_id。
' 返回值：true/false，表示有/无对该项目的操作权限
' =========================================================================================
function checkmenu(roleid, itemid)
Dim rs
Dim item_id
Dim role_id
Dim quanxian
Dim SQLStr
role_id = roleid
item_id = itemid
SQLStr = "select * from T_Rights where role_id ="&role_id&" and item_id ='"&item_id&"'"
' response.write "aa" & SQLStr
' response.end
Set rs = cn.execute(SQLStr)
if rs.eof then
response.write "数据库T_item无"&item_id&"项目！请检查u_menu.asp!"
' response.end
else
if rs("operation_right") = 1 then
quanxian = true
else
quanxian = false
end if
end if
checkmenu = quanxian
end function
' ==================================================================
' 函数checkmenu(roleid,itemid)结束
' ==================================================================
' ==================================================================
' 函数名称：Isattendee(attendee,userid)
' 函数功能：判断",name,"是否包含在",strData,"中
' 输入参数：strData,name都是字符串
' 返回值： true/false,表示是/否包含。
' ==================================================================
function Isattendee(strData,name)
Dim strAttendee
Dim strUserid
if Isnull(strData) or Isnull(name) then
response.write "attendee或者userid为null!"
response.end
else
strAttendee = replace(strData," ","")
strAttendee = ","+strAttendee+","
strUserid = ","+name+","
if Instr(strAttendee,strUserid) > 0 then
Isattendee = true
else
Isattendee = false
end if
end if
end function
' =====================================================================
' 函数 Isattendee(attendee,userid)结束
' =====================================================================
' ==================================================================
' 函数名称：GetInvisibleChar(strData)
' 函数功能：显示原字符串，包括其中的不可见字符：空格和回车
' 输入参数：字符串：strData
' 返回值： 字符串：GetInvisibleChar
' ==================================================================
function GetInvisibleChar(strData)
Dim strGetSpace
Dim strGetAll
if Isnull(strData) then
response.write "strData为null!"
response.end
else
strGetSpace = unescape(Replace(escape(strData),"%20"," "))
strGetAll = unescape(Replace(escape(strGetSpace),"%0D%0A","<br>"))
end if
GetInvisibleChar = strGetAll
end function
' =====================================================================
' 函数 GetInvisibleChar(strData)结束
' =====================================================================
sub WritePageInfor(bEof, sFileName, sFormParams, sSortParams, iCurrentPage, iTotalPages)
Dim iPrevPage, iNextPage
iPrevPage = iCurrentPage - 1
if iPrevPage <= 0 then iPrevPage = 1
' 后一页
iNextPage = iCurrentPage + 1
if iNextPage > iTotalPages then iNextPage = iTotalPages
' display grid based on recordset
if bEof and iCurrentPage = 1 then ' 第一页，并且是最后一页，无前页/首页，无后页/尾页
Response.write "首页 前页"
Response.write " "
Response.write iCurrentPage & "/" & iTotalPages
Response.write " "
Response.write "后页 尾页"
elseif Not bEof and iCurrentPage = 1 then ' 第一页，但不是最后一页，无前页/首页，有后页/尾页
Response.write "首页 前页"
Response.write " "
Response.write iCurrentPage & "/" & iTotalPages
Response.write " "
Response.write "<a href='" & sFileName & "?" & sFormParams & sSortParams & "Page=" & iNextPage & "'>后页</a>"
Response.write " "
Response.write "<a href='" & sFileName & "?" & sFormParams & sSortParams & "Page=" & iTotalPages & "'>尾页</a>"
elseif bEof and iCurrentPage > 1 then ' 不是第一页，是最后一页，有前页/首页，无后页/尾页
Response.write "<a href='" & sFileName & "?" & sFormParams & sSortParams & "Page=1'>首页</a>"
Response.write " "
Response.write "<a href='" & sFileName & "?" & sFormParams & sSortParams & "Page=" & iPrevPage & "'>前页</a>"
Response.write " "
Response.write iCurrentPage & "/" & iTotalPages
Response.write " "
Response.write "后页 尾页"
else ' 不是第一页，也不是最后一页，有前页/首页，有后页/尾页
Response.write "<a href='" & sFileName & "?" & sFormParams & sSortParams & "Page=1'>首页</a>"
Response.write " "
Response.write "<a href='" & sFileName & "?" & sFormParams & sSortParams & "Page=" & iPrevPage & "'>前页</a>"
Response.write " "
Response.write iCurrentPage & "/" & iTotalPages
Response.write " "
Response.write "<a href='" & sFileName & "?" & sFormParams & sSortParams & "Page=" & iNextPage & "'>后页</a>"
Response.write " "
Response.write "<a href='" & sFileName & "?" & sFormParams & sSortParams & "Page=" & iTotalPages & "'>尾页</a>"
end if
end sub
sub CheckSecurity(PageName)
Dim sFileName ' 当前要检查的web文件名
Dim rs ' 存放RecordSet
Dim iHasPage : iHasPage = 0 ' T_WebFiles中是否有该页面文件
Dim bRights ' 用户访问该页面的权限
Dim sSQL ' SQL statement
'先检查是否登录
if Trim(Session("UserID")) = "" then Session("UserID") = empty
if IsEmpty(Session("UserID")) then
cn.close
Response.write "<script language='JavaScript'>alert('对不起，您没有登录！');</script>"
Response.redirect(gURLHome)
end if
' 获取文件名
' Request.ServerVariables("PATH_INFO") ' 取得目前网页的虚拟路径
' Request.ServerVariables("PATH_TRANSLATED") ' 目前所运行的ASP程序，位于服务器端的真实路径（不是虚拟路径）
' Request.ServerVariables("URL") ' 取得目前网页的存储位置（虚拟路径）
sFileName = Request.ServerVariables("SCRIPT_NAME") ' 被运行ASP文件的完整虚拟路径
sFileName = Right(sFileName, len(sFileName)-4)
' 检查是否T_WebFiles中是否有该文件
iHasPage = cn.execute("select count(*) from T_WebFiles where file_name=" & ToSQL(sFileName,"Text")).Fields(0).Value
if iHasPage = 0 then
Response.write "<script language='JavaScript'>alert('对不起，您访问的文件 ( " & sFileName & " ) 不存在或您没有权限访问！');</script>"
Response.write "<script language='JavaScript'>history.go(-1);</script>"
exit sub
end if
' 如果存在该页，则检查该用户对该页是否有访问权
sSQL = "select Operation_Right from T_Rights where Role_id=" & ToSQL(Session("RoleID"),"Number") & " and Item_id in (select Item_id from T_WebFiles where file_name = " & ToSQL(sFileName,"Text") & ") and Operation_Right = 1"
openrs rs, sSQL
if rs.EOF then ' 无访问权
response.write "<script language='JavaScript'>alert('对不起，您没有足够的权限！')</script>" & vbLF
' response.write "<script language='JavaScript'>history.go(-1);</script>" & vbLF
end if
End Sub
' GlobalFuncs end
'===============================
%>
<%
Sub CheckSpecialPost()
Session("officer") = empty
Session("owner") = empty
Session("manager") = empty
Session("operator") = empty
'===============================
' 获取特殊用户信息 Begin
'===============================
Dim post_id, sError
sSQL = "select post_id, account_id from T_SpecialPost where account_id in (select account_id from T_Account where status = 0) order by account_id"
openrs rs, sSQL
while Not rs.EOF
post_id = GetValue(rs, "post_id")
Select Case post_id
Case 1
Session("officer") = GetValue(rs, "account_id")
Case 2
Session("owner") = GetValue(rs, "account_id")
Case 3
Session("manager") = GetValue(rs, "account_id")
Case 4
Session("operator") = GetValue(rs, "account_id")
End Select
rs.movenext
wEnd
rs.close
sError = ""
if Session("officer") = "" then sError = "办公室主任"
if Session("owner") = "" then
if sError <> "" then sError = sError & ", "
sError = sError & "与物业联系的业主人员"
end if
if Session("manager") = "" then
if sError <> "" then sError = sError & ", "
sError = sError & "物业负责人"
end if
if Session("operator") = "" then
if sError <> "" then sError = sError & "和"
sError = sError & "物业操作员"
end if
if sError <> "" then
cn.close
Session("officer") = empty
Session("owner") = empty
Session("manager") = empty
Session("operator") = empty
Response.Clear
Response.Write "<h2>error: 系统尚未指定" & sError & "，请与系统管理员联系！</h2>"
Response.end
end if
End Sub
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -