空间管理您的位置: 51Testing软件测试网 » 血樱狂飙的个人空间 » 日志

终于升级空间了,可以开始写日志了!

上一篇 / 下一篇 2009-04-02 22:54:10 / 个人分类：心情

查看( 642 ) / 评论( 10 ) / 评分( 0 / 0 )

工作快2年了,总感觉没有留下点什么,心里空荡荡的.

我觉得, 是时候改总结总结了!

收藏举报

TAG:

引用删除 Jay-Yang84 / 2009-06-03 17:12:18: Dim fso, MyFile, path
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile(".\DeleteResult.txt", True)
path = getProjectPath()&"\TestCase"
DeleteSpecifyFolder path, "SnapShots", MyFile
MyFile.Close

Function DeleteSpecifyFolder(path, foldername, MyFile)
Dim fso, f, f1, fc, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(path)
Set fc = f.SubFolders
For Each f1 in fc
      If f1.name = foldername Then
         f1.Delete
         MyFile.WriteLine("The folder "+foldername+" under "+path+" is delete successfully.")
      Else
         DeleteSpecifyFolder path+"\"+f1.name, foldername  ,MyFile
      End If
Next
End Function

Function getProjectPath()
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objFile = objFSO.GetFile(wscript.scriptfullname)
      parentFolder = objFSO.GetParentFolderName(objFile)
      getProjectPath = objFSO.GetParentFolderName(parentFolder)
      Set objFSO = Nothing
      Set objFile = Nothing
End Function

引用删除 Jay-Yang84 / 2009-06-03 17:10:59: Function GetROProp(objName, strProperty)
dim objTemp

Set objTemp = GetObj(objName)
if IsExist(objName, 2) Then
      GetROProp = objTemp.GetROProperty(strProperty)
Else
      ExitAction
End If
End Function

Function GetTOProp(objName, strProperty)
dim objTemp

Set objTemp = GetObj(objName)
if IsExist(objName, 2) Then
      GetTOProp = objTemp.GetTOProperty(strProperty)
Else
      ExitAction
End If
End Function

Function IsExist(objName, intTime)
Dim objTemp, intInterval, intCountFrom, intCountTo
Dim blnExist

blnExist = vbFalse
Set objTemp = GetObj(objName)
If 0 = (intTime mod 2) Then
      intCountTo = intTime \ 2 - 1
Else
      intCountTo = intTime \ 2
End If

If intTime > 2 Then
      intInterval = 2
Else
      intInterval = intTime
End If

For intCountFrom = 0 to intCountTo
      If objTemp.Exist(intInterval) Then
         blnExist = vbTrue
         Exit for
      End If
Next

If Not blnExist Then
      Report micDone, "IsExist", "Object <" & objName & "> doesn't exist!"
End If

IsExist = blnExist
End Function

Function PressKey(strKeyboard)
Dim shellObj
Set shellObj = CreateObject("Wscript.shell")
Shellobj.SendKeys strKeyBoard
Set shellObj = Nothing
End Function

Function ClickObject(ObjName)
Dim objTemp
ClickObject = vbFalse
Set objTemp = GetObj(objName)
If objTemp.exist(3) Then
      objTemp.Click
      wait 1
      ClickObject = vbTrue
Else
      Report "micFail","Function:ClickOjbect","The object doesn't exist."
      ExitAction
End If
End Function

引用删除 Jay-Yang84 / 2009-06-03 16:56:48: Function GetObj(objName)
' Check the name string, then return the object.
If 0 = strcomp(objName, "", 1) Then
      GetObj = vbFalse
      Report micFail, "GetObj", "Object name cannot be none."
      ExitAction
Else
      Dim strTemp
      strTemp = Eval(objName)
      If 0 = strcomp(strTemp, "", 1) Then
         GetObj = vbFalse
         Report micFail, "GetObj", "Object <" & objName & "> doesn't exist in repository."
         ExitAction
      Else
         Execute("set GetObj = " & strTemp)
      End If
End If
End Function

Function EnterValue(objName, objValue)
Dim strClass, objTemp
Set objTemp = GetObj(objName)

