Перейти к содержимому

Фотография

Qtp 9.0 > Как Снять Скриншот С Окна?


  • Авторизуйтесь для ответа в теме
Сообщений в теме: 3

#1 Lich

Lich

    Новый участник

  • Members
  • Pip
  • 5 сообщений
  • ФИО:Кирсанов Сергей Васильевич

Отправлено 17 сентября 2007 - 12:32

Здравствуйте.

Подскажите, пожалуйста, как снять скриншот ошибки (обычно это окно с nativeclass="#32770") и сохранить его в виде файла во время выполнения теста.
  • 0

#2 Mike

Mike

    Консультант

  • Members
  • PipPipPipPipPipPip
  • 1 079 сообщений
  • Город:Москва

Отправлено 17 сентября 2007 - 13:41

Снэпшот-то снять несложно. Для этого у всех тестовых объектов есть метод .CaptureBitmap.
Хуже с помощением его в результаты. Вот мой вариант (пришлось вырывать из фреймворка, так что мог где-то недосмотреть. заранее сорри)

'Решение проблемы полуночи у Timer()
Public Function TimerEx()
   TimerEx = CDbl(Date) * 86400 + Timer()
End Function

'Репортит html в лог
Public Sub ReportEventWText(ByVal eventStatus, ByVal eventHeader, ByVal eventDesc, ByVal htmlCode)
	Dim fullDescription
	Dim htmlBody
	fullDescription = "<DIV style='font-size: 7pt; color: white'>&</DIV><P style='text-align:left'><B>" & EncodeHTML(eventDesc) & "</B></P><BR>" & htmlCode
	
	Reporter.ReportEvent eventStatus, eventHeader, fullDescription
End Sub

'Репортит снэпшот объекта в лог
Public Function ReportSnapshot(obj, eventStatus, eventHeader, eventDesc)
	Dim exist

	exist = obj.Exist(0)
	
				If Not exist Then
	   ReportSnapshot = False
	   Exit Function
	End If

	Dim filename,filenamebase,i
	
	filenamebase = Environment("ResultDir")&"\" & Round(TimerEx())
	filename = filenamebase
	i = 0

	dim fso
	
	set fso = CreateObject("Scripting.FileSystemObject")
	
	While getFSO().FileExists(filename)
						 filename = filenamebase & "_" & i
			 i = i +1
	Wend

	filename = filename & ".png"

   Obj.CaptureBitmap filename
   ReportEventWText eventStatus, eventHeader, eventDesc, "<IMAGE src=""file:///" & filename & """' />"
   ReportSnapshot = True
End Function

PS: Работать будет только на локальной машине - послать результаты по почте не выйдет: ссылки посыпятся.
  • 0
Best regards,
Майк.

#3 Mike

Mike

    Консультант

  • Members
  • PipPipPipPipPipPip
  • 1 079 сообщений
  • Город:Москва

Отправлено 17 сентября 2007 - 13:45

Так и знал. Ссылаюсь в коде на свою функцию EncodeHTML... Вот она:

Public Function FindFirstRegExpOccurance(ByVal where, ByVal pattern)
	Dim RE
	Dim found
	Dim matches
	
	Set re = New RegExp
	re.Pattern = pattern
	re.Global = False
	Set matches = re.Execute(where)
	If matches.count >=1 Then
		FindFirstRegExpOccurance = matches(0)
	Else
		FindFirstRegExpOccurance = ""
	End If
End Function

Public Function EncodeHTML(ByVal strToEncode)

	On Error Resume Next
		
		If FindFirstRegExpOccurance(strToEncode,"(\&|>|<|  |\\n|\"")") <> "" Then
			strToEncode = CStr(strToEncode)
			strToEncode = Replace(strToEncode, "&", "&amp;")
			strToEncode = Replace(strToEncode, ">", "&gt;")
			strToEncode = Replace(strToEncode, "<", "&lt;")
			strToEncode = Replace(strToEncode, """", "&quot;")
			strToEncode = Replace(strToEncode, "  ", "&nbsp;&nbsp;")
			strToEncode = Replace(strToEncode, "\n", "<BR>")
			strToEncode = Replace(strToEncode, vbCrLf, "<BR>")
		Else
			strToEncode = Replace(strToEncode, vbCrLf, "<BR>")
		End If
		
		
		If err.number<>0 Then
			Reporter.ReportEvent micFail, "EncodeHTML", err.description
			err.Clear
		End If
		
	On Error Goto 0
	
	EncodeHTML = strToEncode
	
End Function

  • 0
Best regards,
Майк.

#4 Lich

Lich

    Новый участник

  • Members
  • Pip
  • 5 сообщений
  • ФИО:Кирсанов Сергей Васильевич

Отправлено 18 сентября 2007 - 07:05

Спасибо за ценную информацию.
  • 0


Количество пользователей, читающих эту тему: 0

0 пользователей, 0 гостей, 0 анонимных