'===========================================================================
' Subject: FILE SELECTOR                     Date: 11-25-98 (04:54)       
' Author:  Antoni Gual                       Code: QB, PDS                
' Origin:  agual@eic.ictnet.es             Packet: DOS.ABC
'===========================================================================
DECLARE FUNCTION filesel$ ()
'----------------------------file selector:---------------------------------
'I'm sick of trying snippets starting with a blank screen and a
'
'                Enter path to file:
'
'prompt!!!!!!!!
'---------------------------------------------------------------------------
'Version 2
'
'
'Improvements:
'-Now it uses an error handler with RESUME and RESUME NEXT statements,so it
'can return control to procedures. Handler  only displays  error and asks user
'in case of different options. It passes back the error number in a different
'variable HERR (ERR is cleared by the handler), so the line where the program
'resumes can undertake the correct action.
'This way the file selector can be a function, callable from any other proce-
'dure or module.

'My email: agual@eic.ictnet.es
'
'I did'nt corrected this:
'-Ugly display.I tried to keep it simple..
'-Uses qlib interrupt calls to change drive, so it can't be run from qbasic.
'(some qbasic user could add one of these call absolute routines...)
'--------------------------------------------------------------------------

'init
DEFINT A-Z
'$INCLUDE: 'qb.bi'
DIM SHARED inreg AS RegTypeX, outreg AS RegTypeX


'-----------demo : displays file selected (so select a text file..)

NUM = 1
OPEN filesel$ FOR INPUT AS #NUM
DO WHILE NOT EOF(NUM)
	LINE INPUT #NUM, A$
	PRINT A$
LOOP
CLOSE NUM
END

'-----------------This is the error handler ---------------------------------

errorfilesel:
SELECT CASE ERR
	CASE 53, 64: PRINT " File not found!":
	CASE 68: PRINT "Drive Does not Exist!":
	CASE 71: PRINT "Disk Not ready [Retry/Abort] "
		k$ = UCASE$(INPUT$(1))
		IF k$ = "R" THEN RESUME
	CASE 76: PRINT "Path not found!"
	CASE ELSE: PRINT "Error "; ERR
END SELECT
herr = ERR
RESUME NEXT

FUNCTION filesel$

ON ERROR GOTO errorfilesel
herr = 0
CLS
s0$ = SPACE$(80)

DO
	FILES
askdrive:
	INPUT "Select Drive [Enter:Current] > ", drive$
	'if no input, go ask path
	IF LEN(drive$) THEN
		'---CHDRIVE drive$ in PDS-----------------------
		inreg.ax = &HE00
		driv% = ASC(UCASE$(drive$)) - ASC("A")
		inreg.dx = driv%
		CALL INTERRUPTX(&H21, inreg, inreg)
		'----end of CHDRIVE-----------------------------
		'as this interrupt call does'n give any error result
		'we must test if current drive is what we asked for
		'and generate our own error if is not
	   
		inreg.ax = &H1900
		CALL INTERRUPTX(&H21, inreg, inreg)
		'probabli the drive we asked for does'nt exist
		IF (inreg.ax AND &HFF) <> driv% THEN ERROR 68
		IF herr = 68 OR herr = 71 THEN herr = 0: GOTO askdrive
	END IF
askpath:
	'what is in?  Here we trap the no disk error
	FILES
	IF herr = 71 THEN herr = 0: GOTO askdrive
	INPUT "Select Path [Enter:Current] > ", path$
	'if no input go ask filename
	IF LEN(path$) THEN
		CHDIR path$
		IF herr = 53 OR herr = 76 THEN herr = 0: GOTO askpath
		IF herr = 71 THEN herr = 0: GOTO askdrive
		GOTO askpath
	END IF
askname:
	INPUT "Select Name [Enter:New path] > ", name$
	'does it exist?
	FILES name$
	IF herr = 53 OR herr = 64 THEN herr = 0: GOTO askname
	IF herr = 71 THEN herr = 0: GOTO askdrive
LOOP UNTIL LEN(name$)

filesel$ = name$
ON ERROR GOTO 0

END FUNCTION