publicfunction.asp

功能齐全的oa系统

'*************************************************************
'功能：解析某一字符串中,某个字符的个数
'参数：
'  FatherString；String；字符串
'  SonChar；String；要解析的字符
'返回值：Integer
'*************************************************************
Function Num_CharInString(FatherString,SonChar)
	Dim intStart,intPosition,intNum
	intStart = 1 '初始化搜索开始位置
	intPosition = 1 '初始化FatherString的析取位置
	intNum=0
																
	Do While intStart <= len(FatherString)
		If mid(FatherString,intStart,1) = cstr(SonChar)  Then '找到字符SonChar
			intNum=intNum+1
		End If
		intStart = intStart + 1 '后移搜索开始位置
	Loop
	Num_CharInString = intNum
End Function


'*************************************************************
'功能：发送Email
'参数：
'      Sender                发信人的信箱 
'      Receiver              收信人的信箱
'      CC                    抄送人的信箱  
'      BCC                   密送人的信箱
'      Subject               信件的标题
'      Body                  信件的内容
'      Importance            信件的优先级
'      m_AttachFileNameList  附件在服务器上的名字序列
'      m_AttachOldNameList   附件的原名字序列
'返回值：无
'*************************************************************
Function SendEmail(Sender,Receiver,CC,BCC,Subject,Body,Importance,m_AttachFileNameList,m_AttachOldNameList)
    Response.Write Sender&"<br>"
    Response.Write Receiver&"<br>"
    Response.Write CC&"<br>"
    Response.Write Bcc&"<br>" 
    Response.Write Subject&"<br>"
    Response.Write Body&"<br>"
    Response.Write Importance&"<br>"
    Response.Write m_AttachFileNameList&"<br>"
    Response.Write m_AttachOldNameList&"<br>"

    
    dim CurrentFullFileName,OtherAttachFileNameList,CurrentFileName    '解析附件服务器上名字序列时所用的变量   
    dim CurrentOldName,OtherAttachOldNameList 
    On Error Resume Next
    
    Set sendMail = Server.CreateObject("CDONTS.Newmail")	'创建新邮件对象的一个实例
	sendMail.From = cstr(Sender)							'指定发件人地址
	sendMail.To = cstr(Receiver)							'指定收件人地址
	if  CC <> "" then  
	     sendMail.Cc = cstr(CC)							    '指定抄送人地址
	end if 
	if BCC <> "" then  
	     sendMail.Bcc = cstr(BCC)						    '指定密送人地址
	end if 
	sendMail.Subject = cstr(Subject)						'指定邮件主题
	sendMail.Body = cstr(Body)                              '指定邮件内容
	sendMail.Importance = Cint(Importance)                  '指定邮件的优先级
	
	OtherAttachFileNameList = m_AttachFileNameList
    OtherAttachOldNameList = m_AttachOldNameList
	Do Until Instr(OtherAttachFileNameList,"и") = 0							
		
		CurrentFileName = cstr(Left(OtherAttachFileNameList,Instr(OtherAttachFileNameList,"и")-1))		  '解析字符и
		OtherAttachFileNameList = mid(OtherAttachFileNameList,Instr(OtherAttachFileNameList,"и")+1)                                 
        path=Server.mappath("TempFiles")						  '上传文件服务器的路径
        CurrentFullFileName = path+"\"+CurrentFileName
        CurrentOldName = cstr(Left(OtherAttachOldNameList,Instr(OtherAttachOldNameList,"и")-1))		  '解析字符и
        OtherAttachOldNameList = mid(OtherAttachOldNameList,Instr(OtherAttachOldNameList,"и")+1)
        sendMail.AttachFile  CurrentFullFileName , CurrentOldName 
        'Call DelUpFileFromDri(CurrentAttach)  
        Response.Write CurrentFullFileName&"<br>"
        Response.Write CurrentOldName&"<br>"     
	Loop
	sendMail.MailFormat = 0                                 
	sendMail.BodyFormat = 0	 	
	sendMail.Send											'发送邮件
	Set sendMail = Nothing	
	
	If Err.number <> 0 Then
		Response.Redirect "SendFinished.asp?OperType=Failed"
		Exit Function
	End If
	
	OtherAttachFileNameList = m_AttachFileNameList
    
	Do Until Instr(OtherAttachFileNameList,"и") = 0							
		
		CurrentFileName = cstr(Left(OtherAttachFileNameList,Instr(OtherAttachFileNameList,"и")-1))		  '解析字符и
		OtherAttachFileNameList = mid(OtherAttachFileNameList,Instr(OtherAttachFileNameList,"и")+1)                                 
        path=Server.mappath("TempFiles")						  '上传文件服务器的路径
        CurrentFullFileName = path+"\"+CurrentFileName
        Call DelUpFileFromDri(CurrentFullFileName)       
	Loop
	
