' LONG FILENAMES FROM DOS DEMONSTRATION v1.5
' by Alex Warren, June 1998
' Released into the Public Domain

' This program is intended to show you how to use the long filename
' functions. It's not particularly neat but it should be good enough to
' show you how to incorporate long filenames in your applications without
' having to use the incredibly messy method of using SHELL.

' New in version 1.5 - new neater screen layout, "Create File" added (was
' in menu in 1.0 but forgot to implement it <g> )

DECLARE SUB drawwindow (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, col AS INTEGER)
DECLARE SUB centreprint (y AS INTEGER, s$)
DECLARE SUB setdirectory ()
DECLARE SUB getfileattribs ()
DECLARE SUB showdirectory ()
DECLARE SUB createfile ()
DECLARE SUB createdirectory ()
DECLARE SUB getvolumeinfo (drive$)
DECLARE FUNCTION truncate$ (s$)
DECLARE FUNCTION getcurrentdir$ ()
DECLARE SUB int21 ()
'$INCLUDE: 'qb.bi'
DIM SHARED inregs AS RegTypeX, outregs AS RegTypeX

DIM SHARED filesystem$, casesensitive%, preservecase%, unicode%, lfnfunctions%, compressed%
DIM SHARED searchhandle%, returnedlfn$, returnedsfn$

DO
CLS

drawwindow 5, 1, 75, 5, 0

centreprint 2, "Long Filenames from DOS Demonstration, by Alex Warren"
centreprint 3, "version 1.5, June 1998"
centreprint 4, "Released into the Public Domain"

drawwindow 15, 12, 65, 22, 9
centreprint 12, "[ MENU ]"
centreprint 13, "Current directory is " + getcurrentdir$
centreprint 15, "1 - Create directory"
centreprint 16, "2 - Change to directory"
centreprint 17, "3 - View directory"
centreprint 18, "4 - Create file"
centreprint 19, "5 - Change drive"
centreprint 20, "6 - Exit"

' Not included but worth investigating are:
' - Remove directory (service 713Ah)
' - Delete file (7141h)
' - Move/Rename file (7156h)
' - Get/Set file attributes (7143h)
' +++ others on Ralf Brown's Interrupts List

DO: a$ = INPUT$(1): LOOP UNTIL a$ >= "1" AND a$ <= "6"
selected = VAL(a$)

COLOR 7, 0: CLS

SELECT CASE selected
CASE 1
createdirectory
CASE 2
setdirectory
CASE 3
showdirectory
CASE 4
createfile
CASE 5
INPUT "Enter drive letter: ", driveletter$
driveletter$ = driveletter$ + ":"
SHELL driveletter$
CASE 6
END
END SELECT

LOOP


SUB centreprint (y AS INTEGER, s$)

x% = 40 - LEN(s$) / 2
LOCATE y, x%: PRINT s$

END SUB

SUB createdirectory

DIM pathname AS STRING * 255

INPUT "Enter FULL path of sub-directory to create: "; p$
pathname = p$

' inregs:
' .ax: service - 7139h
' .ds: segment of pathname
' .dx: offset of pathname

inregs.ax = &H7139
inregs.ds = VARSEG(pathname)
inregs.dx = VARPTR(pathname)
int21

END SUB

SUB createfile

DIM createfilename AS STRING * 255

INPUT "Enter name and path of file to create: ", f$
createfilename = f$

' inregs:
' .ax: service - 716Ch
' .bx: access mode and sharing flags
' .dx: action (bits: 0=open; 1=truncate; 4=create)
' .ds: segment of pathname
' .si: offset of pathname

inregs.ax = &H716C
inregs.dx = (2 ^ 4)
inregs.ds = VARSEG(createfilename)
inregs.si = VARPTR(createfilename)
int21

' When the file has been created you could get its short filename and
' write to it. I think that you may need to close the file using an
' interrupt before you do that though... I don't know what it is. Sorry!

END SUB

SUB drawwindow (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, col AS INTEGER)


COLOR 7, col
FOR i% = y1 TO y2
LOCATE i%, x1
PRINT STRING$(x2 - x1, " ")
NEXT i%

' draw corners
LOCATE y1, x1: PRINT CHR$(218)
LOCATE y1, x2: PRINT CHR$(191)
LOCATE y2, x1: PRINT CHR$(192)
LOCATE y2, x2: PRINT CHR$(217)

' draw edges
LOCATE y1, x1 + 1: PRINT STRING$(x2 - x1 - 1, 196)
LOCATE y2, x1 + 1: PRINT STRING$(x2 - x1 - 1, 196)
FOR y% = y1 + 1 TO y2 - 1
LOCATE y%, x1
PRINT CHR$(179);
NEXT y%
FOR y% = y1 + 1 TO y2 - 1
LOCATE y%, x2
PRINT CHR$(179);
NEXT y%



END SUB

FUNCTION getcurrentdir$

DIM thedir AS STRING * 255

' inregs:
' .ax: service - 7147h
' .dx: 0=default, 1=A:, 2=B:, 3=C:, 4=D: etc.
' .ds: segment of buffer
' .si: offset of buffer

inregs.dx = &H0
inregs.ax = &H7147
inregs.ds = VARSEG(thedir)
inregs.si = VARPTR(thedir)
int21

' This line truncates thedir up to the first null character:
d$ = truncate$(thedir)

' This line adds the backslash if not present, as the backslash may or may
' not be present already. If you don't want the backslash there ever, modify
' this line:
IF RIGHT$(d$, 1) <> "\" THEN d$ = d$ + "\"

getcurrentdir$ = d$

END FUNCTION

SUB getvolumeinfo (drive$)

' inregs:
' .ax: service - 71A0h
' .ds: segment of rootname
' .dx: offset of rootname
' .es: segment of buffer for file system name
' .di: offset of buffer for file system name
' .cx: size of file system name buffer

