2010-12-07 21:18

'******************************************************************************
' File: RapidDBG.bas - part of RapidDBG, a RapidQ source-line debugger.
' Copyright (C) 2008-2010 D Homans
'
'    RapidDBG is free software: you can redistribute it and/or modify
'    it under the terms of the GNU General Public License as published by
'    the Free Software Foundation, either version 3 of the License, or
'    (at your option) any later version.
'
'    RapidDBG is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU General Public License for more details.
'
'    You should have received a copy of the GNU General Public License
'    along with RapidDBG.  If not, see <http://www.gnu.org/licenses/>.
'
'******************************************************************************
'-------------------------------------------------------------------------------------------
'  PROJECT: RapidDBG
'      FILE RapidDBG.bas: A small GUI wrapper that controls the generation
'           of a temporary debug+src executable and starts the debugging process.
'      FILE fbDBGParser.fbb: A FreeBasic dll that parses the user src file,
'           adding debug information, into a temporary debug+src RapidQ source file.
'      FILE RapidDBG.dat: The main GUI wrapper and logic (when running the debugger),
'           added to the temporary debug+src RapidQ source file by the parser.
'      FILE RapidDBG.bmp: default toolbar bitmap.
'      FILE RapidDBG.ico: default project icon.
'      FILE README.txt: Some helpful information.
'
'    AUTHOR: d_homans@yahoo.com.au
'   VERSION: v1.37 (defined in fbDBGParser.fbb)
'      DATE: 28 August 2010
'------------------------------------------------------------------------------------------

     $APPTYPE GUI
     $TYPECHECK ON
     $OPTION ICON "RapidDBG.ico"                                         ' Using the RapidQ icon

     $INCLUDE "Rapidq2.inc"

     $DEFINE TIDY_TEMP_FILES                                             ' Comment out to leave temp files behind

     $DEFINE COMP_ONLY 1                                                 ' -c/-C  Test (compile) input file - display result
     $DEFINE RUN_USER 2                                                  ' -r/-R  Compile and run input file
     $DEFINE RUN_DEBUG 3                                                 ' -d/-D  Add debug code, compile then run the debugger

     CONST CRLF=CHR$(13)+CHR$(10)
     CONST QU=CHR$(34)

     $RESOURCE DebugData AS "RapidDBG.dat"                               ' |
     $RESOURCE ProgIcon AS "RapidDBG.ico"                                ' | Order here important for code below
     $RESOURCE ButnPics AS "RapidDBG.bmp"                                ' |

     DECLARE FUNCTION WaitOnCompile LIB "kernel32" ALIAS "WaitForSingleObject" (hHandle AS LONG, _
      dwMilliseconds AS LONG) AS LONG

     DECLARE FUNCTION fbParserVersion LIB "fbDBGParser" ALIAS "fbParserVersion@4" (lpRetString AS LONG) AS INTEGER
     DECLARE FUNCTION fbParseFile LIB "fbDBGParser" ALIAS "fbParseFile@20" (lpSrcFile AS LONG, _
      lpDataFile AS LONG, lpInitData AS LONG, lpRetString AS LONG, buflen AS INTEGER) AS INTEGER


     DECLARE SUB DbgNoClose(Action AS INTEGER)
     DECLARE FUNCTION TRIM$(srcLine AS STRING) AS STRING
' Initialise fns
     DECLARE SUB Initialise                                              ' Some init stuff
     DECLARE SUB GetEnvironment                                          ' User input -> Paths to rc.exe etc....
     DECLARE SUB LoadEnvironment                                         ' ....or Load pre-set paths
' GP subs/fns
     DECLARE SUB KillDebugEXE
     DECLARE SUB DbgError(ErrNum AS INTEGER)
     DECLARE SUB GotResponse(Sender AS QBUTTON)
     DECLARE SUB WaitResponse(msg AS STRING, msgType AS INTEGER)
' In-line steps to debug a file
     DECLARE SUB TestUserSource                                          ' Ensure user source file compiles ok!
     DECLARE SUB CreateDbgTarget
     DECLARE SUB CreateDbgExe                                            ' Compile to final exe with debug code
     DECLARE SUB RunDbgExe                                               ' Run final exe and terminate

