db_bak.inc

物业管理和办公自动化系统

<%
'************************************************************************************************
' 文件名: list.inc
' Copyright(c) 2001-2002 上海阿尔卡特网络支援系统有限公司

' 创建人: 周秋舫
' 日　期:   2002-05-08
' 修改历史:
'   ****年**月**日 ****** 修改内容:**************************************************
' 描　述:
' 版　本:
'************************************************************************************************
%>

<!-- #INCLUDE FILE="../config/adovbs.inc" -->
<!-- #INCLUDE FILE="../config/TemplateObj.asp" -->

<%
'************************************************************************************************
' 数据库信息有多个，如OA系统的SQL Server数据库，中控室数据库／停车场收费管理系统数据库等若干个数据库，
' 在连接数据库时，需要指明连接到哪个数据库
Const dbLocal		= 0		' OA系统本身提供的SQL Server数据库
Const dbControl	= 1		' 中央控制室数据库
Const dbParking	= 2		' 停车场收费管理系统数据库
'************************************************************************************************

Class DBConn
	Private DBConn
	
	'************************************************************************************************
	' 函数名　: Class_Initialize
	' 输　入　: (无)
	' 输　出　: (无)
	' 功能描述: 初始化数据库连接对象
	' 调用模块: 
	' 作　者　: 周秋舫
	' 日　期　: 2002-05-09
	' 版　本　: 
	'************************************************************************************************
	Private Sub Class_Initialize
		Set DBConn = Server.CreateObject("ADODB.Connection")
	End Sub

	'************************************************************************************************
	' 函数名　: Connect
	' 输　入　: db
	' 　　　　  db ---- 指明连接到哪个数据库
	' 输　出　: Connect，函数名作为返回值，类型为ADODB.Connection的数据库连接对象
	' 功能描述: 获取数据库链接
	' 调用模块: 
	' 作　者　: 周秋舫
	' 日　期　: 2002-05-09
	' 版　本　: 
	'************************************************************************************************
	Public Function Connect(db)
		Select Case db
			Case dbLocal
				DBConn.open "LocalServer", "infor", "tower"		
			Case dbControl
				'TODO: 连接到中控室数据库
			Case dbParking
				'TODO: 连接到停车场收费管理系统数据库
			Case Else
				DBConn.open "LocalServer", "infor", "tower"
		End Select
		Set Connect = DBConn
	End Function

	' 断开数据库连接
	Public Sub Disconnet()
		DBConn.Close()
		Set DBConn = nothing
	End Sub

	' 
	Public Sub Openrs()
		
	End Sub
	
	Public Function PrintMe()
		PrintMe = "abcde"
	End Function
End Class
		

'************************************************************************************************
' 函数名　: DBConn
' 输　入　: db
' 　　　　  db ---- 指明连接到哪个数据库
' 输　出　: DBConn，函数名作为返回值，类型为ADODB.Connection的数据库连接对象
' 功能描述: 获取数据库链接
' 调用模块: 
' 作　者　: 周秋舫
' 日　期　: 2002-05-08
' 版　本　: 
'************************************************************************************************
function DBConn1(db)
	Dim conn 
	Set conn = Server.CreateObject("ADODB.Connection")
	Select Case db		' 打开数据库连接
		Case dbLocal
			cn.open "LocalServer", "infor", "tower"		
		Case dbControl
			'TODO: 连接到中控室数据库
		Case dbParking
			'TODO: 连接到停车场收费管理系统数据库
		Case Else
			cn.open "LocalServer", "infor", "tower"
	End Select
	Set DBConn1 = conn
end function  


'************************************************************************************************
' 函数名　: DBDisconnect
' 输　入　: (无)
' 输　出　: (无)
' 功能描述: 关闭数据库链接
' 调用模块: 
' 作　者　: 周秋舫
' 日　期　: 2002-05-09
' 版　本　: 
'************************************************************************************************
Sub DBDisconnect()
	DBConn.close
	Set DBConn = nothing
End Sub

'************************************************************************************************
' 函数名　: Openrs
' 输　入　: rs, sSQL
' 　　　　  rs   ----
' 　　　　  sSQL ---- SQL 语句
' 输　出　: (无)
' 功能描述: 创建forward only recordset
' 调用模块: 
' 作　者　: 周秋舫
' 日　期　: 2002-05-09
' 版　本　: 
'************************************************************************************************
sub openrs(cn, rs, sql)
  Set rs = Server.CreateObject("ADODB.Recordset")
  rs.CursorLocation = adUseServer
  rs.Open sql, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
end sub