DIM rootname AS STRING * 4
DIM filesysname AS STRING * 255
rootname = drive$ + CHR$(0)

inregs.ax = &H71A0
inregs.ds = VARSEG(rootname)
inregs.dx = VARPTR(rootname)
inregs.es = VARSEG(filesysname)
inregs.di = VARPTR(filesysname)
inregs.cx = 255
int21

IF outregs.ax = &H7100 THEN
BEEP
PRINT "LFN functions are not supported; exiting program..."
END
END IF

filesystem$ = truncate$(filesysname)
IF outregs.bx AND 2 ^ 0 THEN casesensitive% = 1 ELSE casesensitive% = 0
IF outregs.bx AND 2 ^ 1 THEN preservecase% = 1 ELSE preservecase% = 0
IF outregs.bx AND 2 ^ 2 THEN unicode% = 1 ELSE unicode% = 0
IF outregs.bx AND 2 ^ 14 THEN lfnfunctions% = 1 ELSE lfnfunctions% = 0
IF outregs.bx AND 2 ^ 15 THEN compressed% = 1 ELSE compressed% = 0

END SUB

SUB int21

CALL INTERRUPTX(&H21, inregs, outregs)

END SUB

SUB setdirectory

DIM pathname AS STRING * 255

INPUT "Enter FULL path of sub-directory: "; p$
pathname = p$

' inregs:
' .ax: service - 713Bh
' .ds: segment of pathname
' .dx: offset of pathname

inregs.ax = &H713B
inregs.ds = VARSEG(pathname)
inregs.dx = VARPTR(pathname)
int21


END SUB

SUB showdirectory

' get volume label

DIM vollable AS STRING * 500
DIM filespec AS STRING * 4

filespec = "*.*" + CHR$(0)

inregs.ax = &H714E
inregs.ds = VARSEG(filespec)
inregs.dx = VARPTR(filespec)
inregs.es = VARSEG(vollable)
inregs.di = VARPTR(vollable)
inregs.cx = &H808
inregs.si = &H0
int21

vol$ = truncate$(MID$(vollable, &H2D, 260))   ' truncate string to null char.
vol$ = LEFT$(vol$, 8) + RIGHT$(vol$, 3)       ' get rid of the dot


COLOR 9: PRINT "Volume label is "; vol$; "."
COLOR 7

quitloop = 0

' What's done:
' first, call 714Eh to find first matching file, then call 714Fh to find
' next matching file and so on. Use 71A1h to stop the search.

' Attributes masks:
' Bit: 4 = directory
'      3 = volume label
'      2 = system
'      1 = hidden
'      0 = read-only

' ax=&h714E (service)
' ds:dx = filespec, e.g. *.*
' es:di = finddata record (see below)
' cl = allowable attributes mask, set here to F7, i.e ALL attributes allowed
'      except for volume label.
' ch = required attributes mask, set here to 00 so NO attributes required

DIM finddatarecord AS STRING * 500

' filespec must be DIMmed as STRING * x, this is already done above.
filespec = "*.*" + CHR$(0)

inregs.ax = &H714E
inregs.ds = VARSEG(filespec)
inregs.dx = VARPTR(filespec)
inregs.es = VARSEG(finddatarecord)
inregs.di = VARPTR(finddatarecord)
inregs.cx = &HF7
inregs.si = &H0
int21
filefindhandle = outregs.ax



numfiles = 1

DO

' finddatarecord$ is now filled with loads of information about the file
' we've retrieved (info from Ralf Brown's Interrupts List):
' offset 00h bits 0-6 are standard DOS file attribs
' 04h QWORD file creation time
' 0Ch QWORD last access time
' 14h QWORD last modification time
' 1Ch DWORD file size (high 32 bits)
' 20h DWORD file size (low 32 bits)
' 2Ch 260bytes ASCIZ full filename
' 130h 14bytes ASCIZ short filename

' If required, you could interpret all that stuff but we're only interested
' in the filenames for now:

longfilename$ = truncate$(MID$(finddatarecord, &H2D, 260))
shortfilename$ = truncate$(MID$(finddatarecord, &H131, 14))

' NOTE that shortfilename$ will contain nothing if the short filename
' is *exactly* the same as the long file name.

PRINT longfilename$; TAB(30); shortfilename$

' If longfilename$ is null, we've reached the end of the list.
IF longfilename$ = "" THEN PRINT "*** END OF LIST; PRESS A KEY ***": EXIT DO


' reset finddatarecord
finddatarecord = STRING$(500, 0)

inregs.ax = &H714F
inregs.bx = filefindhandle
int21

IF numfiles MOD 20 = 0 THEN
COLOR 14
PRINT ">> Press a key <<"
COLOR 7
a$ = INPUT$(1)
IF a$ = CHR$(27) THEN quitloop = 1
END IF

numfiles = numfiles + 1

LOOP UNTIL quitloop = 1

IF quitloop = 0 THEN a$ = INPUT$(1)

' It's important to reset the filefind handle:
inregs.ax = &H71A1
inregs.bx = filefindhandle
int21

END SUB

SUB showinfo

getvolumeinfo ("C:\")

PRINT "File system is: "; filesystem$
PRINT
PRINT "Searches are case sensitive:"; casesensitive%
PRINT "Preserves case in directory entries:"; preservecase%
PRINT "Uses unicode chars in file and dir names:"; unicode%
PRINT "Supports DOS LFN functions:"; lfnfunctions%
PRINT "Compressed volume:"; compressed%


END SUB

FUNCTION truncate$ (s$)

' Truncates s$ to first null character

truncate$ = LEFT$(s$, INSTR(s$, CHR$(0)) - 1)
END FUNCTION