' Global data
     DEFSTR VERSION                                                      ' Obtained from fbDBGParser.dll

     DEFINT CommandParm                                                  ' Command-line parameter
     DEFSTR rcPath                                                       ' Our environ variables....
     DEFSTR incPath                                                      ' ... note:  no "\" terminator
     DEFSTR libPath
     DEFSTR iniFile                                                      ' Environment variables file
     DEFSTR srcFile                                                      ' Test source file
     DEFSTR dbgFile                                                      ' Test src plus debug info
     DEFSTR PreSetBrkPoints                                              ' (Command line option) preset breakpoints

     DIM SrcStream AS QMEMORYSTREAM                                      ' Source file passed to FB dll
     DIM DatStream AS QMEMORYSTREAM                                      ' Data passed to FB dll
     DIM tmpStream AS QMEMORYSTREAM

     CREATE DbgForm AS QFORM                                             ' Main form
      Height=200
      Width=500
      DelBorderIcons(2)                                               ' Disable maximize button
      BorderStyle=1                                                   ' Fixed size form
      Font.Size=9
      Font.AddStyles fsBold
      Center
      CAPTION="RapidDBG "+VERSION
      OnClose=DbgNoClose                                              ' Disable "X" box of form
      CREATE RichEd AS QRICHEDIT
       Align=5
       HideScrollBars=False
       ScrollBars=ssVertical
       PlainText=True
       ReadOnly=True
       Alignment=0
       HideSelection=True
      END CREATE
      CREATE DirTree AS QDIRTREE
       Align=5
       Visible=False
       InitialDir=LEFT$(Application.Path,3)
      END CREATE
      CREATE OKButn AS QBUTTON
       Top=DbgForm.ClientHeight-OKButn.Height
       Left=(DbgForm.ClientWidth-OKButn.Width)\2
       CAPTION="Set"
       Tag=0
       Visible=False
       OnClick=GotResponse
      END CREATE
     END CREATE

     Initialise
' -c/-r/-d options (compile, run or debug test source code)
     TestUserSource                                                      ' -c/-r/-d Check/run test source code - if no good exit!
     CreateDbgTarget                                                     ' -d debug - create debug+src bas file
     CreateDbgExe                                                        ' Compile the sucker in the target folder
     RunDbgExe                                                           ' Do some debugging maybe?
     DbgError(0)                                                         ' Finished

     SUB DbgNoClose(Action)
      Action=False                                                    ' No closing of form
     END SUB

     FUNCTION TRIM$(srcLine)
      Result=RTRIM$(LTRIM$(srcLine))
     END FUNCTION

'-------------------------- Calling the FreeBasic dll-----------------------------------
' The Dll creates fn/var map in memory and then builds a debug+src file ready to compile
' Params [5]: src file (memorystream), data file (memorystream), initData address of string,
' address of return buffer, size of buffer
' Returns: Fail 0 (reason in buffer?) OR Pass 1
'---------------------------------------------------------------------------------------
     SUB CreateDbgTarget
      DEFINT i, retVal
      DEFSTR buf, tstr
      DIM tFile AS QFILESTREAM

      RichEd.AddStrings "Parsing "+srcFile
      buf=SPACE$(256)                                                 ' Returned string from dll call
      SrcStream.CLOSE                                                 ' Initialise it
      tFile.OPEN (srcFile, fmOpenRead)
      SrcStream.CopyFrom(tFile,0)                                     ' Get the source file into memory
      SrcStream.WriteNum(0,4)                                         ' Append some nulls BUGFIX: v1.35
      tFile.CLOSE
      DOEVENTS
      SrcStream.Position=0                                            ' Not necessary but..
      DatStream.CLOSE                                                 ' Initialise it
      DatStream.ExtractRes(Resource(0))                               ' Get include template file in memory
      DatStream.WriteNum(0,4)                                         ' Append some nulls BUGFIX: v1.35
      DatStream.Position=0

      $IFDEF TIDY_TEMP_FILES                                              ' Build the initialised data string
       tstr="$DEFINE TIDY_TEMP_FILES~"
      $ELSE                                                               ' Leave temp files behind on exit?
       tstr="$UNDEF TIDY_TEMP_FILES~"
      $ENDIF
      tstr=tstr+srcFile+"~"                                           ' Full path+src file
      tstr=tstr+Application.Path+"\~"                                 ' Path to debugger (for toolbar bitmap)
      tstr=tstr+PreSetBrkPoints+"~"                                   ' For debugger preset breakpoints (if any)
      tstr=tstr+STR$(DbgForm.Left)+"~"                                ' DLL Progress bar Left
      tstr=tstr+STR$(DbgForm.Top+DbgForm.Height-50)+"~"               ' DLL Progress bar Top

      retVal=fbParseFile(SrcStream.Pointer, DatStream.Pointer, VARPTR(tstr), VARPTR(buf), LEN(buf))

      SrcStream.CLOSE: DatStream.CLOSE: tmpStream.CLOSE
      IF retVal=0 THEN
       tstr="ERROR: CreateDbgTarget()"+CRLF+"Reason:"+CRLF+RTRIM$(buf)+CRLF+"Terminating!"
       MESSAGEBOX(tstr,"RapidDBG "+VERSION,&H10)
       Application.Terminate
      END IF
      $IFNDEF TIDY_TEMP_FILES
       MESSAGEBOX(buf,"Information",&H40)
      $ENDIF
      buf=" ": tstr=" "
     END SUB

