51Testing软件测试论坛

标题: 【seagull1985-QTP】测试过程屏幕截图保存 [打印本页]

---

作者: seagull1985    时间: 2016-4-18 18:03
标题: 【seagull1985-QTP】测试过程屏幕截图保存

1. '==========================================================================
   
2. ' NAME: User Login
   
3. ' AUTHOR: heyl  
   
4. ' DATE  : 2012-12-21
   
5. ' COMMENT:  
   
6. '==========================================================================
   
7. Class ScreenCaptureEngine
   
8. 
   
9.              Public str_ScriptPath
   
10.                          Public  oFSO
    
11.                        
    
12.                          Private Sub Class_Initialize   
    
13.                                   str_ScriptPath = str_Test_Path&"Report\"
    
14.                                   str_ScriptPath = str_ScriptPath&GetTestName
    
15.                                   me.Createreporterfolder(str_ScriptPath)
    
16.              End Sub
    
17.                        
    
18.                         Private Sub Class_Terminate      
    
19.                         Set oFSO = nothing
    
20.                         End Sub
    
21.             
    
22.                         'create a folder
    
23.                         Function Createreporterfolder(str_folderpath)
    
24.                         Dim fso, f
    
25.                         Set fso = CreateObject("Scripting.FileSystemObject")
    
26.                            If Not fso.FolderExists(str_folderpath)  Then
    
27.                            Set f = fso.CreateFolder(str_folderpath)
    
28.                            Set f = Nothing
    
29.                            Set fso = Nothing
    
30.                            Else
    
31.                            Set fso = Nothing
    
32.                            End If
    
33.                         End Function
    
34. 
    
35.                         Public Sub Report()
    
36.                          
    
37.                            Dim sFile
    
38.                            Dim sTimeStamp
    
39.                
    
40.                        
    
41.                        
    
42.                            Set oFSO = createobject("Scripting.FileSystemObject")
    
43.                            sTimeStamp = CStr(Now)
    
44.                            sTimeStamp = Replace(sTimeStamp , "\", "")
    
45.                            sTimeStamp = Replace(sTimeStamp , "/", "")
    
46.                            sTimeStamp = Replace(sTimeStamp , ":", "")
    
47.                        
    
48.                            sFile = str_ScriptPath
    
49.                            If Mid(sFile, Len(sFile),1) <> "\" Then sFile = sFile & "\"
    
50.                           
    
51.                            sFile = sFile & " " & sTimeStamp & ".png"
    
52.                        
    
53.                            While oFSO.FileExists(sFile)
    
54.                                    sFile = Mid(sFile ,1,Len(sFile)-4) & "_1" & ".png"
    
55.                            Wend
    
56.                           
    
57.                            Desktop.CaptureBitmap(sFile)
    
58.                          
    
59.                         End Sub
    
60. End Class
    
61. 
    
62. Set oScreenCapture = new ScreenCaptureEngine

复制代码

---

作者: 赵佳乐SMILE    时间: 2016-4-19 09:15
棒棒哒

---

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

Powered by Discuz! X3.2