publicfunction.asp

功能齐全的oa系统

<%
'*************************************************************
'名称：PublicFunction
'
'中文含义：公共函数
'
'描述：
'  该文件包含所有的公共函数
'*************************************************************
'
'函数定义列表：
'
'函数定义                                                   描述
'---------------------------------------------------------------------------------------
'Function ReGoTo(List,Page)								 重新定位记录集
'
'Sub Show_Bottom(FormFlag)							     显示并确定分页栏状态
'
'Function AutoGetNo(MapName)							 自动获取唯一序列号
'
'Function ShowDictValue(m_DictName,m_ActiveName)		 原始状态显示词典的下拉菜单
'
'Function SelectDictValue(m_DictName,m_ValueName,m_ActiveName)		 显示词典的下拉菜单,并定位到具体值
'
'Function InputOrderByType(TableName,OrderName,TypeName,TypeValue)	根据不同类别，添加次序值
'
'Function ResetOrder(TableName,OrderName,TypeName,TypeValue)    调整不连续的排序值（次序值进行重新赋值）
'
'Function GetValueFromTable(TableName,BaseFieldName,BaseFieldValue,GetFieldName)
'														 从某一表中，根据一字段值得到其他一个字段的内容(一对一的关系）
'
'Function AddRecord(TableName,FieldList,ValueList,IDFieldName)		添加一个新的纪录
'
'Function ModifyRecord(TableName,FieldList,ValueList,IDFieldName,IDFieldValue)	修改某一纪录
'
'Function DeleteRecord(TableName,IDFieldName,IDValues,FalseInfo)    删除指定的纪录,并进行出错提示
'
'Function GetRecordDetail(TableName,IDFieldName,IDValue)			取得某一指定纪录的详细资料
'
'Function GetRecordList(TableName,SearchCondition,OrderField,OrderMode,ShowN)   取得符合条件的纪录列表
'
'Function SendEmail(Sender,Receiver,CC,BCC,Subject,Body,Importance,m_AttachFileNameList,m_AttachOldNameList)发送Email
'
'Function SendMsg(m_FromID,m_ToID,m_CCIDs,m_Name,m_Description) 向内部信箱发送简单形式的邮件
'
'Function DiffHour(theDate)									返回一个日期时间变量和现在相比相差的小时数
'
'Function DiffDay(theDate)									返回一个日期时间变量和现在相比相差的天数								
'
'Function DelUpFileFromDri(FileFullName)				    物理删除磁盘上的某个文件	
'
'function MoveFileInSend(m_SourcePath,m_DestinationPath,m_FileName) 物理移动文件
'
'function GetFileSize(m_FileName)                           得到文件的大小
'
'Function GetUserDept(intUserID)							得到通过UserID得到其所属部门的记录集
'
'Function ShowFileSize(intSize)								显示文件大小(按照B,KB,MB)
'
'---------------------------------------------------------------------------------------


'*************************************************************
'公共声明区
'*************************************************************

'为记录集的翻页声明的常量、变量
Const PAGESIZE=15 '每页的记录数
Dim m_intPageSum '总页数
Dim m_intCurrentPage '当前页码
Dim m_intRecordCount '记录总数

m_intPageSum = 1
m_intCurrentPage = 1
m_intRecordCount = 0




'*************************************************************
'公共函数区
'*************************************************************

'*************************************************************
'功能：重新定位记录集
'参数：
'  List；Recordset；需重新定位的记录集
'  Page；Integer；页码
'返回值：Recordset；重新定位后的记录集
'*************************************************************
Function ReGoTo(List,Page)
	m_intCurrentPage = 1
	
	List.PageSize = PAGESIZE
	m_intPageSum = List.PageCount
	m_intRecordCount=List.RecordCount
	
	If not List.EOF Then
		'确定当前页码
		If Page <> "" Then
			If isnumeric(Page) Then
				If cint(Page)>=1 and cint(Page)<=m_intPageSum Then
			       m_intCurrentPage=Page
			    End If
			End If
		End If		
		List.AbsolutePage = m_intCurrentPage '重新定位记录集
	End If
	Set ReGoTo=List
End Function