If IsExist(objName, 2) Then
      strClass = objTemp.GetTOProperty("Class Name")

      Select Case strClass
         Case "SwfEdit"                objTemp.Set objValue
         Case "SwfEditor"
            objTemp.Object.Clear
            objTemp.Type objValue
         Case "WinEdit"                objTemp.Set objValue
         Case "SwfSpin"                objTemp.Set objValue
         'Web part
         Case "WebEdit"                objTemp.Set objValue
         Case Else                         Report micFail, "InputValue", "Object <" & objName & "> doesn't have this method."
         ExitAction
      End Select
End If
End Function

Function SetValue(objName, objValue)
Dim strClass, objTemp
Set objTemp = GetObj(objName)

If IsExist(objName, 2) Then
      strClass = objTemp.GetTOProperty("Class Name")

      Select Case strClass
         Case "SwfRadioButton"                objTemp.Set
         Case "SwfCheckBox"                   objTemp.Set objValue ' Limited to values "On" and "Off".
         'Web part
         Case "WebCheckBox"                   objTemp.Set objValue ' Limited to values "On" and "Off".
         Case "WebRadioGroup"                'For the WebRadioGroup, the ObjValue is the radio button index of the group, start from 0
         Dim allItems
            allItems = Split(objTemp.GetRoProperty("all items"),";")
            objTemp.Select allItems(ObjValue)
         Case Else
            Report micFail, "InputValue", "Object <" & objName & "> doesn't have this method."
            ExitAction
      End Select
End If
End Function

Function SelectItem(objName, objValue)
Dim strClass, objTemp

Set objTemp = GetObj(objName)

If  IsExist(objName, 2) Then
      strClass = objTemp.GetTOProperty("Class Name")

      Select Case strClass
         Case "SwfComboBox"                objTemp.Select objValue
         'Web part
         Case "WebList"
            objTemp.Select ObjValue
         Case Else
            Report micFail, "InputValue", "Object <" & objName & "> doesn't have this method."
            ExitAction
      End Select
End If
End Function

引用删除 Jay-Yang84 / 2009-06-03 16:51:28: @Echo off

Set "var = %DevPath%"
set "str=%var :;=%"

:intercept
if "%str:~0,1%"==" " set "str=%str:~1%"&goto intercept

:intercept2
if "%str:~-1%"==" " set "str=%str:~0,-1%"&goto intercept2

RegSvr32 /s "%str%RepositoryUtil.dll"

RegSvr32 /s "%str%QTLoader.dll"

引用删除 Jay-Yang84 / 2009-04-24 16:55:36: Class ExcelOperation

private ExcelApp 'As Excel.Application
private  excelSheet  'As Excel.worksheet
private excelBook 'As Excel.workbook

' *********************************************************************************************
' 函数说明：打开工作薄
' 参数说明：
'       (1)ExcelApp:Excel应用程序名称;
'       (2)path:要打开的工作薄路径;
' 返回结果：
'       (1)成功：工作表对象NewWorkbook
'       (1)失败：Nothing
' 调用方法:
'       set NewWorkbook = CreateNewWorkbook(ExcelApp)
' *********************************************************************************************
Public Function OpenWorkbook(path, sheetName)
On Error Resume Next

Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
Set CreateExcel = ExcelApp

ExcelApp.Workbooks.Open(path)
Set excelBook = ExcelApp.Workbooks(1)
excelBook.WorkSheets(sheetName).Activate
Set excelSheet = excelBook.worksheets(sheetName)
On Error GoTo 0
End Function

'The GetCellValue returns the cell's value according to its row column and sheet
'excelSheet - the Excel Sheet in which the cell exists
'row - the cell's row
'column - the cell's column
'return 0 if the cell could not be found
' *********************************************************************************************
' 函数说明：获取工作表excelSheet单元格的值
' 参数说明：
'       (1)excelSheet:工作表名称;
'       (2)row:列的序号;
'       (3)column:行的序号;
' 返回结果：
'       (1)单元格存在,返回单元格值;
'       (2)单元格不存在，返回0;
' 调用方法:
'          set CellValue = GetCellValue(excelSheet, 1, 2)
' *********************************************************************************************
Public Function GetCellValue(row, column)
value = 0
Err = 0
On Error Resume Next
tempValue = excelSheet.Cells(row, column).Value
If Err = 0 Then
      value = tempValue
      Err = 0