End Function

'***********************************************************************
'功能：向内部信箱发送简单形式的邮件
'参数列表:    
'          m_FromID        发件人的ID        
'          m_ToID          收件人的ID
'          m_CCIDs         抄送人的ID字串，各个ID之间用；隔开
'          m_Name          邮件的标题
'          m_Description   邮件的内容
'返回值：无
'***********************************************************************
Function SendMsg(m_FromID,m_ToID,m_CCIDs,m_Name,m_Description) 
    '定义要存入数据库的数据
    'SendMsg表
    dim m_SendMsgID,m_Prior,m_SendDate,m_IsSend,m_IsMsgActive
    dim FieldListMessage,ValueListMessage
    
    'ReceiveMsg表
    dim m_ReceiveMsgID,m_SendType,m_IsReaded,m_IsSendToActive
    dim FieldListSendTo,ValueListSendTo
      
    '----------存储到SendMsg表中
    '从表单得到要存入的值
    m_SendMsgID = AutoGetNo("SendMsg")                     
    m_Prior = 0
    m_SendDate = Now
    m_IsSend = true
    m_IsMsgActive = 3                            '只注重收件结果，发件信息不用记,直接设为删除状态
    '向表中添加数据-------
    FieldListMessage = "SendMsgID,Name,FromID,Description,Prior,SendDate,IsSend,IsActive"
    ValueListMessage = m_SendMsgID&"и"&m_Name&"и"&m_FromID&"и"&m_Description&"и"&m_Prior&"и"&m_SendDate&"и"&m_IsSend&"и"&m_IsMsgActive   
    Call AddRecord("SendMsg",FieldListMessage,ValueListMessage,"SendMsgID")

    '--------存储到ReceiveMsg表中        
    m_ReceiveMsgID = AutoGetNo("ReceiveMsg")    '处理第一个用户,发送类型
    m_SendType ="发送"    
    m_IsReaded = false
    m_IsSendToActive = 1 
            
    FieldListSendTo = "ReceiveMsgID,SendMsgID,SendType,ToID,IsReaded,IsActive"      
    ValueListSendTo =  m_ReceiveMsgID&"и"&m_SendMsgID&"и"&m_SendType&"и"&m_ToID&"и"&m_IsReaded&"и"&m_IsSendToActive
    Call AddRecord("ReceiveMsg",FieldListSendTo,ValueListSendTo,"ReceiveMsgID")
   
    Do Until Instr(m_CCIDs,";") = 0		        '处理其余用户，抄送类型
        m_ReceiveMsgID = AutoGetNo("ReceiveMsg")
        m_SendType = "抄送"        
		m_ToID = Left(m_CCIDs,Instr(m_CCIDs,";")-1)
		m_CCIDs = mid(m_CCIDs,Instr(m_CCIDs,";")+1)
	    ValueListSendTo =  m_ReceiveMsgID&"и"&m_SendMsgID&"и"&m_SendType&"и"&m_ToID&"и"&m_IsReaded&"и"&m_IsSendToActive
	    Call AddRecord("ReceiveMsg",FieldListSendTo,ValueListSendTo,"ReceiveMsgID") 
	Loop
End function

'*************************************************************
'功能：返回一个日期时间变量和现在相比相差的小时数
'参数：
'  theDate；DateTime；字符串
'返回值：Integer,若不现在早，则返回负数，否则返回正数
'*************************************************************
Function DiffHour(theDate)
	DiffHour=DateDiff("h",Now,theDate)
End Function



'*************************************************************
'功能：返回一个日期时间变量和现在相比相差的天数
'参数：
'  theDate；DateTime；字符串
'返回值：Integer,若不现在早，则返回负数，否则返回正数
'*************************************************************
Function DiffDay(theDate)
	DiffDay=DateDiff("d",Now,theDate)
