空间管理您的位置: 51Testing软件测试网 » 子木清风 » 日志

不要追求绝对的公平，红尘之中没有公平而言，人活一世，难得糊涂。　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　it is no use doing what you like, you have got to like what you do.

SQAUtil.sbl

上一篇 / 下一篇 2007-01-05 16:49:01 / 个人分类：Robot技术

查看( 480 ) / 评论( 0 ) / 评分( 0 / 0 )

'$include "DpConst.sbh"

Declare Function LCSdatapool_open Lib "rtlcs.dll" (ByVal pszDpName$, ByVal dwFlags&) As Long
Declare Function TSSErrorDetail Lib "rttss.dll" (ByVal pszErrText$, dwLen&) As Long
Const SQA_DP_WRAP = &H00000002
Const SQA_DP_NOWRAP = &H00000020
Const SQA_DP_SHARED = &H00000004
Const SQA_DP_PRIVATE = &H00000040

' The last error number returned from the LCSdatapool_position_value and
' LCSdatapool_name_value functions.
Const LCS_LAST_VALUE_ERROR = -3

Declare Function LCSdatapool_position_value Lib "rtlcs.dll" (ByVal dwDpId&, ByVal dwColIndex&) As Long
Declare Function LCSdatapool_name_value Lib "rtlcs.dll" (ByVal dwDpId&, ByVal sColName As String) As Long
Declare Function Dplstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Declare Function Dplstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long

' ----------------------------------------------------------------------------
Const SQA_DIR_RUNFILES         = 1 ' Install Directory

