The Hammer » VDF Splat

//TH-Header

//*****************************************************************************************

// Copyright (c)  2013 Antwise Solutions

// All rights reserved.

//

// $FileName    : VdfSplat.src

// $ProjectName : Splat ! Vdf Debugger

// $Authors     : Wil van Antwerpen

// $Created     : 12.14.2013  23:42

// $Type        : GPLv2

//

// Contents:

//

//*****************************************************************************************

//TH-RevisionStart

//TH-RevisionEnd

Use DFAllEnt.pkg

Use cToolTipController.pkg

Use cDebugCJCommandBarSystem.pkg

Use vWin32fh.pkg

Use seq_chnl.pkg

Use cSplatApplication.pkg

Use cSplatPanel.pkg

Object oHtmlHelp is a cHtmlHelp

End_Object

Object oApplication is a cSplatApplication

    Set peHelpType to htHtmlHelp

    Set psAutoOpenWorkspace to "" // We're not using data files, the exe has to be completely self contained.

End_Object

Object oToolTipController is a cToolTipController

    Move Self to ghoToolTipController

End_Object

Use oEditContextMenu.pkg

Use oDEOEditContextMenu.pkg

#IF (1=0)

// This imagelist is a dummy, it is only used to have the Studio recognize

// which bitmaps are used in the application so that a "Scan Bitmaps" will always

// include the bitmaps as embedded resource. The imagelist itself is not used.

Object ImageContainer is a cImageList32

  Set piMaxImages to 10

  Procedure OnCreate

    Integer iImage

    Get AddImage "Debugger.bmp/t" to iImage

  End_Procedure

End_Object

#ENDIF

Object oMain is a cSplatPanel

    Set Label to "VdfSplat"

    Set Location to 4 3

    Set Size to 300 450

    // Make sure it can be used here already

    Use cDebuggerEngine.pkg

    Object oOpenProgramDialog is an OpenDialog

        Set Filter_String  to  'Visual DataFlex Executables|*.exe'

        Set Initial_Folder to 'C:\Program Files\Visual DataFlex'

//        Set MultiSelect_State  To False

        Set NoChangeDir_State  To True  // don't touch my current folder

        Set CreatePrompt_State To False

        Set HideReadOnly_State To True

        Set Filter_Index to 2

    End_Object

    Object oOpenSourceFileDialog is an OpenDialog

        Set Filter_String  to  'Visual DataFlex source|*.*'

//        Set Initial_Folder to 'C:\Program Files\Visual DataFlex'