End Function


'*************************************************************
'功能：物理删除磁盘上的某个文件
'参数：
'  FileFullName；所要删除的文件的详细路径及文件名
'返回值：无
'*************************************************************
Function DelUpFileFromDri(FileFullName)

	Dim MyFileObject,MyFile
	
	Set MyFileObject = Server.CreateObject("Scripting.FileSystemObject")
	
	If MyFileObject.FileExists(FileFullName) Then		'检查要删除的文件是否存在
		
		Set MyFile = MyFileObject.GetFile(cstr(FileFullName))
		MyFile.Delete
		Set MyFile = nothing
	End If		
	Set MyFileObject = nothing  

End Function



'*************************************************************
'功能：得到通过UserID得到其所属部门的记录集
'参数：
'  intUserID	用户的ID
'返回值：记录集
'*************************************************************
Function GetUserDept(intUserID)
	
	Dim SearchCondition,OrderField,OrderMode,ShowN
	
	SearchCondition = "DepartmentID in (Select DepartmentID From Employ Where EmpID in (Select RepID From PUB_User Where UserID = " & clng(intUserID) & "))"
	OrderField = "DepartmentID"
	OrderMode = 1
	ShowN = 0

	Set GetUserDept = GetRecordList("Department",SearchCondition,OrderField,OrderMode,ShowN)
	
End Function

'***********************************************************************
'功能：粘贴附件
'参数：
'返回值：记录集
'***********************************************************************
Function AddAttachInSend()

	Dim blnParse
	Set objUpload = Server.CreateObject("aspcn.upload")  '创建对象
	blnParse=objupload.parseFormData()		 '分离表单元素的值

	If blnParse=true Then  '如果blnParse返回真,则分离表单元素的值成功
	
		filename=objUpload.filename("fSelectFile") '取得上传文件的文件名
		
		'记录上传的文件名
		Dim tmpFileName
		tmpFileName = filename	
			
		'文件上传到服务器的目录下
		Dim path, newname, nowdate, ftype

		nowdate=now
		nowdate=replace(nowdate,"-","")
		nowdate=replace(nowdate,":","")
		nowdate=replace(nowdate," ","")
		
		ftype=objUpload.fileType(filename)
		newname=nowdate & "."& ftype
		
		'上面几句是得到新的名字（以当前时间命名），下面一句是赋新名字
		objUpload.NewFileName =newname
	
		If filename <> "" Then 
			m_DocFileName = newname				
			path=Server.mappath("TempFiles")						 '上传文件服务器的路径
			varResult=objUpload.FileUpLoad (0,path)			 '上传文件
			m_FileOldName = cstr(tmpFileName)			'得到上载文件的原始名字
			m_DocFileSize = objupload.getFileSize    '得到上载文件的大小（Kb）
		Else
			m_DocFileName = ""
			m_FileOldName = ""
			m_DocFileSize = 0
		End If
	
	End If

	Response.Redirect ("EditAttachFrm.asp?Upload=Yes&FileName="&m_DocFileName&"&OldName="&m_FileOldName&"&FileSize="&m_DocFileSize&"")
	
End Function 


'***********************************************************************
'功能：删除已粘贴的附件
'返回值：无
'***********************************************************************
Function DelAttachInSend()
	
	Dim blnParse,strSelFile
	Dim strTmpInfo1,strTmpInfo2,strTmpInfo3,strTmpSession,intTmpInfo
	Set objUpload = Server.CreateObject("aspcn.upload")
	blnParse=objUpload.parseFormData()		 '分离表单元素的值
	strSelFile = objUpload.objectvalue("sltAttachFile")
	
	'把删除的文件信息从Session中删除
	strTmpSession = Session("FileInfo")
	strTmpInfo1 = Left(strTmpSession,Instr(strTmpSession,strSelFile)-1)
	strTmpInfo2 = Mid(strTmpSession,Instr(strTmpSession,strSelFile))
	intTmpInfo= Instr(strTmpInfo2,"?")
	strTmpInfo3= Mid(strTmpInfo2,intTmpInfo+1)
	Session("FileInfo") = strTmpInfo1 & strTmpInfo3
	
	Dim path, strFileFullPath
	path = Server.MapPath("TempFiles")
	strFileFullPath = path + "\" + strSelFile
	DelUpFileFromDri(strFileFullPath) 
	