Declare Function UTLGetDir Lib "rtxutil.dll" (ByVal DirType%, ByVal lpszPath$, ByVal cch&) As Integer
Function SQAGetDir (iDirType as Integer) as String
    ' Returns standard directories used by SQA Suite apps
    Dim sDirPath as String, Result as Integer
    sDirPath = Space$(260)
    Result = UTLGetDir(iDirType, sDirPath, 260)
    sDirPath = Left$(sDirPath, InStr(sDirPath,Chr$(0)) - 1)
    If (Right$(sDirPath, 1) <> "\") Then sDirPath = sDirPath + "\"
    SQAGetDir = sDirPath
End Function
' ----------------------------------------------------------------------------
Function SQAGetPropertyNames( objectRec As String, propertyNames() as String) As Integer
    Dim ret%
    Dim sList as Variant
    ret = SQAGetPropertyList( objectRec, sList)
    If ret <> sqaSuccess Then
        SQAGetPropertyNames = ret
        Exit Function
    End If

    Dim cObj%
    cObj = SQAGetListCount( sList )
    ReDim propertyNames( 0 To cObj-1 )

    Dim i%
    Dim vName as Variant
    For i = 0 to cObj-1
        ret = SQAGetListItem( sList, i, vName)
        If ret <> sqaSuccess Then
            SQAGetPropertyNames = ret
            Exit Function
        End If
        propertyNames(i) = vName
    Next i

    SQAGetPropertyNames = sqaSuccess

End Function
' ----------------------------------------------------------------------------
Function SQAGetChildren( objectRec As String, childRec() as String) As Integer
    Dim ret%
    Dim sList as Variant
    Dim parentPrefix as Variant

    ret = SQAGetProperty( objectRec, "FullRecognition", parentPrefix )
    If ret <> sqaSuccess Then
        SQAGetChildren = ret
        Exit Function
    End If
        parentPrefix = parentPrefix + ";\;"

    ret = SQAGetChildList( objectRec, sList)
    If ret <> sqaSuccess Then
        SQAGetChildren = ret
        Exit Function
    End If

    Dim cObj%
    cObj = SQAGetListCount( sList )
    ReDim childRec( 0 To cObj-1 )

    Dim i%
    Dim vName as Variant
    For i = 0 to cObj-1
        ret = SQAGetListItem( sList, i, vName)
        If ret <> sqaSuccess Then
            SQAGetChildren = ret
            Exit Function
        End If
        childRec(i) = parentPrefix + vName
    Next i

    SQAGetChildren = sqaSuccess

End Function
' ----------------------------------------------------------------------------
Function SQAGetPropertyArrayAsString( objectRec As String, propertyName as String, propertyValues() as String) As Integer

    Dim ret%
    Dim val$
    Dim i%, p_sub_i$
    Dim cProp%

    ret = SQAGetPropertyArraySize( objectRec, propertyName, cProp )
    If ret <> sqaSuccess Then
        SQAGetPropertyArrayAsString = ret
        Exit Function
    End If

    ReDim Preserve propertyValues( 0 To cProp-1 )

    For i = 0 to cProp-1
        p_sub_i = propertyName+"("+str(i)+")"

        ret = SQAGetPropertyAsString( objectRec, p_sub_i, val)
        If ret <> sqaSuccess Then
            SQAGetPropertyArrayAsString = ret
            Exit Function
        End If
        propertyValues(i) = val

    Next i

    SQAGetPropertyArrayAsString = sqaSuccess

End Function
' ----------------------------------------------------------------------------
Function SQAGetPropertyArray( objectRec As String, propertyName as String, propertyValues() as Variant) As Integer

    Dim ret%
    Dim val as Variant
    Dim i%, p_sub_i$
    Dim cProp%

    ret = SQAGetPropertyArraySize( objectRec, propertyName, cProp )
    If ret <> sqaSuccess Then
        SQAGetPropertyArray = ret
        Exit Function
    End If

    If cProp>0 then
        ReDim propertyValues( 0 To cProp-1 )
    End if

    For i = 0 to cProp-1
        p_sub_i = propertyName+"("+str(i)+")"

        ret = SQAGetProperty( objectRec, p_sub_i, val)
        If ret <> sqaSuccess Then
            SQAGetPropertyArray = ret
            Exit Function
        End If
        propertyValues(i) = val

    Next i

    SQAGetPropertyArray = sqaSuccess

End Function
' ----------------------------------------------------------------------------
Function SQADatapoolOpen (pszDpName As String, Optional bWrap As Variant, Optional nSequence As Variant, Optional bExclusive As Variant) As Long
    Dim lResult As Long
    Dim dwFlag As Long
    Dim lLength As Long
    Dim sErrText As String

    lResult = sqaDpSuccess
    ' Set the optional parameters to defaults if missing
    If IsMissing(bWrap) = -1 Then
        bWrap = false
    End If
    If IsMissing(nSequence) = -1 Then
        nSequence = SQA_DP_SEQUENTIAL
    End If
    If IsMissing(bExclusive) = -1 Then
        bExclusive = false
    End If

    ' Check if the optional parameter is correct type
    If Not VarType(bWrap) = 2 And Not VarType(bWrap) = 3 Then
        lResult = sqaDpInvalidArgument
    End If
    If Not VarType(nSequence) = 2 And Not VarType(nSequence) = 3 Then
        lResult = sqaDpInvalidArgument
    End If
    If Not VarType(bExclusive) = 2 And Not VarType(bExclusive) = 3 Then
        lResult = sqaDpInvalidArgument
    End If

    If lResult <> sqaSuccess Then
        SQADatapoolOpen = lResult
        Exit Function
    End If

    ' Build the dwFlag
    If bWrap Then
        dwFlag = SQA_DP_WRAP
    Else
        dwFlag = SQA_DP_NOWRAP
    End If

    If nSequence = SQA_DP_RANDOM Then
        dwFlag = dwFlag + SQA_DP_RANDOM
    ElseIf nSequence = SQA_DP_SHUFFLE Then
        dwFlag = dwFlag + SQA_DP_SHUFFLE
    ElseIf nSequence = SQA_DP_SEQUENTIAL Then
        dwFlag = dwFlag + SQA_DP_SEQUENTIAL
    Else
        SQADatapoolOpen = sqaDpInvalidArgument
        Exit Function
    End If

    If bExclusive Then
        dwFlag = dwFlag + SQA_DP_PRIVATE
    Else
        dwFlag = dwFlag + SQA_DP_SHARED
    End If

    lResult = LCSdatapool_open(pszDpName, dwFlag)
    if lResult < 0 Then
        lLength = 160
        sErrText = space(lLength + 1)
        lResult = TSSErrorDetail(sErrText, lLength)
        If lLength > 160 then
            sErrText = space(lLength + 1)
            lResult = TSSErrorDetail(sErrText, lLength)
        End If
        SQAscrīptCmdFailure sErrText
        SQADatapoolOpen = sqaDpFailure
    Else
        SQADatapoolOpen = lResult
    End If

End Function
' ----------------------------------------------------------------------------
Function SQADatapoolValue (dpID As Long, dpCol As Variant, sValue As String) As Long
    Dim lString As Long
    Dim lLength As Long
    Dim lResult As Long

    lString = 0
    lResult = sqaDpSuccess
    If VarType(dpCol) = 2 Or VarType(dpCol) = 3 Then
        lString = LCSdatapool_position_value(dpID, dpCol)
    ElseIf VarType(dpCol) = 8 Then
        lString = LCSdatapool_name_value(dpID, dpCol)
    Else
        SQADatapoolValue = sqaDpInvalidArgument
        Exit Function
    End If

    If (LCS_LAST_VALUE_ERROR <= lString) And (lString <= 0) Then
        sValue = ""
        ' Preserve interesting errors
        If lString <> 0 Then
            SQADatapoolValue = sqaDpFailure
        End If
    Else
        lLength = Dplstrlen(lString)
        sValue = space(lLength + 1)
        Dplstrcpy sValue, lString
        sValue = Left$(sValue, InStr(sValue,Chr$(0)) - 1)
    End If
End Function

'
' Clean String - Cleans out HTML tags
'
Function CleanString(TargetStr As String) As String

Dim NewStr   As String
Dim Position As Integer

    Position = InStr(1, TargetStr, "<")
    If (Position > 1) Then
        CleanString = Mid$(TargetStr, 1, Position-1)
    Else
        CleanString = TargetStr
    End If

End Function

'=================================================================================
' FindAndLogString --
'   Open a file to search and find all occurances of the string. Log the results
'   to the log file and close up when complete.
'=================================================================================
Function FindAndLogString(FileName as String, SearchText As String, LogEntryType As Integer) As Integer

Dim SearchedStr, FoundStr As String
Dim Position As Integer
Dim LineNumber As Long
Dim FileNumber As Integer

On Error GoTo BailOut

    FileNumber = FreeFile
    LineNumber = 0
    Open FileName for Input As #FileNumber

    Do Until EOF(1)
        Input #FileNumber, SearchedStr

    ' Increment the line counter
        LineNumber = LineNumber + 1

    ' Search in the string for the desired text
        Position = InStr(1, SearchedStr, SearchText)
        If (Position <> 0) Then
            FoundStr = Mid$(SearchedStr, Position)
            SQALogMessage LogEntryType, CleanString(FoundStr), "Found at line: " & LineNumber & " in: " & FileName
        End If
    Loop

    Close #FileNumber

Exit Function

BailOut:

    MsgBox "Error " & Err & ": " & Error$
    SQALogMessage SQAFail, Err & ": " & Error$, "File Error"

End Function

' ----------------------------------------------------------------------------
'---------------------------------------------------------------------------------
' SQACreateBaseline() -- Call the install analyzer to create a baseline snapshot
'---------------------------------------------------------------------------------
Function SQAEnvCreateBaseline(fileName as String) As Integer

    Dim FullPath, CommandStr as String
    Dim ToolRoot, LogRoot As String
    Dim Result as Integer

' Get the target directories
    ToolRoot = SQAGetDir(SQA_DIR_RUNFILES)
    LogRoot = SQAGetLogDir

    SQAEnvCreateBaseline = 0

    FullPath = LogRoot & "Results\" & fileName & ".ans"
    CommandStr = ToolRoot & "Analyzer /nologo /bc:" & fileName & " /res:" & LogRoot & "Results\"

On Error Resume Next
    Kill FullPath

' Turn off logging, there's no need to see the file VP in the final log file
    SQASuspendLogOutput

' Execute the command
    Shell CommandStr, 1

    FullPath = "Name=" & FullPath
    Result = FileVP(Exists, FullPath, "VP=Baseline Analyzer File;ExpectedResult=PASS;Wait=10,1200")

' Turn the logfile back on
    SQAResumeLogOutput

' Grab and close the Analyzer Window
    Window SetContext, "Caption={VeriTest-Rational Install Analyzer - *}", ""
    Window CloseWin, "", ""

    SQAEnvCreateBaseline = Result

End Function

'-------------------------------------------------------------------------------
' SQAEnvCreateCurrent() -- Call the install analyzer to create a current snapshot
'-------------------------------------------------------------------------------
Function SQAEnvCreateCurrent(fileName as String) As Integer
    Dim FullPath, CommandStr as String
    Dim ToolRoot, LogRoot As String
    Dim Result as Integer

' Get the target directories
    ToolRoot = SQAGetDir(SQA_DIR_RUNFILES)
    LogRoot = SQAGetLogDir

    SQAEnvCreateCurrent = 0

    FullPath = LogRoot & "Results\" & fileName & ".ans"
    CommandStr = ToolRoot & "Analyzer /nologo /cc:" & fileName & " /res:" & LogRoot & "Results\"

On Error Resume Next
    Kill FullPath

' Turn off logging, there's no need to see the file VP in the final log file
    SQASuspendLogOutput

' Execute the Command
    Shell CommandStr, 1

    FullPath = "Name=" & FullPath
    Result = FileVP(Exists, FullPath, "VP=Current Analyzer File;ExpectedResult=PASS;Wait=10,1200")

' Turn the logfile back on
    SQAResumeLogOutput

' Grab and close the Analyzer Window
    Window SetContext, "Caption={VeriTest-Rational Install Analyzer - *}", ""
    Window CloseWin, "", ""

    SQAEnvCreateCurrent = Result

End Function

'-------------------------------------------------------------------------------
' SQAEnvCreateDelta() -- Call the install analyzer to create a current delta report
'-------------------------------------------------------------------------------
Function SQAEnvCreateDelta(Baseline as String, Current as String, ShowReport As Integer) As Integer

    Dim FullPath, CommandStr, ErrorPath,SearchedStr, FoundStr As String
    Dim Position As Integer
    Dim ToolRoot, LogRoot As String
    Dim Result as Integer

    SQAEnvCreateDelta = 0

' Get the target directories
    ToolRoot = SQAGetDir(SQA_DIR_RUNFILES)
    LogRoot = SQAGetLogDir

    FullPath = LogRoot & "Results\" & Current & " - " & Baseline & ".htm"
    CommandStr = ToolRoot & "Analyzer /g /nologo /bl:" & Baseline & " /cl:" & Current

'
' PHJ - 17-Jan-2000
' Commented out and moved the ShowReport functionality to the bottom
'    If( ShowReport = 0 ) Then
'        CommandStr = ToolRoot & "Analyzer /g /nologo /bl:" & Baseline & " /cl:" & Current & " /res:" & LogRoot & "Results\"
'    Else
'        CommandStr = ToolRoot & "Analyzer /gu /nologo /bl:" & Baseline & " /cl:" & Current & " /res:" & LogRoot & "Results\"
'    End If

On Error Resume Next
    Kill FullPath

' Turn off logging, there's no need to see the file VP in the final log file
    SQASuspendLogOutput

' Generate the Deltas and wait for the file to be available
    Shell CommandStr, 1
    CommandStr = "Name=" & FullPath
    Result = FileVP(Exists, CommandStr, "VP=Create Delta Report;ExpectedResult=PASS;Wait=10,1200")

' Turn the logfile back on
    SQAResumeLogOutput

' Grab and close the Analyzer Window
    Window SetContext, "Caption={VeriTest-Rational Install Analyzer - *}", ""
    Window CloseWin, "", ""

' Grep for Changes in the delta file -- Grep needs quotes around filenames with spaces
   FullPath = LogRoot & ".\Results\" & Current & " - " & Baseline & ".htm"

   FindAndLogString FullPath, "WARNING", SQAWarning
   FindAndLogString FullPath, "ERROR",   SQAFail
   FindAndLogString FullPath, "INFO",    SQANone

'
' PHJ - 17-Jan-2000
' If the ShowReport flag is thrown, start a browser with the new file
'
   If( ShowReport = 1 ) THen
        StartBrowser FullPath, ""
   End If

    SQAEnvCreateDelta = Result

Exit Function

CatchError:

    MsgBox "Error " & Err & ": " & Error$
    SQALogMessage SQAFail, Err & ": " & Error$, "File Error"

End Function

用户菜单

我的栏目

标题搜索

日历

数据统计

访问量: 289442
日志数: 261
图片数: 5
文件数: 20
书签数: 5
建立时间: 2006-12-06
更新时间: 2011-08-31

SQAUtil.sbl

相关阅读:

用户菜单

我的栏目

标题搜索

日历

我的存档

数据统计

RSS订阅