//        Set MultiSelect_State  To False

        Set NoChangeDir_State  To True  // don't touch my current folder

        Set CreatePrompt_State To False

        Set HideReadOnly_State To True

        Set Filter_Index to 2

    End_Object

    Procedure Warning_Box String sMessage String sCaption

      Integer eResponse

      Get Message_Box sMessage sCaption MB_OK MB_ICONWARNING to eResponse

    End_Procedure // Warning_Box

    Procedure Fishy_Box String sMessage String sDebugfile

      Send Warning_Box ("Sorry but the debug file for the executable you choose\n\n"+;

           sDebugfile+"\ndoesn't look like it is valid.\n\n"+sMessage+"\n\nPlease try again.") ;

           "VdfSplat thinks this is fishy"

    End_Procedure // Fishy_Box

    //

    // Reads the runtime version of the .dbg file passed.

    // The file must exist.

    //

    Function ReadRuntimeVersion String sDebugFile Returns Integer

      Integer iRuntime

      Integer iChIn

      Integer iFileSize

      Integer iVdfMax

      Integer iVdfMin

      String  sBinary

      Move 0 To iRuntime

      Get vWin32_APIFileSize sDebugFile to iFileSize

      If (iFileSize > 40000) Begin

        Get Seq_Open_Input_Channel sDebugfile to iChIn

        Direct_Input channel iChIn ("binary:" + sDebugfile)

            Read_Block channel iChIn sBinary 50

        Send Seq_Close_Channel iChIn

        If (Left(sBinary,4)="VDFB") Begin

          Move (Ascii(Mid(sBinary,1,5))) To iVdfMax

          Move (Ascii(Mid(sBinary,1,9))) To iVdfMin

          If ((iVdfMax>2 and iVdfMax < 26) and (iVdfMin<5)) Begin

            Move ((iVdfMax*10)+iVdfMin) To iRuntime

          End

          Else Begin

            Send Fishy_Box ("The debug file suggests this is VDF version"*trim(iVdfMax)+"."+trim(iVdfMin)+"\nNot very likely that.") sDebugfile

          End

        End

        Else Begin

          Send Fishy_Box "The debug file signature is not correct." sDebugfile

       End

      End

      Else Begin

        Send Fishy_Box "It is wayyy too small." sDebugfile

      End

      Function_Return iRuntime

    End_Function // ReadRuntimeVersion

    Procedure doOpenFile

      Handle  hoDebug

      Handle  hoEditor

      Handle  hoDialog

      Boolean bOpen

      Boolean bIsValid

      String  sFileName

      Get phoDebugger to hoDebug

      If (hoDebug) Begin

        Move (oOpenSourceFileDialog(Self)) To hoDialog

        Get Show_Dialog of hoDialog to bOpen

        If bOpen Begin

          Get File_Name of hoDialog To sFileName

          Get ComIsValidSourceFile of hoDebug sFileName To bIsValid

          If (bIsValid) Begin

            Get phoEditor to hoEditor

            If (hoEditor) Begin

              Send DoOpenSourceFile of hoEditor sFileName

            End

          End

          Else Begin

            Send Info_Box "source file is not part of selected program we are currently debugging."

          End

        End

      End

    End_Procedure // doOpenFile

    Procedure doDebugRun

      String  sApplication

      String  sExt

      String  sDebugfile

      Integer iRuntime

      Boolean bOpen

      Boolean bExists

      Handle  hoDebug

      Handle  hoParent

      Handle  hoDialog

      Set piDebugfileVersion To 0

      Get psApplication of ghoApplication To sApplication

      If (sApplication = "") Begin

        Move (oOpenProgramDialog(Self)) To hoDialog

          Get Show_Dialog of hoDialog to bOpen

          If bOpen Begin

            Get File_Name of hoDialog To sApplication

            // Don't tell me when I selected a file, just do it.

            //Send Info_Box ("Selected file " + sApplication)

          End

          Else Send Info_Box "You did not choose a file, nothing to debug."

      End

      If (sApplication="") Begin

        // Oh still no app? Use our hardcoded path

        Procedure_Return

      End

      Get ParseFileExtension sApplication To sExt

      Move (Replace("."+sExt,sApplication,".dbg")) To sDebugfile

      Get vFilePathExists sDebugfile to bExists

      If (bExists=false) Begin

        Send Warning_Box ("Sorry but for the executable chosing the corresponding debug file\n"+;

               sDebugfile+"\ncould not be located.\n\nPlease select again.") ;

               "VdfSplat can't do that"

      End

      Else Begin

        Get ReadRuntimeVersion sDebugfile To iRuntime

        If (iRuntime=0) Begin

          Move False To bExists

        End

      End

      Get phoDebugger to hoDebug

      If (bExists and hoDebug=0) Begin

        //

        Get phoDebuggerHost To hoParent

        Set piDebugfileVersion To iRuntime

        Get Create Of hoParent U_cDebuggerEngine To hoDebug

        If (hoDebug) Begin

          Send DoCreateEngine of hoDebug

        End

      End

      If (bExists and hoDebug<>0) Begin

        Set psApplication of ghoApplication To sApplication

        Set ApplicationFileName of hoDebug To sApplication

        // ??

        Send DoSetCaptionLabel Of (oVdfDbg(oClientArea(Self))) sApplication

        Send DoStartDebug

      End

    End_Procedure // doDebugRun

    Procedure DoStartDebug

      String  sApplication

      Integer iRuntime

      Handle  hoDebug

      Get phoDebugger to hoDebug

      If (hoDebug<>0) Begin

        Get psApplication Of ghoApplication To sApplication

        Get piDebugfileVersion To iRuntime

        //Send ComPause of hoDebug

        //Procedure ComStartProgram String llcmdLine Variant llwebApp Variant llurl

        If (iRuntime<181) Begin

          Send ComStartProgram of hoDebug sApplication false ""

        End

        Else Begin                         // noheap or heap? that's' the question.

          Send ComStartProgram181 of hoDebug sApplication True false ""

        End

        Send ComUpdateViews Of hoDebug

      End

    End_Procedure

    Procedure doStopDebug

      Handle hoDebug

      Get phoDebugger to hoDebug

      If (hoDebug) Begin

        Send ComStopProgram of hoDebug

        Send ComUpdateViews Of hoDebug

        Set psApplication of ghoApplication To ""

      End

    End_Procedure // doStopDebug

    Procedure doDebugPause

      Handle hoDebug

      Get phoDebugger to hoDebug

      If (hoDebug) Begin

        Send ComPause of hoDebug

        Send ComUpdateViews Of hoDebug

      End

    End_Procedure // doDebugPause

    Procedure doDebugContinue

      Handle hoDebug

      Get phoDebugger to hoDebug

      If (hoDebug) Begin

        Send ComContinue of hoDebug

        Send ComUpdateViews Of hoDebug

      End

    End_Procedure // doDebugContinue

    Procedure doDebugStepOver

      Handle hoDebug

      Get phoDebugger to hoDebug

      If (hoDebug) Begin

        Send ComStepOver of hoDebug

        Send ComUpdateViews Of hoDebug

      End

    End_Procedure // doDebugStepOver

    Procedure doDebugStepInto

      Handle hoDebug

      Get phoDebugger to hoDebug

      If (hoDebug) Begin

        Send ComStepInto of hoDebug

        Send ComUpdateViews Of hoDebug

      End

    End_Procedure // doDebugStepInto

    Procedure doDebugStepOut

      Handle hoDebug

      Get phoDebugger to hoDebug

      If (hoDebug) Begin

        Send ComStepOut of hoDebug

        Send ComUpdateViews Of hoDebug

      End

    End_Procedure // doDebugStepOut

    Procedure doSetBreakPoint

      Integer iLine

      String  sFileName

      Boolean bSuccess

      Handle  hoDebugger

      Handle  hoEditor

      Get phoDebugger to hoDebugger

      Get phoEditor   To hoEditor

      If (hoDebugger<>0 and hoEditor<>0) begin

        Get psFileName    Of hoEditor To sFileName

        Get CurrentLine   Of hoEditor To iLine

        If (sFileName<>"" and iLine<>0) Begin

          Get SetBreakPoint of hoDebugger sFileName (&iLine) To bSuccess

          If (bSuccess=false) Begin

            Send info_box ("Set breakpoint at line"*trim(iLine)*"Failed.\nReturned="*trim(bSuccess))

          End

          //Send ComSetMarginImages iLine 1

        End

      End

    End_Procedure

    Procedure doRemoveBreakPoint

      Integer iLine

      String  sFileName

      Boolean bSuccess

      Handle  hoDebugger

      Handle  hoEditor

      Get phoDebugger to hoDebugger

      Get phoEditor   To hoEditor

      If (hoDebugger<>0 and hoEditor<>0) begin

        Get psFileName    Of hoEditor To sFileName

        Get CurrentLine   Of hoEditor To iLine

        If (sFileName<>"" and iLine<>0) Begin

          Get RemoveBreakPoint of hoDebugger sFileName (&iLine) To bSuccess

          If (bSuccess=false) Begin

            Send info_box ("Removing breakpoint at line"*trim(iLine)*"Failed.\nReturned="*trim(bSuccess))

          End

          //Send ComSetMarginImages iLine 1

        End

      End

    End_Procedure

    //

    //Procedure doCreateCallStack

    //  Boolean bCreated

    //  Handle  hoCallStack

    //

    //

    //  Get phoCallStack To hoCallStack

    //  If (hoCallStack) Begin

    //    Send CreateComObject of hoCallStack

    //    Get IsComObjectCreated Of hoCallStack To bCreated

    //    Showln "callstack [" bCreated "]"

    //    If (bCreated) Begin

    //      Send RegisterComEvents Of hoCallStack

    //      //Set ComWindowType Of hoGlobals To 1 // global

    //    End

    //  End

    //End_Procedure // doCreateCallStack

    Function HasProgramStarted Returns Boolean

      Boolean bStarted

      Handle  hoDebugger

      Move False To bStarted

      Get phoDebugger To hoDebugger

      If (hoDebugger) Begin

        Get pbProgramStarted of hoDebugger To bStarted

      End

      Function_Return bStarted

    End_Function // HasProgramStarted

    //

    // A program can only be paused after it has started

    // This is used as an indication that we can step through the source

    //

    Function HasProgramPaused Returns Boolean

      Boolean bPaused

      Boolean bStarted

      Handle  hoDebugger

      Move False To bPaused

      Get HasProgramStarted To bStarted

      If (bStarted) Begin

        Get phoDebugger To hoDebugger

        If (hoDebugger) Begin

          Get pbProgramPaused of hoDebugger to bPaused

        End

      End

      Function_Return bPaused

    End_Function // HasProgramPaused

    //

    // A breakpoint can only be removed if we have existing breakpoints

    //

    Function HasBreakpoints Returns Boolean

      Boolean bHasBreakPoints

      Boolean bStarted

      Handle  hoDebugger

      Move False To bHasBreakPoints

      Get HasProgramStarted To bStarted

      If (bStarted) Begin

        Get phoDebugger To hoDebugger

        If (hoDebugger) Begin

          Get HasBreakPoints of hoDebugger to bHasBreakPoints

        End

      End

      Function_Return bHasBreakPoints

    End_Function // HasBreakPoints

    Object oCommandBarSystem is a cDebugCJCommandBarSystem

        Procedure OnCreateCommandBars

            Handle hoOptions

            Get OptionsObject to hoOptions

            Forward Send OnCreateCommandBars

        End_Procedure

        Object oMenuBar is a cCJMenuBar

            Object oFileMenu is a cCJMenuItem

                Set peControlType to xtpControlPopup

                Set psCaption   to "&File"

                Set psDescription to "Find, Save, Delete, Clear information or quit this application."

                Set psCategory to "Menus"

                Object oClearMenuItem is a cCJClearMenuItem

                    Set pbAddToDesignerMenu to True

                End_Object

                Object oClearAllMenu is a cCJClearAllMenuItem

                    Set pbAddToDesignerMenu to True

                End_Object

                Object oPromptMenuItem is a cCJPromptMenuItem

                    Set pbAddToDesignerMenu to True

                    Set pbControlBeginGroup to True

                End_Object

                Object oCJDebugPauseMenuItem is a cCJDebugPauseMenuItem

                    Set pbAddToDesignerMenu to True

                    Set pbControlBeginGroup to True

                End_Object

                Object oFindNextMenu is a cCJFindNextMenuItem

                    Set pbAddToDesignerMenu to True

                End_Object

                Object oFindPreviousMenu is a cCJFindPreviousMenuItem

                    Set pbAddToDesignerMenu to True

                End_Object

                Object oFindFirstMenu is a cCJFindFirstMenuItem

                    Set pbAddToDesignerMenu to True

                End_Object

                Object oFindLastMenu is a cCJFindLastMenuItem

                    Set pbAddToDesignerMenu to True

                End_Object

                Object oSaveMenuItem is a cCJSaveMenuItem

                    Set pbAddToDesignerMenu to True

                    Set pbControlBeginGroup to True

                End_Object

                Object oDeleteMenuItem is a cCJDeleteMenuItem

                    Set pbAddToDesignerMenu to True

                End_Object

                Object oExitMenu is a cCJExitMenuItem

                    Set pbControlBeginGroup to True

                End_Object

            End_Object

            Object oViewMenu is a cCJMenuItem

                Set peControlType to xtpControlPopup

                Set psCaption to "&View"

                Set psToolTip to "View"

                Set psDescription to "Available Views"

                Object ooVdfdbgMenuItem is a cCJMenuItem

                  Set psCaption to "Debugger View"

                  Set psTooltip to "The debugger main view"

                  Procedure OnExecute Variant vCommandBarControl

                    Handle hoClient

                    Get Client_Id to hoClient

                    Send Activate_oVdfdbg of hoClient

                  End_Procedure

                End_Object

                Object oObjectInspectorMenuItem is a cCJMenuItem

                  Set psCaption to "Object Inspector     Ctrl+L"

                  Set psTooltip to "Inspect the objects in the running program"

                  Procedure OnExecute Variant vCommandBarControl

                    Handle hoClient

                    Get Client_Id to hoClient

                    Send doActivateObjectInspectorPanel of hoClient

                  End_Procedure

                  Function IsEnabled Returns Boolean

                    Boolean bPaused

                    Get HasProgramPaused To bPaused

                    Function_Return bPaused

                  End_Function

                End_Object

            End_Object

            Object oNavigateMenu is a cCJMenuItem

                Set peControlType to xtpControlPopup

                Set psCaption to "&Navigate"

                Set psTooltip to "Navigate"

                Set psDescription to "Move to different areas of the application"

                Object oNextAreaMenu is a cCJNextAreaMenu

                End_Object

                Object oPriorAreaMenu is a cCJPriorAreaMenu

                End_Object

                Object oNextViewMenu is a cCJNextViewMenu

                End_Object

                Object oPriorViewMenu is a cCJPriorViewMenu

                End_Object

                Object oPromptMenu is a cCJPromptMenuItem

                    Set pbControlBeginGroup to True

                End_Object

                Object oZoomMenu is a cCJZoomMenuItem

                End_Object

            End_Object

            Object oWindowMenu is a cCJMDIWindowsMenuItem

                Set peControlType to xtpControlPopup

                Set psCaption to "&Window"

                Set psToolTip to "Window"

                Set psDescription to "Display Current Views and set other display options."

                // These are the static windows items. More will be created in onInitPopup

                Object oDisplayOptionsMenu is a cCJMenuItem

                    Set peControlType to xtpControlPopup

                    Set psCaption to "&Display Options"

                    Set psToolTip to "Display Options"

                    Set psDescription to "Set display options"

                    Object oStatusbarMenu is a cCJStatusbarMenuItem

                    End_Object

                    Object oAutoArrangeIconsMenu is a cCJAutoArrangeIconsMenuItem

                    End_Object

                    Object oRestoreMenusMenu is a cCJRestoreMenusMenuItem

                        Set pbControlBeginGroup to True

                    End_Object

                End_Object

                Object oCascadeMenu is a cCJCascadeMenuItem

                    Set pbControlBeginGroup to True

                End_Object

                Object oHorizTile is a cCJTileHorizontally

                End_Object

                Object oVertTile is a cCJTileVertically

                End_Object

                Object oMinimizeMenuItem is a cCJMinimizeWindowsMenuItem

                    Set pbControlBeginGroup to True

                End_Object

                Object oRestoreMenuItem is a cCJRestoreWindowsMenuItem

                End_Object

                Object oArrangeIconsMenuItem is a cCJAutoArrangeIconsMenuItem

                    Set pbControlBeginGroup to True

                End_Object

            End_Object

            Object oHelpMenu is a cCJMenuItem

                Set peControlType to xtpControlPopup

                Set psCaption to "&Help"

                Set psDescription to "Access Information for learning and using this DataFlex application."

                Set psToolTip to "Help"

                Object oHelpMenuItem is a cCJHelpMenuItem

                End_Object

                Object oAboutMenuItem is a cCJAboutMenuItem

                End_Object

            End_Object

        End_Object

        Object oDebugToolBar is a cCJToolbar

            Set psTitle to "Debugging Toolbar"

            Object oStartDebugButton is a cCJStartDebugMenuItem

            End_Object

            Object oStopDebugButton is a cCJStopDebugMenuItem

            End_Object

            Object oRestartDebugButton is a cCJRestartDebugMenuItem

            End_Object

            Object oDebugPauseButton is a cCJDebugPauseMenuItem

            End_Object

            Object oDebugContinueButton is a cCJDebugContinueMenuItem

            End_Object

            Object oDebugStepOverButton is a cCJStepOverMenuItem

            End_Object

            Object oDebugStepIntoButton is a cCJStepIntoMenuItem

            End_Object

            Object oDebugStepOutButton is a cCJStepOutMenuItem

            End_Object

            //

            Object oPromptToolItem is a cCJPromptMenuItem

                Set pbControlBeginGroup to True

            End_Object

        End_Object

        Object oFileToolbar is a cCJToolbar

            Set psTitle To "Open Source Toolbar"

            Object oFileOpen is a cCJOpenFileMenuItem

            End_Object

        End_Object

        Object oBreakPointToolBar is a cCJToolbar

            Set psTitle to "Breakpoint Toolbar"

            Object oAddBreakpointButton is a cCJAddBreakpointMenuItem

            End_Object

            Object oRemoveBreakpointButton is a cCJRemoveBreakpointMenuItem

            End_Object

        End_Object

        Object oEditToolBar is a cCJToolbar

            Set psTitle to "Edit Toolbar"

            Object oCutToolbarItem is a cCJCutMenuItem

            End_Object

            Object oCopyToolbarItem is a cCJCopyMenuItem

            End_Object

            Object oPasteToolbarItem is a cCJPasteMenuItem

            End_Object

            Object oDeleteEditToolbarItem is a cCJDeleteEditMenuItem

                Set pbControlBeginGroup to True

            End_Object

        End_Object

        Object oStatusBar is a cCJStatusBar

            Object oStatusPane1 is a cCJStatusBarPane

                Set piID to sbpIDIdlePane

                Set pbStyleStretch to True

                Set psText To ""

            End_Object

            Object oStatusPane2 is a cCJStatusBarPane

                Set phoViewPane to Self

                Set pbStyleStretch to True

                Set psText To ""

            End_Object

            Object oStatusPane3 is a cCJStatusBarPane

                Set pbStyleStretch to True

                Set psText To "testing 888"

            End_Object

            Function EditorHandle Returns Handle

              Handle  hoEditor

              Boolean bIsCreated

              Get phoEditor To hoEditor

              If (hoEditor) Begin

                Get IsComObjectCreated Of hoEditor To bIsCreated

                If (bIsCreated=false) Begin

                  Move 0 To hoEditor

                End

              End

              Function_Return hoEditor

            End_Function

            Function EditorCurrentLine Returns Integer

              Handle  hoEditor

              Integer iCount

              Get EditorHandle To hoEditor

              If (hoEditor) Begin

                Get CurrentLine Of hoEditor To iCount

              End

              Function_Return iCount

            End_Function // EditorCurrentLine

            Function EditorLineCount Returns Integer

              Handle  hoEditor

              Integer iCount

              Get EditorHandle To hoEditor

              If (hoEditor) Begin

                Get ComLineCount Of hoEditor To iCount

              End

              Function_Return iCount

            End_Function // EditorLineCount

            Procedure Show_Status_Help String sStatusHelp

              Integer iLine

              Handle  hoEditor

              String  sFileName

              Move "" To sFileName

              Get EditorHandle To hoEditor

              If (hoEditor) Begin

                Get psFileName of hoEditor To sFileName

              End

              Get EditorCurrentLine To iLine

              Set psText Of oStatusPane1 To ("Line: "+trim(iLine))

              Set psText Of oStatusPane2 To ("File: "+sFileName)

            End_Procedure

        End_Object

    End_Object

    Object oClientArea is a ClientArea

        Use StdAbout.pkg

        Use ObjectInspector.dg

        Use Vdfdbg.vw

        Procedure doActivateObjectInspectorPanel

          Send StartObjectInspector

        End_Procedure

        Procedure Activate_About

          String sTitle sCopyright sVersion sBitmap sAuthor

          //    string sVal sVal2 sVal3

          //    move (SysConf(sysconf_os_name)) to sVal

          //    send Info_box sVal "Os Name"

          //    move (SysConf(sysconf_os_short_name)) to sVal2

          //    send Info_box sVal2 "os short name"

          //    move (SysConf(sysconf_os_major_rev)) to sVal3

          //    send Info_Box sVal3 "os major revision"

          //    //

          Move "VdfSplat" to sTitle

          Move "Alfa 1" to sVersion

          Move "Copyright 2015, GPL v2, Antwise Solutions" to sCopyright

          Move "Author: Wil van Antwerpen"  to sAuthor

          Move "Debugger.bmp/t" to sBitMap

          Send DoAbout sTitle sVersion sCopyright sAuthor sBitMap

        End_Procedure

    End_Object

End_Object

Procedure StartDebugging

  String sApplication

  Handle hoClient

  Get Client_Id Of oMain To hoClient

  If (hoClient) Begin

    Send Activate_oVdfdbg of hoClient

    Get psApplication of ghoApplication to sApplication

    If (sApplication<>"") Begin

      Send doDebugRun of hoClient

    End

  End

End_Procedure

Send StartDebugging

Start_UI