axd.vbs

realview22.rar

        End If
        if LastTime Then
            Exit Function
        End if
        set MemObj = Nothing
        StartAddress = Unsigned(StartAddress+Range)
        EndAddress   = Unsigned(EndAddress)
    Loop
    
End Function

Function Where(ContextParam)
On Error Resume Next    
    Where = WhereInt(ContextParam)
    DisplayError
End Function
Function WhereInt(ContextParam)
    Dim CurContext, ExprObj, CurImgObj, CurFileObj, CurLineObj, CurAssObj, thisThread
    Dim ContextText, ContextImgText, ContextLineText, curStkObj
    Dim ret, StkObj, lineExist, entrystatus
    Dim ImageName, FileName, LineNum, AssAddress
    Dim NumOfEntry, RequiredIndex
    
    Dim StackEntryList
    set StackEntryList = currentthread.GetStackEntries(0)

    dim size
    size = StackEntryList.count
    if size <= 1 then
        Context(-1)
    Else
        If ContextParam = -1 Then
            set curStkObj = CurrentThread.CurrentStackEntry
            if curStkObj.Handle = 0 then 
                Context(-1)
                Exit Function
            Else
                set StkObj = curStkObj
            End If
        Else
            ret = Parse(ContextParam)
            NumOfEntry = StackEntryList.count
            RequiredIndex = ParseStackIndex(ContextParam, NumOfEntry)
            set StkObj = StackEntryList(RequiredIndex)    
        End If

        If StkObj.PosObjectStatus(PosImgObj) = True Then 
            set CurImgObj = StkObj.Image
            ImageName = CurImgObj.Name
            If StkObj.PosObjectStatus(PosFileObj) = True Then
                set CurFileObj = StkObj.File
                FileName = CurFileObj.Name
                If StkObj.PosObjectStatus(PosLineObj) = True Then
                    set CurLineObj = StkObj.SourceLine
                    LineNum = Chr(124) & (CurLineObj.LineNumber + 1)
                Else
                    LineNum = "N/A"
                End If
            Else
                FileName = "No file information available."
            End If
        Else
            ImageName = "No image"
        End If

        If StkObj.PosObjectStatus(PosAsmObj) = True Then
            set CurAssObj = StkObj.AsmLine
            AssAddress = CurAssObj.FormatAddress
        Else
            AssAddress = "Disassembly not available."
        End If
        
        ContextImgText = "Image:" & Chr(9) & ImageName & Chr(124) & Chr(64) & AssAddress & Chr(13) & Chr(10)
        ContextLineText = "File:" & Chr(9) & FileName & LineNum & Chr(13) & Chr(10)
        
        ContextText = ContextImgText & ContextLineText
        adw3cli.Display(ContextText)
    End If
End Function

Function StackEntries(StackIndex)
On Error Resume Next    
    StackEntries = StackEntriesInt(StackIndex)
    DisplayError
End Function

Function StackEntriesInt(StackIndex)        
    Dim txt
    Dim StackEntryList
    set StackEntryList = currentthread.GetStackEntries(StackIndex) 
    txt = GetStackListText(StackEntryList, StackIndex)
    adw3cli.Display(txt)
End Function

Function GetAllScopeVar(ContextStr, VarScope, fmtKey, fmtStr, scopeFlag, tempStr)
    Dim iter,  tmp
    iter = 0
    do while iter < 3 
        tmp = ContextStr
		If iter = 2 Then
			scopeFlag = FALSE
		End If
        ConVariablesInt tmp, iter, fmtKey, fmtStr, scopeFlag, tempStr
        iter = iter + 1
    Loop
	If scopeFlag = FALSE Then
		adw3cli.Display(tempStr)
	End If
End Function

Function ConVariables(ContextStr, VarScope, fmtKey, fmtStr)
On Error Resume Next
	scopeFlag = FALSE
	tempStr = AddSpace("Name", 24) & AddSpace("Type",14) & "Value" & Chr(13) & Chr(10)
    ConVariables = ConVariablesInt(ContextStr, VarScope, fmtKey, fmtStr, socpeFlag, tempStr)
    DisplayError
End Function