'*************************************************************
'功能：显示并确定分页栏状态
'参数：
'  FormFlag；Integer；用于判断调用该函数的页面是否具有Form元素
'                     0：代表没有；1：代表有
'返回值：无
'*************************************************************
Sub Show_Bottom(FormFlag)
  scriptname=Request.ServerVariables("script_name")

  Response.Write "<TABLE align=center  border=0 cellPadding=0 cellSpacing=0 width=100% height=19>"    
  
  if FormFlag=0 then '调用该函数的页面没有Form元素
	Response.Write "<FORM action='"& scriptname & "' method=post name=MyForm><TBODY><TR>"
  elseif FormFlag=1 then '调用该函数的页面已有Form元素
	Response.Write "<TBODY><TR>"        
  end if
  
  Response.Write "<TD noWrap vAlign=center><img src='../Images/icon_multipage.gif' align='absmiddle'>&nbsp分页&nbsp;"

  Response.Write "<script language=javascript>"+chr(10)
  Response.Write "function triggerGoTo(PageNO){"+chr(10)
  Response.Write "MyForm.txtPageNO.value=PageNO"+chr(10)
  Response.Write "MyForm.submit()"+chr(10)
  Response.Write "}"+chr(10)
  Response.Write "function onSubmit(){"+chr(10)
  Response.Write "MyForm.submit();"+chr(10)
  Response.Write "}"+chr(10)
  Response.Write "</script>"+chr(10)
  
  if m_intPageSum=1 or m_intPageSum=0 then
    Response.Write "首页 前页 后页 尾页&nbsp;"
  elseif m_intCurrentPage=1 then
    Response.Write "首页 前页&nbsp;"
    Response.write "<A href='javascript:triggerGoTo(" & m_intCurrentPage+1 & ")'>后页</A>&nbsp;"
    Response.write "<A href='javascript:triggerGoTo(" & m_intPageSum & ")'>尾页</A>&nbsp;"
  elseif int(m_intCurrentPage)=int(m_intPageSum) then
    Response.Write "<A href='javascript:triggerGoTo(1)'>首页</A>&nbsp;"
    Response.Write "<A href='javascript:triggerGoTo(" & m_intCurrentPage-1 & ")'>前页</A>&nbsp;"
    Response.Write "后页 尾页&nbsp;"
  else
    Response.Write "<A href='javascript:triggerGoTo(1)'>首页</A>&nbsp;"
    Response.Write "<A href='javascript:triggerGoTo(" & m_intCurrentPage-1 & ")'>前页</A>&nbsp;"
    Response.write "<A href='javascript:triggerGoTo(" & m_intCurrentPage+1 & ")'>后页</A>&nbsp;"
    Response.write "<A href='javascript:triggerGoTo(" & m_intPageSum & ")'>尾页</A>&nbsp;"
  end if
      
  Response.write "页次：" & m_intCurrentPage & "/" & m_intPageSum & " 页&nbsp;"     
  Response.write "<font color=#ff3300>" & PAGESIZE & "</font> 条/页 共 <font color=#ff3300>" & m_intRecordCount & "</font> 条纪录</FONT></SPAN></TD>"    
  Response.Write "<TD noWrap vAlign=center><DIV align=right>"    
  Response.write "<P>转到:"
  Response.write "<INPUT class=Input maxLength=10 name=txtPageNO size=4 value=" & m_intCurrentPage & ">"
  Response.Write "<INPUT class=button id=button1 type=button value='OK'style='height:21px' onClick='onSubmit()' onMouseOver='onButton(this);' onMouseOut='offButton(this);'>&nbsp;"
  
  if FormFlag=0 then '调用该函数的页面没有Form元素
	Response.Write "</SPAN></P></DIV></TD></TR></FORM></TBODY></TABLE>"
  elseif FormFlag=1 then '调用该函数的页面已有Form元素
	Response.Write "</SPAN></P></DIV></TD></TR></TBODY></TABLE>"
  end if

End Sub

'***********************************************************************
'功能：自动获取唯一序列号
'返回值：Int 
'参数：
'		MapName				需要获得唯一序列号的数据表名
'***********************************************************************
Function AutoGetNo(MapName)
	Dim m_No,Sql
	Dim m_FirTempNo,m_SecTempNo		'm_FirTempNo	 第一个临时数据  
									'm_SecTempNo	 第二个临时数据
	Set m_No=Server.CreateObject("adodb.recordset")
	Sql="SELECT * FROM "&MapName
	m_No.Open  Sql,conn,3,3
	If m_No.EOF Then
		AutoGetNo=1					'若初始没有记录，则序列号定义为1
	Else
		if  m_No.Fields(0).Value<>1 Then
			AutoGetNo=1			   '若序列号为1的不存在，则新的序列号定义为1
		else
			do while not m_No.EOF
				m_FirTempNo=m_No.Fields(0).Value 
				m_No.MoveNext
				  if not m_No.EOF  then 
					m_SecTempNo=m_No.Fields(0).Value 
					if m_SecTempNo - m_FirTempNo>1 then 
						AutoGetNo=m_FirTempNo+1
						exit do
					end if
				  else
						AutoGetNo=m_FirTempNo+1
				  end if
			loop
		end If
	End If