End If
On Error GoTo 0
GetCellValue = value
End Function

Private Sub Class_Terminate
Call CloseExcel()
End Sub

' *********************************************************************************************
' 函数说明：关闭Excel应用程序;
' 参数说明：
'       (1)ExcelApp:Excel应用程序名称;
' 调用方法:
'          CloseExcel(ExcelApp)
' *********************************************************************************************
Private Function CloseExcel()
On Error Resume Next
ExcelApp.Quit
Set ExcelApp = Nothing
On Error GoTo 0
End Function

End Class

引用删除 Jay-Yang84 / 2009-04-24 16:55:02: Dim qtApp 'As QuickTest.Application ' Declare the Application object variable
Dim qtTest 'As QuickTest.Test ' Declare a Test object variable
Dim qtResultsOpt 'As QuickTest.RunResultsOptions ' Declare a Run Results Options object variable

'Get project path
Dim projectPath
projectPath = getProjectPath()&"\"

Call driver()

Function driver()
      sourceDataFile = projectPath&"TestSet.xls"
      sourceDataSheet = "TestCases"
      TestCasePath = projectPath&"TestCase"
      frameUtilFolder = projectPath&"FrameUtil"
      'Load all vbs file under FramwUtil folder
      Call ImportUtilFun(frameUtilFolder)
      XmlLogPrint "<?xml version=""1.0"" encoding=""GB2312""?>"

      Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object
      qtApp.Launch ' Start QuickTest
      qtApp.Visible = True ' Make the QuickTest application visible
      ' Set QuickTest run options
      qtApp.Options.Run.CaptureForTestResults = "OnError"
      qtApp.Options.Run.RunMode = "Fast"
      qtApp.Options.Run.ViewResults = False

   ' Create an instance to operate excel
      Dim excelInstance
      Set excelInstance = new ExcelOperation
      excelInstance.OpenWorkbook sourceDataFile, sourceDataSheet

      Dim row
      row =2
      IDX = Trim(excelInstance.GetCellValue(row, 1))
      XmlLogPrint "<TestCase>"
      Do
         ' If the IDX value is "√", run it,
         If StrComp(IDX, "√")=0 Then
            TestCaseSubFolder = Trim(excelInstance.GetCellValue(row, 2))
            TestCaseName = Trim(excelInstance.GetCellValue(row, 3))
            XmlLogPrint "<"&TestCaseName&">"
            Call RunTestCase(TestCasePath&"\"&TestCaseSubFolder&"\"&TestCaseName, TestCaseName)
            XmlLogPrint "</"&TestCaseName&">"
               row = row +1
               IDX = Trim(excelInstance.GetCellValue(row, 1))
         ElseIf StrComp(IDX, "×")=0 Then
               row = row +1
               IDX = Trim(excelInstance.GetCellValue(row, 1))
         Else
            Exit Do
         End If
      Loop While IDX<>""
      XmlLogPrint "</TestCase>"

      qtTest.Close
      Set qtResultsOpt = Nothing ' Release the Run Results Options object
      Set qtTest = Nothing ' Release the Test object
      qtApp.quit
      Set qtApp = Nothing ' Release the Application object
Set excelInstance = nothing
End Function

Function RunTestCase(testCasePath, TestCaseName)
      qtApp.Open testCasePath, False, True  '
      Set qtTest = qtApp.Test

      ' Set folder path
      If qtApp.Folders.Find(projectPath) = -1 Then ' If the folder is not found in the collection
         qtApp.Folders.RemoveAll
         qtApp.Folders.Add(projectPath)
         ' Save setting
         qtApp.Test.Save
      Else
            ' set run settings for the test
            Set qtResultsOpt = CreateObject("QuickTest.RunResultsOptions")
            qtResultsOpt.ResultsLocation = projectPath&"\Result\"&TestCaseName'
            qtTest.Run qtResultsOpt, True
            XmlLogPrint qtTest.LastRunResults.Status
            ErrorXmlPrint()
      End If
End Function

引用删除 Jay-Yang84 / 2009-04-24 16:53:55: Function ImportUtilFun(ImportFolder)
   Set fso = CreateObject("Scripting.FileSystemObject")                                                    'Load all share VBS files under FrameUtil folder
         Set UtilFolder=fso.GetFolder(ImportFolder)
      Set UtilFileCollection=UtilFolder.files
      For each UtilFile in UtilFileCollection
         Include UtilFile.path
      Next
      Set fso = nothing
End Function

Function Include(sInstFile)
Dim fso, f, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(sInstFile)
s = f.ReadAll
f.Close
ExecuteGlobal s
Set fso = nothing
End Function

引用删除 Jay-Yang84 / 2009-04-24 16:53:05: Function getProjectPath()
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objFile = objFSO.GetFile(wscript.scriptfullname)
      getProjectPath = objFSO.GetParentFolderName(objFile)
      Set objFSO = Nothing
      Set objFile = Nothing
End Function

引用删除 Jay-Yang84 / 2009-04-22 17:18:13: Option explicit

Dim strRepository
Set strRepository = CreateObject("Mercury.ObjectRepositoryUtil")

Function InitialRepository(strRepName)
' Find the repository file path
Dim fileSysObj, fileSpec
      Set fileSysObj = CreateObject("Scripting.FileSystemObject")
      fileSpec = Pathfinder.Locate("Repository") & "\" & strRepName
      ' Load the repository and initial the objects.
      If (fileSysObj.FileExists(fileSpec)) Then
         strRepository.Load filespec
         Dim TOCollection
         Set TOCollection = strRepository.GetChildren(Null)
         Call InitialRepStr(TOCollection, "")
         InitialRepository = True
         Report micDone, "InitialRepository", "The repository " & strRepName & " is initialized!"
      Else
         InitialRepository = False
         Report micWarning, "InitialRepository", "The repository file "& strRepName & " doesn't exist!"
         msgbox "The repository file "& strRepName & " doesn't exist!"
      End If
End Function

Sub InitialRepStr(collecName, strParent)
Dim itemNum
itemNum = collecName.Count

' Exit function when there's no children objects.
If Not itemNum  = 0 Then
      Dim itemCount, TestObject, strType, strName, ObjectStr
      ' Loop for all the children objects
      For itemCount = 0 To itemNum - 1
         Set TestObject = collecName.Item(itemCount)
            strType= Trim(TestObject.GetTOProperty("Class Name"))
            strName = strRepository.GetLogicalName(TestObject)
            If 0 = strcomp(strParent, "", 1) Then
                  ObjectStr = strType & "(" & chr(34)  & chr(34) & strName & chr(34)  & chr(34) & ")"
            Else
                  ObjectStr = strParent & "." & strType & "(" & chr(34)  & chr(34) & strName & chr(34)  & chr(34) & ")"
            End If

            On error resume next
            ' Declare a const for the object.
            strName = "Const " & strName & " = " & chr(34) & ObjectStr & chr(34)
            Execute(strName)

            If Err.Number <> 0 Then
                  Report micFail, "InitialRepStr", "The statement is invalid: " & strName
                  ExitActionIteration
            End If
            ' Recur  the children objects of current object.
            Call InitialRepStr(strRepository.GetChildren(TestObject), ObjectStr)
      Next
End If
End Sub

引用删除 Jay-Yang84 / 2009-04-22 17:16:26: Function ImportSheet(ExcelPath, SheetName, Category)
ImportSheet = False
Err.Clear
On Error Resume Next
DataTable.AddSheet SheetName
DataTable.ImportSheet ExcelPath, SheetName, SheetName
If Error.Number = 0 Then
row_count = DataTable.GetSheet(SheetName).GetRowCount

For i = 1 To row_count
If DataTable("Category",SheetName) = Category Then
      DataTable.GetSheet(SheetName).SetRowCount i
      ImportSheet = True
      Exit For
End If
Next
Else
msgbox Err.Description
End If

If ImportSheet = False Then
msgbox "Can not get data table value, please check whether the "&FirstColValue&" feild is existent in "&SheetName &" of "&ExcelPath
End If
End Function

查看全部评论

Jay-Yang84

用户菜单

我的栏目

标题搜索

日历

我的存档

数据统计

访问量: 13880
日志数: 28
书签数: 1
建立时间: 2009-04-02
更新时间: 2010-06-09

终于升级空间了,可以开始写日志了!

用户菜单

我的栏目

标题搜索

日历

我的存档

数据统计

RSS订阅