QTP 錯誤截圖、處理以及發送

1、截取錯誤圖片信息函數

1 2 3 4 5 6 7 8 9 10 11 12

'pathway 截圖所要存放的位置 Public Function QTP_Capture (pathway)   Dim datestamp   Dim filename   Datestamp = Now () 'Test_name腳本的名稱   filename = Environment ("TestName")&"_"&datestamp&".jpg" '文件命名不可包含字符 ：   filename = Replace (filename,":","")   filename = pathway + "\" + ""&filename   Desktop.CaptureBitmap filename End Function

 2、圖片處理函數

　2.1圖片中添加文字

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

'Filename:圖片文件名字 'Strng:在圖片中所要添加的文字 Function JPG_TypeString (filename, strng) Set Jpeg=CreateObject("Persits.Jpeg") Jpeg.Open filename '字體的顏色、字體、是否加粗 Jpeg.Canvas.Font.Color=vbblack Jpeg.Canvas.Font.Family="楷體_GB2312" Jpeg.Canvas.Font.Bold=True '在圖片的(100, Jpeg.OriginalHeight/2)的座標位置添加文字strng Jpeg.Canvas.print 100, Jpeg.OriginalHeight/2, strng Jpeg.Save filename Jpeg.Close Set Jpeg=nothing End Function

 　2.2在圖片中畫橢圓

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

'filename 圖片的路徑 'leftlen、toplen 左邊的x , y 'rightlen、buttonlen 右邊的x , y Function JPG_DrawEllipse (filename, leftlen, toplen, rightlen, buttonlen)         Set Jpeg=CreateObject ("Persits.Jpeg")         Jpeg.Open filename         Jpeg.Canvas.Pen.Color=vbred       Jpeg.Canvas.Pen.Width=2       Jpeg.Canvas.Brush.Solid=False '畫橢圓       Jpeg.Canvas.Ellipseleftlen,toplen,rightlen,buttonlen       Jpeg.Save filename       Jpeg.Close       Set Jpeg=nothing End Function

 

　2.3在圖片需要標示的地方畫橢圓，然後畫直線，註明信息

    

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66

Function JPG_DrawEllipseAndString(filename,strng,leftlen,toplen,rightlen,buttonlen)       Set Jpeg=CreateObject("Persits.Jpeg")       Jpeg.Open filename         Jpeg.Canvas.Pen.Color=vbblack         Jpeg.Canvas.Pen.Width=2 '是否加粗         Jpeg.Canvas.Brush.Solid=False '畫橢圓         Jpeg.Canvas.Ellipse leftlen,toplen,rightlen,buttonlen         If  leftlen>Jpeg.OriginalWidth/2Then         tmpleft=leftlen         tmtop=toplen+(buttonlen-toplen)/2            If leftlen >100  Then                     tmpright=leftlen-100               Else                tmpright=leftlen/2            End If            If toplen+(buttonlen-toplen)/2>100 Then               tmpbuttom=toplen+(buttonlen-toplen)/2-100            Else                   tmpbuttom=toplen+(buttonlen-toplen)/2-100       End If       Else        tmpleft=rightlen        tmptop=toplen+(buttonlen-toplen)/2        If rightlen+100+Len(strng)*2>Jpeg.OriginalWidth Then          tmpright=Jpeg.OriginalWidth-Len(strng)*2        Else        tmpright=rightlen+100        End If        If toplen+(buttonlen-toplen)/2+100>Jpeg.OriginalHeight Then            tmpbuttom=Jpeg.OriginalHeight+100          Else          tmpbuttom=toplen+(buttonlen-toplen)/2+100          End If        End If         Jpeg.Canvas.Line tmpleft,tmptop,tmpright,tmpbuttom      Jpeg.Canvas.Font.Family="楷體_GB2312"     Jpeg.Canvas.Font.Bold=True     Jpeg.Canvas.Font.Color=vbblack        lenght=0     lens=0     startLen=1     strLen1=CInt(Jpeg.Canvas.GetTextExtent("b"))        strLen=CInt(Jpeg.Canvas.GetTextExtent(strng))        JSize=Jpeg.Canvas.Font.Size     If tmpright+strLen>Jpeg.OriginalWidth Then       Do           startLen=startLen+lenght         tmpbuttom=tmpbuttom+lens         Jpeg.Canvas.Print tmpright,tmpbuttom,Mid(strng,startLen,CInt((Jpeg.OriginalWidth-tmpright)/strLen1)-2)         lens=JSize         lenght=CInt((Jpeg.OriginalWidth-tmpright)/strLen1)-2         Loop Until startLen>=Len(strng)         Else         Jpeg.Canvas.Print tmpright,tmpbuttom,strng              End If           Jpeg.Save filename         Gl_ErrBitmapName=filename         Jpeg.Close        Set Jpeg=Nothing        End Function

 3、發送郵件函數

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50

Public Function SendByOutLook(emailAddress,subject,body) Function 'You_Account：你的郵件賬號 'You_Password:你的郵件密碼 'Send_Email:  接受郵件的賬號 'Send_Topic:  郵件主題 'Send_Body:   郵件內容 'Send_Attachment:郵件附件 Send_mail(You_Account,You_Password,Send_Email,Send_Topic,Send_Body,Send_Attachment) '帳號和服務器分離 You_ID=Split(You_Account, "@", -1, vbTextCompare) '這個是必須要的，不過可以放心的事，不會通過微軟發送郵件 MS_Space = "http://schemas.microsoft.com/cdo/configuration/" Set Email = CreateObject("CDO.Message") Email.From = You_Account '接收郵件的賬號 Email.To = Send_Email '郵件主題 Email.Subject = Send_Topic '郵件內容 Email.Textbody = Send_Body '郵件附件 If Send_Attachment <> "" Then Email.AddAttachment Send_Attachment End If With Email.Configuration.Fields '發信端口 .Item (MS_Space&"sendusing") = 2 'SMTP服務器地址 .Item(MS_Space&"smtpserver") = "smtp."&You_ID(1) 'SMTP服務器端口 .Item(MS_Space&"smtpserverport") = 25 'cdobasec .Item(MS_Space&"smtpauthenticate") = 1 '你的郵件賬號 .Item(MS_Space&"sendusername") = You_ID(0) '你的郵件密碼 .Item(MS_Space&"sendpassword") = You_Password .Update End With '發送郵件 Email.Send Set Email=Nothing Send_Mail=True '如果沒有任何錯誤信息，則表示發送成功,否則發送失敗 If Err Then Err.Clear Send_Mail=False End If End Function