1 Class QCImageErrorCapture
 2    Dim qtpApp
 3    Sub Class_Initialize()
 4           Set qtpApp = CreateObject("QuickTest.Application")
 5         If qtpApp.CurrentDocumentType = "Test" Then
 6             qtpApp.Test.Settings.Run.DisableSmartIdentification = False‘False
 7             qtpApp.Test.Settings.Run.OnError = "Stop" ‘"NextStep"      "stop"
 8         else
 9             qtpApp.BusinessComponent.Settings.Run.OnError = "Stop"
10         End If
11    End Sub
12     Sub Class_Terminate()
13         ‘Check if the current test has failed. If failed then only capture screenshot
14         If Reporter.RunStatus = micFail Then ‘and qtpApp.CurrentDocumentType = "test" Then
15             CaptureAndAttachDesktop
16         End If
17     End Sub
18  
19     Private Sub CaptureAndAttachDesktop()
20         ‘QC is not connected
21         If QCUtil.IsConnected = False then Exit Sub
22  
23         ‘The test is not running from Test Lab
24         If QcUtil.CurrentRun is Nothing Then Exit Sub
25  
26         On error resume next
27         ‘Hide QTP to make sure we don‘t get QTP in snapshot
28 ‘        Set qtpApp = CreateObject("QuickTest.Application")
29 ‘        qtpApp.Test.Settings.Run.DisableSmartIdentification = True
30 ‘        msgbox "display"
31         qtpApp.visible = False
32 
33         ‘GIve time for QTP to get hidden
34         Wait 2
35  
36         ‘Capture the screenshot to the report folder
37         Desktop.CaptureBitmap Reporter.ReportPath & "/Report/ErrorImage.png", True
38         qtpApp.visible = True
39 ‘        Browser("title:=视博云业务全流程管理平台").Close
40 
41 ‘        SystemUtil.CloseProcessByName "iexplore.exe"
42 ‘        isFail = True
43         
44         Reporter.ReportEvent micFail, "失败截图", "失败截图", Reporter.ReportPath & "/Report/ErrorImage.png"
45 
46         
47         If qtpApp.CurrentDocumentType = "Test" Then
48             Browser("title:=视博云业务全流程管理平台").Page("title:=视博云业务全流程管理平台").Frame("html id:=FM_Logo").Image("file name:=icon_exit.png").Click
49             wait 1
50             Browser("title:=视博云业务全流程管理平台").Dialog("text:=来自网页的消息", "nativeclass:=#32770").WinButton("text:=确定").Click
51         end if
52 
53         ‘Add the capture to QC
54 ‘        Set oAttachments = QCutil.CurrentRun.Attachments
55 ‘        Set oAttachment = oAttachments.AddItem(null)
56 ‘        oAttachment.FileName = Reporter.ReportPath & "/Report/ErrorImage.png" 
57 ‘        oAttachment.Type = 1 ‘File
58  
59         ‘Check if the current test is a QTP Test or Business Component
60 ‘        Select Case LCase(qtpApp.CurrentDocumentType)
61 ‘            Case "test"
62 ‘                    print "test"
63 ‘                    oAttachment.Description = "Name: " & qtpApp.Test.Name & vbNewLine & "Error: " & qtpApp.Test.LastRunResults.LastError
64 ‘            Case "business component"
65 ‘                    oAttachment.Description = "Name: " & qtpApp.BusinessComponent.Name & vbNewLine & "Error: " & qtpApp.BusinessComponent.LastRunResults.LastError
66 ‘ 
67 ‘                    ‘We can also add the Business COmponent to a User Defined Field 
68 ‘                    ‘QCUtil.CurrentTestSetTest.Field("TC_USER_01") = qtpApp.BusinessComponent.Name
69 ‘                    ‘QCUtil.CurrentTestSetTest.Post
70 ‘        End Select        
71 ‘ 
72 ‘        ‘Add the attachment
73 ‘        oAttachment.Post
74 ‘        print "post"
75     End Sub 
76 End Class
77  
78 ‘Create the object in one of the attached libraries. When the Test or Business component ends 
79 ‘the screenshot will be captured
80 Set oErrorCapture = new QCImageErrorCapture