'===========================================================================
' Subject: RETURN TRUE EXE NAME              Date: Unknown Date (00:00)   
' Author:  Unknown Author(s)                 Code: QB, PDS                
' Keys:    RETURN,TRUE,EXE,NAME            Packet: DOS.ABC
'===========================================================================
REM *************************************************************
REM **                                                         **
REM **  This program will read the TRUE program name from the  **
REM **  Environment.  If you are executing a program called    **
REM **  HELLO.EXE, and only typed HELLO at the command line,   **
REM **  It would return the ENTIRE PATH of where HELLO.EXE is  **
REM **  located.  If HELLO.EXE is in C:\DOS\BASIC\QB, the      **
REM **  line returned from this program would be               **
REM **  c:\dos\basic\qb\HELLO.EXE instead of just HELLO        **
REM **                                                         **
REM **  This program is basically a reprint from a very early  **
REM **  Cobb Inside Microsoft Basic Journal, but can be used   **
REM **  freely.  It is in the Public Domain.  No credit or     **
REM **  other compensation is necessary or expected.           **
REM **                                                         **
REM **  This program should work with BOTH QuickBasic 4.5 and  **
REM **  the Basic Professional Development System 7.xx         **
REM **                                                         **
REM *************************************************************

REM ****  Below is the main program module  ************

DECLARE FUNCTION ProgramName$ ()
DEFINT A-Z

CONST FALSE = 0
CONST TRUE = -1

'PDS users should change the next line to include the QBX.BI file
'$INCLUDE: 'QB.BI'

CLS
PRINT "Program name = "; ProgramName$
END

REM ****  Below is a FUNCTION that should be parsed by the QB ***
REM ****  or QBX Environments.  *********************************

'=================== Function ProgramName$ ======================
'== INPUT: None                                                ==
'== RETURNS: Name of currently executing program               ==
'================================================================
'
FUNCTION ProgramName$

DIM Regs AS RegType

'Get PSP address

   Regs.ax = &H6200
   CALL Interrupt(&H21, Regs, Regs)
   PSPSegment = Regs.bx

'Find environment address from PSP

   DEF SEG = PSPSegment
   EnvSegment = PEEK(&H2D) * 256 + PEEK(&H2C)

'Find the filename

   DEF SEG = EnvSegment
   EOT = FALSE                 'Set end of environment table flag
   Offset = 0

   WHILE NOT EOT
	 Byte = PEEK(Offset)       'Get table character
	 IF Byte = 0 THEN          'End of environment string?
'        PRINT                   'Uncomment to print environment
	    Offset = Offset + 1
	    Byte = PEEK(Offset)
	    IF Byte = 0 THEN        'End of environment?
		  Offset = Offset + 3   'Yes - Skip over nulls & tbl info
		  C% = PEEK(Offset)
		  WHILE C% <> 0                   'Assemble filename string
			FileN$ = FileN$ + CHR$(C%)    '  from individual
			Offset = Offset + 1           '  characters
			C% = PEEK(Offset)
		  WEND
		  EOT = TRUE              'Set flag to exit while/wend loop
	    END IF
	 ELSE                        'No-Read more environment string
'        PRINT CHR$(Byte);         'Uncomment to print environment
	    Offset = Offset + 1
	 END IF
   WEND
   ProgramName$ = FileN$
   DEF SEG
END FUNCTION