End function

'*********************************************************************
'功能：原始状态显示词典的下拉菜单
'返回值：HTML文本
'参数：m_DictName				所选择的词典名称
'	   m_ActiveName             表中是否显示项的名字
'*********************************************************************
Function ShowDictValue(m_DictName,m_ActiveName)
	
	If m_ActiveName <> ""  Then 
		Set Rs=conn.Execute ("SELECT * FROM "& m_DictName & " Where " & m_ActiveName & " = 1")
	Else
		Set Rs=conn.Execute ("SELECT * FROM "& m_DictName)
	End If
	
	Do While Not Rs.EOF		
		IF Rs.Fields(0).Value<>"" THEN
			Response.write("<OPTION value=" & Rs.Fields(0).value &">" & Rs.Fields(1).value & "</OPTION>" & Chr(10))
		END IF		
	RS.MoveNext
	Loop
	RS.Close
End Function


'*********************************************************************
'功能：显示词典的下拉菜单,并定位到具体值
'返回值：HTML文本
'参数：m_ValueName				已选中的项目名
'	   m_DictName				所选择的词典名称
'	   m_ActiveName             表中是否显示项的名字
'*********************************************************************
Function SelectDictValue(m_DictName,m_ValueName,m_ActiveName)
	
	If m_ActiveName <> ""  Then 
		Set Rs=conn.Execute ("SELECT * FROM "& m_DictName & " Where " & m_ActiveName & " = 1")
	Else
		Set Rs=conn.Execute ("SELECT * FROM "& m_DictName)
	End If
	
	Do While Not Rs.EOF
		IF Rs.Fields(0).Value<>"" THEN
			if clng(m_ValueName) <> clng(Rs.Fields(0).value) then
			Response.write("<OPTION value=" & Rs.Fields(0).value &">" & Rs.Fields(1).value & "</OPTION>" & Chr(10))
			else 
			Response.write("<OPTION value=" & Rs.Fields(0).value &" selected>" & Rs.Fields(1).value & "</OPTION>" & Chr(10))
			end if
		END IF
	RS.MoveNext
	Loop
	RS.Close
End Function



'*********************************************************************
'功能：从某一表中，根据一字段值得到其他一个字段的内容(一对一的关系）
'返回值：HTML文本
'参数：TableName					表的名称
'	   BaseFieldName			所根据的字段名称
'	   BaseFieldValue			所根据的字段值(Integer)
'	   GetFieldName				将要得到值的字段名称
'*********************************************************************
Function GetValueFromTable(TableName,BaseFieldName,BaseFieldValue,GetFieldName)
	
	Dim rstGetValue,Sql

	Set rstGetValue = Server.CreateObject("ADODB.Recordset")
	
	Sql = "Select "&GetFieldName&" From "&TableName&" Where "&BaseFieldName&"="&BaseFieldValue
	
	rstGetValue.Open Sql,conn,3,3

	If rstGetValue.RecordCount > 0 Then
		GetValueFromTable = rstGetValue(GetFieldName) 
	Else
		GetValueFromTable = ""
	End If

End Function

'*********************************************************************
'功能：根据不同类别，添加次序值
'参数：TableName				数据表名称
'	   OrderName			排序字段名称
'	   TypeName				类别表名称
'	   TypeValue			类别值(Integer型)
'	   IsActiveName			是否激活的标识字段名称(没有该字段，为1)
'返回值：Integer
'*********************************************************************
Function InputOrderByType(TableName,OrderName,TypeName,TypeValue,IsActiveName)
	
	Dim rstOrder,Sql
	Dim m_FirTempNum,m_SecTempNum
	
	Set rstOrder = Server.CreateObject("ADODB.Recordset")
	
	Sql = "Select * From "&Tablename&" Where "&TypeName&"="&TypeValue&" And "&IsActiveName&"=1 Order By "&OrderName
	rstOrder.Open Sql,conn,3,3
	
	If rstOrder.RecordCount = 0 Then
		InputOrderByType = 1
	Else
		if  rstOrder(OrderName).Value<>1 Then
			InputOrderByType=1			   '若次序值为1的不存在，则新的次序值定义为1
		else
			do while not rstOrder.EOF
				m_FirTempNum=rstOrder(OrderName).Value 
				rstOrder.MoveNext
				  if not rstOrder.EOF  then 
					m_SecTempNum=rstOrder(OrderName).Value 
					if m_SecTempNum - m_FirTempNum>1 then 
						InputOrderByType=m_FirTempNum+1
						exit do
					end if
				  else
						InputOrderByType=m_FirTempNum+1
				  end if
			loop
		end If
	End If