Function ConVariablesInt(ContextStr, VarScope, fmtKey, fmtStr, scopeFlag, tempStr)
    Dim varList, ctxx, currentContext, expr, exprName, ConVariable
	Dim GlobalHeader, LocalHeader, ClassHeader, NoHeader, VarText, columnheader 
	Dim AllScopeFlag
    Dim StackEntryList
    call CheckForImage(-1)
    set currentContext = CurrentThread.CurrentStackEntry
 
    If VarScope = -1 Then
		scopeFlag = TRUE
        GetAllScopeVar ContextStr, VarScope, fmtKey, fmtStr, scopeFlag, tempStr
        Exit Function
    End If
   
    If ContextStr <> -1 Then
        call ContextInt(ContextStr)
    End If
    
    set ConVariable = CurrentThread.ContextVariable
    Select Case VarScope
        Case AxdGlobal
            set varList = ConVariable.GlobalVars
            GlobalHeader = "Global Variables:" & Chr(13) & Chr(10)
			VarText = tempStr & GlobalHeader
			'adw3cli.Display("Global Variables:" & Chr(13) & Chr(10))
        Case AxdLocal
            set varList = ConVariable.LocalVars
            LocalHeader = "Local Variables:" & Chr(13) & Chr(10)
			VarText = tempStr & LocalHeader
			'adw3cli.Display("Local Variables:" & Chr(13) & Chr(10))
        Case AxdClass
            set varList = ConVariable.ClassVars
            ClassHeader = "Class Variables:" & Chr(13) & Chr(10)
			VarText = tempStr & ClassHeader
			'adw3cli.Display("Class Variables:" & Chr(13) & Chr(10))
    End Select

    dim size
    size = varList.count
    If size = 0 Then
        call Restore(currentContext)    'restore old stack  
		NoHeader = "No variable available within this scope." & Chr(13) & Chr(10)
		'VarText = tempStr & NoHeader
		'adw3cli.Display("No variable available within this scope." & Chr(13) & Chr(10))
		tempStr = VarText & NoHeader
        Exit Function
    End If

    'columnheader = AddSpace("Name", 24) & AddSpace("Type",14) & "Value" & Chr(13) & Chr(10)
    'adw3cli.Display(columnheader)
    'VarText = VarText & columnheader

    dim iter, thisvar, ctvarType, tf
    iter = 0
    fmt = GetFormatFromKey(fmtKey)
    If fmtStr = -1 Then
        fmtStr = DefDisplayFormatPar
    End If
    do while iter < size
        set thisvar = varList(iter)
        ctvarName = thisvar.GetName
        tf = FormatValueSimple(thisvar, fmt, fmtStr)
        txt = AddSpace(ctvarName,24) & tf & Chr(13) & Chr(10)
        VarText = VarText & txt
        iter = iter + 1
    Loop
	
	If scopeFlag = False Then
		adw3cli.Display(VarText)
	Else
		tempStr = VarText
    End If

    call Restore(currentContext)        'restore old stack
    
End Function


Function Restore(currentContext)
    If IsNull(currentContext) = True Then
        err.raise 1000, "VBScript", "No stack entry found."
    End If
    CurrentThread.CallStackLocate currentContext.Handle
End Function

Function FormatValueSimple(ByRef ContextObj, fmt, fmtStr)
    Dim ctvarType, TypeString, txt, min
    ctvarType = ContextObj.GetType
    TypeString = TypeValueToName(ctvarType)

    If fmt = -1 Then
        fmt = DefDisplayFormat
    End If
    If fmtStr = -1 Then
        fmtStr = DefDisplayFormatPar
    End If
    
    If ContextObj.IsParent = True and ContextObj.GetSize > 0 Then
        If ContextObj.GetType = &H2000 Then
            FormatValueSimple = AddSpace(TypeString, 14) & ContextObj.Format(fmt, fmtStr)
        Else
            FormatValueSimple = AddSpace(TypeString, 14)
        End If
    Else
        FormatValueSimple = AddSpace(TypeString, 14) & ContextObj.Format(fmt, fmtStr)
    End If
    
End function

Function FormatValue(ByRef ContextObj, fmt, fmtStr)
    Dim ctvarType, TypeString, txt, min
    ctvarType = ContextObj.GetType
    TypeString = TypeValueToName(ctvarType)

    If fmt = -1 Then
        fmt = DefDisplayFormat
    End If
    If fmtStr = -1 Then
        fmtStr = DefDisplayFormatPar
    End If

    If ContextObj.IsParent = True Then
    '
    ' and ContextObj.NumOfChildren > 0 Then
    '
        Dim subList, subSize, subItem, subIter
        set subList = ContextObj.DeReference
        subSize = subList.count
        subIter = 0
        subText = Chr(13) & Chr(10)
        do while subIter < subSize
            set subItem = subList(subIter)
            subName = subItem.GetName
            subType = subItem.GetType
            subValue = subItem.Format(fmt, fmtStr)
            subTypeString = TypeValueToName(subType)
            subText = subText & Chr(9) & AddSpace(subName, 14) & AddSpace(subTypeString, 14) & subValue & Chr(13) & Chr(10)
            subIter = subIter + 1
        Loop
        If ContextObj.GetType = &H2000 Then
            FormatValue = AddSpace(TypeString, 14) & ContextObj.Format(fmt, fmtStr) & subText
        Else
            FormatValue = AddSpace(TypeString, 14) & subText
        End If
    Else
        FormatValue = AddSpace(TypeString, 14) & ContextObj.Format(fmt, fmtStr) & Chr(13) & Chr(10)
    End If
End function

Function Context(StackIndex)                    '<--- CLI command
On Error Resume Next    
    Context = ContextInt(StackIndex)
    DisplayError
End Function