'------------------------------Test/RUN User source--------------------------------------------
' Entry point TestUserSource()

' Debugging - NOT interested in code with line numbers
     FUNCTION HasLineNumbers() AS INTEGER
      DEFINT i
      DEFSTR tstr
      DIM tFile AS QFILESTREAM

      tmpStream.CLOSE                                                 ' Re-initialise it
      tFile.OPEN(srcFile,fmOpenRead)                                  ' Open/Read source file
      tmpStream.CopyFrom(tFile,0)                                     ' Copy the entire stream
      tFile.CLOSE
      DOEVENTS
      tmpStream.Position=0
      FOR i=1 TO 32                                                   ' Check 1st 32 lines of source
       tstr=tmpStream.ReadLine
       tstr=REPLACESUBSTR$(tstr,CHR$(9)," ")                       ' Replace TABs
       IF LEFT$(UCASE$(tstr),4)<>"REM " AND LEFT$(tstr,1)<>"'" THEN
        tstr=FIELD$(tstr," ",1)
        IF VAL(tstr)>0 THEN                                     ' Line number?
         Result=True
         EXIT FUNCTION
        END IF
       END IF
      NEXT i
      Result=False
     END FUNCTION

     SUB RunUserProgram
      DEFSTR tgtFile

      tgtFile=LEFT$(srcFile,RINSTR(srcFile,"."))+"EXE"                ' The EXE tgtFile
      IF FILEEXISTS(tgtFile)=0 THEN
       MESSAGEBOX(tgtFile+" - File does not exists!","RapidDBG "+VERSION,&H10)
      ELSE
       RUN tgtFile                                                 ' "Run" the program and return to quit
      END IF
      Application.Terminate
     END SUB

     FUNCTION CompileFile(FileStr AS STRING) AS INTEGER
      DEFINT size
      DEFLNG PID
      DEFSTR tgtFile, RQCompile
      DIM File AS QFILESTREAM

      tgtFile=LEFT$(FileStr,RINSTR(FileStr,"."))+"EXE"
      RQCompile=QU+rcPath+"\RC.EXE"+QU+" -r "+QU+"-I"+incPath+QU+" "
      RQCompile=RQCompile+QU+"-L"+libPath+QU+" "+QU+FileStr+QU+" "+QU+tgtFile+QU

      PID=SHELL(RQCompile,0)
      WaitOnCompile(PID,120000)                                        ' 120 secs?
      IF FILEEXISTS(tgtFile) THEN
       File.OPEN(tgtFile,fmOpenRead)
       size=File.Size
       File.CLOSE
       DOEVENTS
       IF size>0 THEN
        Result=True
       ELSE
        Result=False
       END IF
      ELSE
       Result=False
      END IF
     END FUNCTION