'************************************************************************************************
' 函数名　: Openrs
' 输　入　: rs, sSQL
' 　　　　  rs   ----
' 　　　　  sSQL ---- SQL 语句
' 输　出　: (无)
' 功能描述: 创建static only recordset
' 调用模块: 
' 作　者　: 周秋舫
' 日　期　: 2002-05-09
' 版　本　: 
'************************************************************************************************
sub openStaticRS(cn, rs, sql)
  Set rs = Server.CreateObject("ADODB.Recordset")
  rs.CursorLocation = adUseServer
  rs.Open sql, cn, adOpenStatic, adLockReadOnly, adCmdText
end sub
'===============================

'===============================
' Site Initialization
'-------------------------------
' Specify Debug mode (true/false)
Dim bDebug : bDebug = false
if bDebug then 
	Session("UserID") = "s10072"
	Session("EmpSerial") = 8
	Session("UserName") = "周秋舫"
	Session("RoleID") = 1
	Session("co_id") = 1
	Session("co_name") = "上海信息世界分公司信息大楼"
end if

'-------------------------------
' Obtain the path where this site is located on the server
'-------------------------------
Dim sAppPath : sAppPath = left(Request("PATH_TRANSLATED"), instrrev(Request("PATH_TRANSLATED"), "\"))
'===============================

'===============================
' Common functions
'-------------------------------
' Convert non-standard characters to HTML
'-------------------------------
function ToHTML(strValue)
  if IsNull(strValue) then 
    ToHTML = ""
  else
    ToHTML = Server.HTMLEncode(strValue)
  end if
end function

'-------------------------------
' Convert value to URL
'-------------------------------
function ToURL(strValue)
  if IsNull(strValue) then strValue = ""
  ToURL = Server.URLEncode(strValue)
end function

'-------------------------------
' Obtain HTML value of a field
'-------------------------------
function GetValueHTML(rs, strFieldName)
  GetValueHTML = ToHTML(GetValue(rs, strFieldName))
end function

'-------------------------------
' Obtain database field value
'-------------------------------
function GetValue(rs, strFieldName)
	Dim res
	on error resume next
	if rs is nothing then
		GetValue = ""
	elseif (not rs.EOF) and (strFieldName <> "") then
		res = rs(strFieldName)
		if isnull(res) then 
			res = ""
		end if
		if VarType(res) = vbBoolean then
			if res then res = "1" else res = "0"
		end if
		GetValue = res
	else
		GetValue = ""
	end if
	if bDebug then response.write err.Description
	on error goto 0
end function

'-------------------------------
' Obtain specific URL Parameter from URL string
'-------------------------------
function GetParam(ParamName)
  Dim Param
  
  if Request.QueryString(ParamName).Count > 0 then 
    Param = Request.QueryString(ParamName)
  elseif Request.Form(ParamName).Count > 0 then
    Param = Request.Form(ParamName)
  else 
    Param = ""
  end if
  if Param = "" then
    GetParam = Empty
  else
    GetParam = Param
  end if
end function

'-------------------------------
' Convert value for use with SQL statament
'-------------------------------
Function ToSQL(Value, sType)
  Dim Param : Param = Value
  if Param = "" then
    ToSQL = "Null"
  else
    if sType = "Number" then
      ToSQL = replace(CDbl(Param), ",", ".")
    else
      ToSQL = "'" & Replace(Param, "'", "''") & "'"
    end if
  end if
end function

'-------------------------------
' Lookup field in the database based on provided criteria
' Input: Table (Table), Field Name (fName), criteria (sWhere)
'-------------------------------
function DLookUp(Table, fName, sWhere)
  on error resume next
  Dim Res : Res = cn.execute("select " & fName & " from " & Table & " where " & sWhere).Fields(0).Value
  if IsNull(Res) then Res = ""
  DLookUp = Res
  if bDebug then response.write err.Description
  on error goto 0
end function

'-------------------------------
' Obtain Checkbox value depending on field type
'-------------------------------
function getCheckBoxValue(sVal, CheckedValue, UnCheckedValue, sType)
  if isempty(sVal) then
    if UnCheckedValue = "" then
      getCheckBoxValue = "Null"
    else
      if sType = "Number" then
        getCheckBoxValue = UnCheckedValue
      else
        getCheckBoxValue = "'" & Replace(UnCheckedValue, "'", "''") & "'"
      end if
    end if
  else
    if CheckedValue = "" then
      getCheckBoxValue = "Null"
    else
      if sType = "Number" then
        getCheckBoxValue = CheckedValue
      else
        getCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") & "'"
      end if
    end if
  end if
end function

'-------------------------------
' Obtain lookup value from array containing List Of Values