51Testing软件测试论坛

标题: 通过CQ Hook 发送带附件的邮件 [打印本页]

作者: hasjing 时间: 2007-5-11 09:33
标题: 通过CQ Hook 发送带附件的邮件
在CQ Hook里实现发送带附件的邮件

' ==========================================================
' 说明：ClearQuest不能发送带附件的邮件，该脚本可以实现在，ClearQuest里执行某个Action后发送一封带附件的邮件。
' 前提：以Domino作为邮件服务器，执行该Action操作的人员本地应装有Notes客户端，并能通过Notes客户端发送邮件
思想：执行Action时，将附件先下载到本地，然后通过调用 Notes Com接口来实现带附件的邮件的发送
' 缺点：由于脚本里面无法得到每个人的邮箱密码，所以执行该Action 的人员在执行Action时，会提示输入自己的Notes邮箱密码。
' 功能扩展:虽然有以上缺陷,不过该脚本主要演示CQ里处理附件的方法,和通过NotesCom端口发送邮件的功能。通过以上的方法，可以是写很多报告功能，可以把通过Notes发送邮件的脚本写成一个vbs脚本文件，这个时候就可以把Notes密码直接写入脚本来发送邮件。放到服务器上，并且建立一个计划任务比如一周，一个月，定时执行，发送附件。而附件的内容可以是通过CQ查询出的某种报告，如未完成的基线，未完成的版本流程。可以把这些报告存成Excel表格式，（具体实现参见yunshan 的《使用脚本轻松导出本周纪录》）然后发送给相关人员（相关人员邮件列表取的的方式可参见本人另外一个帖子）。
' Author: killer215       Date:2007-2-2
' ==========================================================

' 下面脚本以Action为"Test",Hook为Notification
Sub Test_Notification(ActionName,ActionType)
      Dim entityObj
      Dim attachmentsObj
      Dim attachment
      Dim FileName,FilePath
      Set attachField =AttachmentFields.Item(0)
      Set attachmentsObj = attachField.Attachments
      numAttachments = attachmentsobj.Count - 1
      Redim FilePathArray(0)
      FilePathArray(0)=""
      For i = 0 to numAttachments
            set attachment = attachmentsObj.Item(i)
            FileName=attachment.FileName
            ' 调用GetFilePath函数得到正确的下载路径
            FilePath=GetFilePath(FileName)
            ' 将附件下载到FilePath指定的路径
            Attachment.Load(FilePath)
            Redim Preserve FilePathArray(i)
            FilePathArray(i)=Filepath
      Next
      ' 调用通过Notes客户端发送邮件的函数发送邮件
      ' 由于该脚本主要说明附件的发送，所以在SendNotesMail里面除了取
      ' CQ里记录类型的附件外，没有取其他信息，如果需要其他信息也容易
      ' 加入
      Call SendNotesMail(FilePathArray)
End Sub

' **************************************************************
' 以下函数应该写在Global Scripts里，这里多说一句，在以前的编程中，为了代码的简洁，
' 我会把一些常用的代码抽出为一个函数，然后其他代码调用，但在CQ里写全局函数要谨慎，
' 我的建议是，能不用就不用，即使牺牲一点代码简洁。具体原因我会在以后的一篇关于CQ
' 调优的文档里说明。
' **************************************************************

' =============================================================
' 增加得到下载附件到本机的文件路径，如果没有该目录，则创建
' 如果该文件已经存在，则先删除该文件的函数
' Author:killer215       Date:2007-2-2
' =============================================================
Function GetFilePath(FileName)
Dim FilePath,FileDirectory
FileDirectory="C:\Temp"
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
' 如果目录不存在，则创建该目录
If Not fs.FolderExists(FileDirectory) Then
   fs.CreateFolder(FileDirectory)
End If
Filepath=FileDirectory & "\" & FileName
' 如果文件已经存在，则删除该文件
If fs.FileExists(FilePath) Then
   Dim file
   Set file = fs.GetFile(FilePath)
   File.Delete
End If
GetFilePath=FilePath
End Function

' ===========================================
' 增加通过Notes客户端发送邮件的函数
' Author:killer215    Date:2007-1-26
' ===========================================
Function SendNotesMail(FilePathArray)
  Dim Notesobj,dir,db,doc,item
  Dim mailsrv,email_address,tolist,body,FileName
  '创建一个Notes Com端口实例
  Set notesobj = CreateObject("Lotus.NotesSession")
  notesobj.Initialize
  ' 从本地的notes.ini文件得到邮件服务器，并且打开自己邮件数据库
  mailsrv = notesobj.GetEnvironmentString("MailServer", True)
  set dir = notesobj.GetDbDirectory(mailsrv)
  set db = dir.OpenMailDatabase
  If db.IsOpen Then
      '创建一封新的邮件
      set doc = db.CreateDocument
      doc.ReplaceItemValue "Form", "Memo"
      ' 在这里添加邮件地址，这个信息可以从记录类型的当前处理人，和项目信息里
      ' 取得，如配置管理员，项目经理，测试人员邮箱等。
      email_address="****@**.**.**"
      tolist = split(email_address,",",-1,1)
      doc.ReplaceItemValue "SendTo", tolist
      doc.ReplaceItemValue "Subject", "测试通过notes接口发送带附件的邮件"
      body = "通过ClearQuest发送带附件邮件的测试" & vbCrLf & vbCrLf
      set item = doc.CreateRichTextItem("Body")
      item.AppendText(body)
      If FilePathArray(0)<>"" Then
   For i=0 To ubound(FilePathArray)
         item.EmbedObject 1454, "", FilePathArray(i)
      Next
      End If
      doc.Send(False)
  End If
End Function

欢迎光临 51Testing软件测试论坛 (http://bbs.51testing.com/)