End Function


'***********************************************************************
'功能：记录上传附件的信息，并进行显示
'参数：
'返回值：记录集
'***********************************************************************
Function RecordAddFileInfo()

	Dim strFileName,strFileOldName,strFileSize,strTmpInfo
	Dim arryFileInfo,arryInfo,intNum

	strTmpInfo = "" 
	strFileName = Request.QueryString("FileName")
	strFileOldName = Request.QueryString("OldName")  
	strFileSize = Request.QueryString("FileSize")
	strTmpInfo = strFileName&"|"&strFileOldName&"|"&strFileSize
	
	Session("FileInfo") =strTmpInfo & "?" & Session("FileInfo")  
	
	arryFileInfo = split(Session("FileInfo"),"?",-1)
	intNum = UBound(arryFileInfo)-LBound(arryFileInfo)
	For i = 0 TO intNum -1
		arryInfo = split(arryFileInfo(i),"|",-1)
		Response.Write "<option value='" & arryInfo(0) & "'>" & arryInfo(1) & " (" & arryInfo(2) & "字节)</option>"
	Next
	Response.Write "</select>"
	Session("FileNum") = intNum

End Function 


'***********************************************************************
'功能：记录上传附件的信息，并进行显示
'参数：
'返回值：记录集
'***********************************************************************
Function RecordDelFileInfo()
	
	Dim arryFileInfo,arryInfo,intNum
	
	If Session("FileInfo") <> "" Then
		arryFileInfo = split(Session("FileInfo"),"?",-1)
		intNum = UBound(arryFileInfo)-LBound(arryFileInfo)
		For i = 0 TO intNum -1
			arryInfo = split(arryFileInfo(i),"|",-1)
			Response.Write "<option value='" & arryInfo(0) & "'>" & arryInfo(1) & " (" & arryInfo(2) & "字节)</option>"
		Next
		Response.Write "</select>"
		Session("FileNum") = intNum
	Else
		Response.Write "</select>"
		Session("FileNum") = ""
	End If

End Function

'***********************************************************************
'功能：物理移动文件（将文件从源文件夹移到目的文件夹，名字不变）
'参数：  m_SourcePath         源文件夹路径   
'        m_DestinationPath    目的文件夹路径
'        m_FileName           文件名字
'返回值：无
'***********************************************************************
function MoveFileInSend(m_SourcePath,m_DestinationPath,m_FileName)                         
    
    Dim strSourceFullName,strDestinationFullPath
	strSourceFullName = m_SourcePath + "\" + m_FileName
	strDestinationFullName = m_DestinationPath +"\"+ m_FileName
	
	Dim MyFileObject
	
	Set MyFileObject = Server.CreateObject("Scripting.FileSystemObject")
	
	If MyFileObject.FileExists(strSourceFullName) Then		'检查要删除的文件是否存在
	    Call MyFileObject.MoveFile(strSourceFullName,strDestinationFullName)	
	End If
	
	
	Set MyFileObject = nothing  
End function 

'***********************************************************************
'功能：得到文件的大小
'参数：  m_FileName         源文件名字   
'返回值：文件大小
'***********************************************************************
function GetFileSize(m_FileName)
         
    Dim MyFileObject,MyFile
	
	Set MyFileObject = Server.CreateObject("Scripting.FileSystemObject")
	
	If MyFileObject.FileExists(m_FileName) Then		'检查要删除的文件是否存在		
		Set MyFile = MyFileObject.GetFile(cstr(m_FileName))
		GetFileSize = MyFile.Size	
		Set MyFile = nothing	
    Else 
        GetFileSize = 0
	End If
	Set MyFileObject = nothing  
End Function


'***********************************************************************
'功能：显示文件大小(按照B,KB,MB)
'返回值：
'***********************************************************************
Function ShowFileSize(intSize)

	If clng(intSize) < 1024 Then
		ShowFileSize = cstr(intSize) + "&nbsp;字节"
	Elseif clng(intSize) >= 1024 and clng(intSize) < 1048576 Then
		ShowFileSize = cstr(Round((intSize/1024),2)) + "&nbsp;KB"
	Elseif clng(intSize) >= 1048576 Then
		ShowFileSize = cstr(Round((intSize/1048576),2)) + "&nbsp;MB"
	End If
	
End Function

%>