End Function


'*********************************************************************
'功能：调整不连续的排序值（次序值进行重新赋值）
'参数：TableName				数据表名称
'	   OrderName			排序字段名称
'	   TypeName				类别表名称
'	   TypeValue			类别值(Integer型)
'	   IsActiveName			是否激活的标识字段名称(没有该字段，为1)
'返回值：Integer
'*********************************************************************
Function ResetOrder(TableName,OrderName,TypeName,TypeValue,IsActiveName)
	
	Dim rstReset,Sql
	Dim m_RightOrderNum  '正确的次序值
	
	Set rstReset = Server.CreateObject("ADODB.Recordset")
	
	Sql = "Select * From "&Tablename&" Where "&TypeName&"="&TypeValue&" And "&IsActiveName&"=1 Order By "&OrderName

	rstReset.Open Sql,conn,3,3
	
	If rstReset.RecordCount <> 0 Then
		m_RightOrderNum = 1
		Do While Not rstReset.EOF 
			if  rstReset(OrderName).Value <> m_RightOrderNum Then
				rstReset(OrderName).Value = m_RightOrderNum	
				m_RightOrderNum = m_RightOrderNum +1
			else
				m_RightOrderNum = m_RightOrderNum +1
			end if
		rstReset.MoveNext 
		Loop
	End If

End Function


'*********************************************************************
'功能：排序
'参数：TableName				数据表名称
'	   OrderName			排序字段名称
'	   Direction			移动方向(值："Up"或"Down"）
'	   FlagName				是否激活字段名称(如果没有该字段，则为1）
'	   OrderID				要移动的记录的主键值
'	   PrimaryKeyName		主键字段名
'	   PrimaryValue			选中的记录的主键值
'	   TypeName				类别表名称（如没有该字段，则为1）
'返回值：无
'*********************************************************************
Function ChangeOrder(TableName,PrimaryKeyName,PrimaryValue,OrderName,Direction,FlagName,TypeName)
	
	Dim rstChgOrd,Sql
	Dim	m_OldOrder,m_TypeName,m_OldTatal		'm_OldOrdr 要移动的记录的原始次序值
												'm_TypeName  要移动的记录的类别（如果有类别）
												'm_OldTatal  要移动的记录所在类别中，所有激活的记录个数
	
	Set rstChgOrd = Server.CreateObject("ADODB.Recordset")
	
	'得到被选中的记录的原始次序值(该记录必须是激活的）
	Sql = "Select * From "&TableName&" Where "&PrimaryKeyName&"="&cint(PrimaryValue)

	rstChgOrd.Open Sql,conn,3,3	
	m_OldOrder = rstChgOrd(OrderName)
	
	
	'根据是否有类别来进行统计激活的记录个数总和
	If cstr(TypeName) <> "0" Then
		m_TypeName = rstChgOrd(TypeName)	
		Sql = "Select * From "&TableName&" Where "&TypeName&"="&m_TypeName&" And "&FlagName&"=1 Order by "&OrderName
	Else
		Sql = "Select * From "&TableName&" Where "&FlagName&"=1 Order by "&OrderName
	End If
	
	rstChgOrd.Close 
	rstChgOrd.Open Sql,conn,3,3	
	m_OldTatal = rstChgOrd.RecordCount 
	
	
	'根据不同方向进行调整次序值
	Sql = ""
	Select Case UCase(Direction)
		Case "UP"
			If	m_OldOrder <> 1 Then       '要移动的试题次序不是第一个
				Do While Not rstChgOrd.EOF 
					If rstChgOrd(OrderName) = m_OldOrder-1 Then
						Sql = "Update "&TableName&" Set "&OrderName&"="&m_OldOrder-1&" Where "&PrimaryKeyName&"="&cint(PrimaryValue)&_
								" ; Update "&TableName&" Set "&OrderName&"="&m_OldOrder&" Where "&PrimaryKeyName&"="&rstChgOrd(PrimaryKeyName)
					End If
					rstChgOrd.MoveNext 
				Loop									
			Else