Function ContextInt(StackIndex)
    Dim CurContext, ExprObj, CurImgObj, CurFileObj, CurLineObj, CurAddObj
    Dim ContextText, ContextImgText, ContextLineText
    Dim ret, StkObj, EntryText, lineExist
    Dim ImageName, FileName, LineNum, AssAddress

    If StackIndex = -1 Then
        set CurContext = CurrentThread.Context
        If CurContext.PosObjectStatus(PosImgObj) = True Then 
            set CurImgObj = CurContext.Image
            ImageName = CurImgObj.Name
            If CurContext.PosObjectStatus(PosFileObj) = True Then
                set CurFileObj = CurContext.File
                FileName = CurFileObj.Name
                If CurContext.PosObjectStatus(PosLineObj) = True Then
                    set CurLineObj = CurContext.SourceLine
                    LineNum = Chr(124) & (CurLineObj.LineNumber + 1)
                Else
                    LineNum = "N/A"
                End If
            Else
                FileName = "No file information available."
            End If
        Else
            ImageName = "No image"
        End If

        If CurContext.PosObjectStatus(PosAsmObj) = True Then
            set CurAssObj = CurContext.AsmLine
            AssAddress = CurAssObj.FormatAddress
        Else
            AssAddress = "Disassembly not available."
        End If
        
        ContextImgText = "Image:" & Chr(9) & ImageName & Chr(124) & Chr(64) & AssAddress & Chr(13) & Chr(10)
        ContextLineText = "File:" & Chr(9) & FileName & LineNum & Chr(13) & Chr(10)
        
        ContextText = ContextImgText & ContextLineText
        adw3cli.Display(ContextText)
    Else    
        ret = Parse(StackIndex)
        Dim STackEntryList    
        set StackEntryList = currentthread.GetStackEntries(0) 
        Dim NumOfEntry, RequiredIndex
        NumOfEntry = StackEntryList.count
        RequiredIndex = ParseStackIndex(StackIndex, NumOfEntry)
        set StkObj = StackEntryList(RequiredIndex)
        If IsNull(StkObj) = True Then
            err.raise 1000, "VBScript", "No stack entry found."
        End If
        CurrentThread.CallStackLocate StkObj.Handle
    End If
End Function

Function SetPC(PCAddress)           '<-----  CLI command
On Error Resume Next
    SetPC = SetPCInt(PCAddress)
    DisplayError
End Function

Function SetPCInt(PCAddress)
    Dim NewValue
    NewValue = ExprToAddress(PCAddress)
    CurrentThread.SetPC(NewValue)   
End Function

Function Statistics(StatEntryName)               '<-----  CLI command
On Error Resume Next
    Statistics = StatisticsInt(StatEntryName)
    DisplayError
End Function

Function StatisticsInt(StatEntryName)
    Dim StatList, ListSize
    Dim StatObj
    Dim iter
    iter = 0
    If StatEntryName = -1 Then
        set StatList = session.GetStatistics
        ListSize = StatList.count
        HeaderText = AddSpace("Reference Points", 20) & StatList(0).GetCycleNames & Chr(13) & Chr(10)
        do while iter < ListSize
            set StatObj = StatList(iter)
            EntryName = StatObj.GetEntryName
            EntryValues = StatObj.GetEntryValues

            DisplayText = DisplayText & AddSpace(EntryName, 20) & EntryValues & Chr(13) & Chr(10)
            iter = iter + 1
        Loop
        DisplayText = HeaderText & DisplayText
        adw3cli.Display(DisplayText)
        set StatList = Nothing
    Else
        res = session.AddStatEntry(StatEntryName)
        If res = FALSE Then
            err.raise 1000, "VBScript", "Reference point's name already exists."
        End If
    End If
End Function

Function ClearStat(StatEntryName)                  '<-----  CLI command
On Error Resume Next
    If StatEntryName = "$statistics" Then
        err.raise 1000, "VBScript", "Only user defined statistics reference points can be deleted."
    Else
        ClearStat = ClearStatInt(StatEntryName)
    End If    
    DisplayError
End Function

Function ClearStatInt(StatEntryName)
    Dim StatList
    set StatList = session.GetStatistics
    size = StatList.count
    If size = 0 Or size = 1 Then
        err.raise 1000, "VBScript", "There is no user reference point."
    End If
    res = session.DeleteStatEntry(StatEntryName)
    If res = FALSE Then
        err.raise 1000, "VBScript", "Failed to delete reference point."
    End If

End Function

Function DbgInternals               '<-----  CLI command
On Error Resume Next
    DbgInternals = DbgInternalsInt
    DisplayError
End Function

Function DbgInternalsInt
    Dim DbgInterList, size, iter, thisInter, interText, text
    Dim entryList, entrySize, entryItem, entryIter, entryExpr, entryText, entryValue, entryName
    Dim arrayList, arraySize, arrayItem, arrayIter, arrayExpr
    set DbgInterList = session.GetDbgInternals
    size = DbgInterList.count
    iter = 0
    do while iter < size
        set thisInter = DbgInterList(iter)
        varName = thisInter.GetName
        If varName = "$statistics" Then
            Dim subList, subSize, subItem, subIter, curContext, interExpr
            set interExpr = CurrentThread.CreateEx