' Check test source file compiles ok, and run it, if required!
' STOP if Debug required and line numbers detected
     SUB TestUserSource
      DEFINT i
      DEFSTR tstr, RQDumpStr
      DIM tFile AS QFILESTREAM

      RichEd.AddStrings "Checking syntax of "+srcFile
      IF CommandParm=RUN_DEBUG THEN
       IF HasLineNumbers() THEN DbgError(1)                        ' EXIT - no debugging
      END IF

      RQDumpStr=LEFT$(srcFile,RINSTR(srcFile,"\"))+"DUMP.$$$"
      IF CompileFile(srcFile) THEN                                    ' Compile ok?
       KILL RQDumpStr                                              ' Delete - not needed
       DOEVENTS
       IF CommandParm=RUN_USER THEN
        RichEd.AddStrings "Running program..."
        RunUserProgram                                          ' Terminates the debugger
       ELSE
        tstr=LEFT$(srcFile,RINSTR(srcFile,"."))+"EXE"           ' EXE tgtFile
        KILL tstr                                               ' Delete - not needed
        DOEVENTS
        IF CommandParm=COMP_ONLY THEN
         RichEd.AddStrings "Success!"
         MESSAGEBOX("Your code compiles ok!","RapidDBG "+VERSION,&H40)
         Application.Terminate
        END IF
       END IF
      ELSE
       tFile.OPEN(RQDumpStr,fmOpenRead)
       tstr=tFile.ReadLine                                         ' Junk first line
       tstr="Rapid-Q Compiler Beta by William Yu"+CRLF
       tstr=tstr+"Copyright 1999-2000"+CRLF+CRLF
       tstr=tstr+"______________________________________________"+CRLF
       FOR i=1 TO tFile.LineCount-1                                ' Lines terminated with LF char...
        tstr=tstr+tFile.ReadLine+CHR$(13)                       ' ...so MUST add termination...
       NEXT i                                                      ' ... to display in our RichEdit
       tstr=tstr+CRLF
       tstr=tstr+"____________________.o0o.______________________"+CRLF

       tFile.CLOSE                                                 ' Leave the "DUMP" file behind!
       DOEVENTS
       MESSAGEBOX(tstr,"RapidDBG "+VERSION,&H10)
       Application.Terminate
      END IF
     END SUB

'----------------------------------Compile Debug+source--------------------------------------
     SUB CreateDbgExe
      DEFINT i
      DEFSTR tstr, RQDumpStr
      DIM tFile AS QFILESTREAM

      RichEd.AddStrings "Generating debug executable"
      DOEVENTS
      RQDumpStr=LEFT$(dbgFile,RINSTR(dbgFile,"\"))+"DUMP.$$$"
      IF CompileFile(dbgFile)=False THEN
       tFile.OPEN(RQDumpStr,fmOpenRead)

       tstr="_____________### RapidDBG FAILURE ###_____________"+CRLF+CRLF
       FOR i=1 TO tFile.LineCount
        tstr=tstr+tFile.ReadLine+CHR$(13)                       ' MUST add <CR> termination char
       NEXT i
       tstr=tstr+CRLF+"Please advise the author of this problem."+CRLF
       tstr=tstr+"Please include an extract of the code"+CRLF
       tstr=tstr+"around the error line in file:"++CRLF+dbgFile+CRLF
       tstr=tstr+"_______________________.o0o._______________________"+CRLF

       tFile.CLOSE
       DOEVENTS
       RichEd.AddStrings "### RapidDBG FAILURE ###"
       MESSAGEBOX(tstr,"RapidDBG "+VERSION,&H10)
       Application.Terminate                                       ' Exit - Leaving DUMP.$$$ for reference
      END IF
      KILL RQDumpStr                                                  ' Dont need DUMP.$$$
      DOEVENTS
     END SUB

'----------------------------------Run Compiled Debug+source--------------------------------------
' Start debugging target source file
     SUB RunDbgExe
      DEFSTR tgtFile

      RichEd.AddStrings "Running debugger...",""
      DOEVENTS
      SLEEP.MS 250
      tgtFile=LEFT$(dbgFile,RINSTR(dbgFile,"."))+"EXE"
      IF FILEEXISTS(tgtFile) THEN
       RUN tgtFile
       Application.Terminate                                       ' We are done for now
      ELSE
       DbgError(8)
      END IF
     END SUB

'----------------------------------General functions--------------------------------------
     SUB DbgError(errnum)
      DEFSTR tstr, msg="ERR #"+STR$(errnum)+CRLF
      DEFINT msgIcon=&h10                                                 ' Red cross icon

      SELECT CASE errnum
      CASE 0: tstr="RapidDBG will now terminate": msg="": msgIcon=&h40    ' "i" information icon
      CASE 1: tstr="Sorry, line numbers are not supported in this version!"
      CASE 2: tstr="Environment ini file corrupt!": msgIcon=&h20          ' "?" icon
      CASE 3:
       tstr="USAGE:"+CRLF+"RapidDBG <option> <source file> [-b <Breakpoints>]"+CRLF+CRLF
       tstr=tstr+"Source file must include full path, and be of type bas or rqb"+CRLF+CRLF
       tstr=tstr+"options:"+CRLF+"        -c/-C    Compile the source file, check for errors"+CRLF
       tstr=tstr+"        -r/-R    Compile then run the source file"+CRLF
       tstr=tstr+"        -d/-D    Compile the source file with debug code, run debugger"+CRLF+CRLF
       tstr=tstr+"        -b/-B    Optional preset breakpoints used with -d/-D"+CRLF
       tstr=tstr+"                    String of comma separated line numbers"+CRLF+CRLF
       msgIcon=&h40
      CASE 4: tstr="Your source file is invalid or non-existent"
      CASE 5: tstr="Expecting BAS or RQB source file ONLY!"
      CASE 6: tstr="Cannot find parser dll": msgIcon=&h20
      CASE 7: tstr="Problem loading parser dll": msgIcon=&h20
      CASE 8: tstr="RunDbgExe() - Internal Error!"
      CASE ELSE
       tstr="Unidentified Error!!!!"
      END SELECT

      msg=msg+tstr
      MESSAGEBOX(msg,"RapidDBG"+VERSION, msgIcon)
      Application.Terminate                                           ' Tidy up and exit
     END SUB

' The -x/X parameter is an "internal" command:
' Debug session, on termination, calls RapidqDBG.exe with the -X switch
' and it's OWN exe filename. RapidDBG simply deletes the debug exe file.
     SUB KillDebugEXE
      DEFSTR tgtFile

      RichEd.Clear
      RichEd.AddStrings "RapidDBG "+VERSION+" - Terminating"
      DOEVENTS
      SLEEP.MS 1000                                                   ' Allow time for tgtFile to terminate
      tgtFile=UCASE$(TRIM$(COMMAND$(2)))
      KILL tgtFile                                                    ' Fails until TgtFile terminated
      WHILE FILEEXISTS(tgtFile)
       DOEVENTS
       SLEEP.MS 100
       KILL tgtFile                                                ' Fails until TgtFile terminated
      WEND
      Application.Terminate
     END SUB

     SUB GotResponse(Sender)
      Sender.Tag=1                                                    ' OKBtn clicked
     END SUB

     SUB WaitResponse(msg, msgType)
      OKButn.Tag=0                                                    ' Used for looping
      OKButn.Visible=True
      MESSAGEBOX(msg,"RapidDBG "+VERSION,msgType)
      WHILE OKButn.Tag=0
       DOEVENTS
      WEND
      OKButn.Tag=0                                                    ' Used for looping
      OKButn.Visible=False
     END SUB

     SUB GetEnvironment
      DIM tFile AS QFILESTREAM

      iniFile=Application.Path+"\RapidDBG.ini"
      DbgForm.CAPTION="Pre-set your RapidQ environment"
      DbgForm.Show
      DirTree.Visible=True

      WaitResponse("Set path to RC.EXE",&h20)
      rcPath=LEFT$(DirTree.Directory,LEN(DirTree.Directory)-1)        ' Remove trailing "\"
      WaitResponse("Set path to INCLUDE files",&h20)
      incPath=LEFT$(DirTree.Directory,LEN(DirTree.Directory)-1)
      WaitResponse("Set path to LIB files",&h20)
      libPath=LEFT$(DirTree.Directory,LEN(DirTree.Directory)-1)

      DirTree.Visible=False
      DbgForm.Visible=False
      tFile.OPEN(iniFile,fmCreate)
      tFile.WriteLine(rcPath)
      tFile.WriteLine(incPath)
      tFile.WriteLine(libPath)
      tFile.CLOSE
      DOEVENTS
     END SUB

     SUB LoadDbgEnvironment
      DIM tFile AS QFILESTREAM

      iniFile=Application.Path+"\RapidDBG.ini"
      tmpStream.Position=0
      tFile.OPEN(iniFile,fmOpenRead)
      tmpStream.CopyFrom(tFile,0)
      tFile.CLOSE
      IF tmpStream.LineCount<>3 THEN
       KILL iniFile
       DbgError(2)
      END IF
      DOEVENTS
      tmpStream.Position=0
      rcPath=tmpStream.ReadLine
      incPath=tmpStream.ReadLine
      libPath=tmpStream.ReadLine
      tmpStream.CLOSE                                                 ' Re-initialise it
     END SUB

     SUB LoadIdeEnvironment
      DEFINT i
      DEFSTR tstr, token, drv
      DIM tFile AS QFILESTREAM

      drv=FIELD$(Application.Path,"\",1)
      tstr=Application.Path
      tstr=LEFT$(tstr,RINSTR(tstr,"\"))+"Freeq.ini"
      IF FILEEXISTS(tstr) THEN
       iniFile=tstr                                                ' Up one folder IDE ini file
      ELSE
       iniFile=Application.Path+"\Freeq.ini"                       ' Current folder IDE ini file
      END IF
      tmpStream.CLOSE                                                 ' Re-initialise it
      tFile.OPEN(iniFile,fmOpenRead)
      tmpStream.CopyFrom(tFile,0)
      tFile.CLOSE
      DOEVENTS
      tmpStream.Position=0
      FOR i=1 TO tmpStream.LineCount
       tstr=tmpStream.ReadLine
       token=TRIM$(UCASE$(FIELD$(tstr,"=",1)))
       SELECT CASE token
       CASE "COMPILERPATH": rcPath=TRIM$(FIELD$(tstr,"=",2))
       CASE "COMPILERLIBPATH": libPath=TRIM$(FIELD$(tstr,"=",2))
       CASE "COMPILERINCPATH": incPath=TRIM$(FIELD$(tstr,"=",2))
       END SELECT
      NEXT i
      tmpStream.CLOSE
      rcPath=REPLACESUBSTR$(rcPath,"/","\")                           ' Just in case
      IF INSTR(rcPath,":")=0 THEN
       IF LEFT$(rcPath,1)<>"\" THEN rcPath="\"+rcPath
       rcPath=drv+rcPath
      END IF
      IF UCASE$(RIGHT$(rcPath,3))="EXE" THEN
       rcPath=LEFT$(rcPath,RINSTR(rcPath,"\")-1)
      END IF

      libPath=REPLACESUBSTR$(libPath,"/","\")                         ' Just in case
      IF INSTR(libPath,":")=0 THEN
       IF LEFT$(libPath,1)<>"\" THEN libPath="\"+libPath
       libPath=drv+libPath
      END IF
      IF RIGHT$(libPath,1)="\" THEN libPath=LEFT$(libPath,LEN(libPath)-1)

      incPath=REPLACESUBSTR$(incPath,"/","\")                         ' Just in case
      IF INSTR(incPath,":")=0 THEN
       IF LEFT$(incPath,1)<>"\" THEN incPath="\"+incPath
       incPath=drv+incPath
      END IF
      IF RIGHT$(incPath,1)="\" THEN incPath=LEFT$(incPath,LEN(incPath)-1)
     END SUB

     SUB CheckEnvironment
      DEFLNG hDll
      DEFSTR tstr

      tstr=Application.Path
      tstr=LEFT$(tstr,RINSTR(tstr,"\"))+"Freeq.ini"                   ' Up one folder
      IF FILEEXISTS(tstr) OR FILEEXISTS(Application.Path+"\Freeq.ini") THEN
       LoadIdeEnvironment                                          ' Load from the IDE ini file
      ELSEIF FILEEXISTS(Application.Path+"\RapidDBG.ini") THEN
       LoadDbgEnvironment											' RapidDBG ini file exists - load it
      ELSE
       GetEnvironment                                              ' else create an ini file!
      END IF
      IF FILEEXISTS(Application.Path+"\fbDBGParser.dll")=0 THEN
       IF FILEEXISTS(LibPath+"\fbDBGParser.dll")=0 THEN
        DbgError(6)
       ELSE
        hDll=LoadLibrary(LibPath+"\fbDBGParser.dll")            ' Returns DLL handle if available
        IF hDll=0 THEN DbgError(7)
       END IF
      END IF
     END SUB

' Debug optional param:  -b/B brkpt1,brkpt2,....
     FUNCTION CheckForBreakpoints() AS STRING
      DEFSTR tstr

      tstr=""
      IF (COMMANDCOUNT=4) AND (UCASE$(TRIM$(COMMAND$(3)))="-B") THEN
       tstr=TRIM$(COMMAND$(4))
      END IF
      Result=tstr
     END FUNCTION

     SUB LoadSourceFile
      DIM fDialog AS QOPENDIALOG
      DEFSTR fName, tgtFolder

      srcFile=""
      dbgFile=""
      fDialog.CAPTION="Load Source File"
      fDialog.FileName=""
      fDialog.InitialDir=Application.Path
      fDialog.Filter="Source Files (*.bas *.rqb)|*.bas;*.rqb"
      IF fDialog.EXECUTE THEN
       srcFile=fDialog.FileName
       fName=RIGHT$(srcFile,LEN(srcFile)-RINSTR(srcFile,"\"))
       fName=LEFT$(fName,RINSTR(fName,"."))
       tgtFolder=LEFT$(srcFile,RINSTR(srcFile,"\"))
       dbgFile=tgtFolder+"~"+fName+"bas"
       CommandParm=RUN_DEBUG
      ELSE
       RichEd.AddStrings "No source file selected!"
       DbgError(0)                                                 ' No file selected, just quit!
      END IF
     END SUB

     SUB Initialise
      DEFSTR tstr, buf, tgtFolder

      SetWindowLong(DbgForm.Handle, -8, 0)
      SetWindowLong(Application.Handle, -8, DbgForm.Handle)
      DbgForm.Show
      RichEd.AddStrings "Initialising..."

      CheckEnvironment                                                ' Get paths to rc.exe etc
      buf=SPACE$(16)
      IF fbParserVersion(VARPTR(buf)) THEN
       VERSION=FIELD$(buf,CHR$(0),1)                               ' Returns nul terminated string
       DbgForm.CAPTION="RapidDBG "+VERSION
      ELSE
       tstr="Failed to get dll version info!"+CRLF+"RapidDBG terminating"
       MESSAGEBOX(tstr,"RapidDBG",&H10)
       Application.Terminate
      END IF
      IF COMMANDCOUNT=0 THEN
       LoadSourceFile
      ELSE
       IF COMMANDCOUNT<2 THEN DbgError(3)                          ' Incorrect num parms supplied
       tstr=UCASE$(TRIM$(COMMAND$(1)))
       SELECT CASE tstr
       CASE "-C": CommandParm=COMP_ONLY
       CASE "-R": CommandParm=RUN_USER
       CASE "-D"
        CommandParm=RUN_DEBUG
        PreSetBrkPoints=CheckForBreakpoints
       CASE "-X": KillDebugEXE                                 ' An "internal" cmd line parameter
       CASE ELSE
        DbgError(3)
       END SELECT

       srcFile=TRIM$(COMMAND$(2))
       srcFile=REPLACESUBSTR$(srcFile,"/","\")
       IF FILEEXISTS(srcFile)=0 THEN DbgError(4)

       tstr=UCASE$(RIGHT$(srcFile,LEN(srcFile)-RINSTR(srcFile,".")))
       IF (tstr<>"BAS") AND (tstr<>"RQB") THEN DbgError(5)

       tgtFolder=LEFT$(srcFile,RINSTR(srcFile,"\")-1)              ' Move to the target directory
       CHDIR tgtFolder

       tgtFolder=tgtFolder+"\"
       tstr=srcFile-tgtFolder                                      ' The file name+ext
       tstr=LEFT$(tstr,RINSTR(tstr,"."))                           ' Remove the ext
       dbgFile=tgtFolder+"~"+tstr+"bas"	                        ' New user source + debug code
      END IF
      IF FILEEXISTS(Application.Path+"\RapidDBG.ico")=0 THEN            ' The debugger form's icon
       EXTRACTRESOURCE Resource(1),Application.Path+"\RapidDBG.ico"
       DOEVENTS
      END IF
      IF FILEEXISTS(Application.Path+"\RapidDBG.bmp")=0 THEN          ' The toolbar bmp
       EXTRACTRESOURCE Resource(2),Application.Path+"\RapidDBG.bmp"
       DOEVENTS
      END IF
     END SUB

2010-12-07 21:18