Long File Name Utilities (QBASIC)

From LiteratePrograms

QBASIC is still quite useful for doing things from the Windows command prompt which can't easily be done with a batch file. Unfortunately it doesn't understand about Long File Names. So here is a utility function called qDir$() which works very much like the Dir() function provided with Visual BASIC or the Microsoft BASIC Professional Development System version 7.1. It is quite possible to do this with assembly calls but in this utility that option is not used.

<<filemgr.bas>>=
DECLARE FUNCTION Proper$ (aText$)
DECLARE FUNCTION qCR$ ()
DECLARE FUNCTION GetTempDir$ ()
DECLARE FUNCTION RndFileName$ ()
DECLARE FUNCTION qDir$ (aText$)
DECLARE FUNCTION qTrim$ (aText$)
DECLARE SUB ShellCommand (aCmd$)
DECLARE FUNCTION qKW$ ()
CLS
LET F$ = qDir$("C:\*.*")
DO WHILE F$ <> ""
   PRINT F$
   LET F$ = qDir$("")
LOOP
SYSTEM
SUB FileCopy (This$, That$)
   ShellCommand "COPY /B " + This$ + " " + That$ + " >NUL"
END SUB
DEFINT A-Z
FUNCTION GetTempDir$
   ' Returns a Temporary Directory path
   STATIC Ready%, TempDir$
   IF NOT Ready% THEN GOSUB GetTempDirInit: Ready% = NOT Ready%
   LET GetTempDir$ = TempDir$
   EXIT FUNCTION
GetTempDirInit:
   IF ENVIRON$("TEMP") > "" THEN
      LET TempDir$ = ENVIRON$("TEMP")
   ELSEIF ENVIRON$("temp") > "" THEN
      LET TempDir$ = ENVIRON$("temp")
   ELSEIF ENVIRON$("TMP") > "" THEN
      LET TempDir$ = ENVIRON$("TMP")
   ELSEIF ENVIRON$("tmp") > "" THEN
      LET TempDir$ = ENVIRON$("tmp")
   ELSEIF ENVIRON$("WINTMP") > "" THEN
      LET TempDir$ = ENVIRON$("WINTMP")
   ELSEIF ENVIRON$("wintmp") > "" THEN
      LET TempDir$ = ENVIRON$("wintmp")
   ELSE
      LET TempDir$ = "."   ' Can't find the temp dir so return the current dir
   END IF
   IF TempDir$ > "" THEN
      IF RIGHT$(TempDir$, 1) <> "\" THEN TempDir$ = TempDir$ + "\"
   END IF
   RETURN
END FUNCTION
FUNCTION qCR$
   CONST TRUE = (1 = 1), FALSE = NOT TRUE
   STATIC Ready%, sCR$
   IF NOT Ready% THEN sCR$ = CHR$(13) + CHR$(10): Ready% = TRUE
   LET qCR$ = sCR$
END FUNCTION
DEFSNG A-Z
FUNCTION qDir$ (aText$)
   CONST DirListMAX = 500
   CONST TRUE = (1 = 1), FALSE = NOT TRUE
   STATIC Ready%, tmpFile$, DirIndex%, DirList$()
   IF NOT Ready% THEN GOSUB qDirInit: Ready% = TRUE
   IF aText$ > "" THEN
      ShellCommand "DIR " + aText$ + " /b >" + tmpFile$
      LET F% = FREEFILE: OPEN tmpFile$ FOR INPUT AS #F%
      LET DirIndex% = 0
      DO WHILE NOT EOF(F%) AND DirIndex% < DirListMAX
         LET DirIndex% = DirIndex% + 1
         LINE INPUT #F%, DirList$(DirIndex%)
      LOOP
      CLOSE #F%
      KILL tmpFile$
   ELSEIF DirIndex% > 0 THEN
      LET DirIndex% = DirIndex% - 1
   END IF
   LET qDir$ = DirList$(DirIndex%)
   EXIT FUNCTION
qDirInit:
   REDIM DirList$(DirListMAX)
   LET tmpFile$ = GetTempDir$ + RndFileName$
   LET DirIndex% = 0
   LET DirList$(DirIndex%) = ""
   RETURN
END FUNCTION
DEFINT A-Z
FUNCTION qKW$
   CONST TRUE = (1 = 1), FALSE = NOT TRUE
   STATIC Ready%, sKW$
   IF NOT Ready% THEN sKW$ = CHR$(34): Ready% = TRUE
   LET qKW$ = sKW$
END FUNCTION
DEFSNG A-Z
FUNCTION qTrim$ (aText$)
    LET qTrim$ = LTRIM$(RTRIM$(aText$))
END FUNCTION
DEFINT A-Z
FUNCTION RndFileName$
' Returns a random filename for making a temporary file
   CONST CharLIST = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   CONST LenCharLIST = 36
   DIM TempName$, J%
   LET TempName$ = ""
   LET J% = 1
   DO WHILE J% <= 11
      LET TempName$ = TempName$ + MID$(CharLIST, INT(RND * LenCharLIST) + 1, 1)
      LET J% = J% + 1
   LOOP
   LET RndFileName$ = LEFT$(TempName$, 8) + "." + MID$(TempName$, 9)
END FUNCTION
SUB ShellCommand (aCmd$)
   CONST TRUE = (1 = 1), FALSE = NOT TRUE
   STATIC Ready%, ShellFile$
   IF NOT Ready% THEN GOSUB ShellCommandInit: Ready% = TRUE
   SHELL ShellFile$ + aCmd$
   EXIT SUB
ShellCommandInit:
   LET ShellFile$ = ENVIRON$("COMSPEC")
   IF LEN(ShellFile$) = 0 THEN LET ShellFile$ = ENVIRON$("comspec")
   IF LEN(ShellFile$) = 0 THEN LET ShellFile$ = "COMMAND"
   LET ShellFile$ = ShellFile$ + " /C "
   RETURN
END SUB

One of the nice things about later versions of Visual BASIC is that you can call a function as if it was a subroutine. In such a case VB just throws away the result. However when you actually want the function's side-effects but not its result, this is a Good Thing. To get the same effect in QBASIC is quite easy. All you need to do is define a subroutine which takes a function's result and ignores it. That's what the following subroutine, Void, does. It will only throw away a numeric result but a similar routine can be defined to throw away text by changing the argument type.

SUB Void (argNull AS LONG)
END SUB

A function to convert the first character of a piece of text to uppercase and the rest to lowercase can be just as useful as one to convert text to all uppercase or all lowercase. Although QBASIC has the UCASE$() and LCASE$() functions to carry out the latter two operations it doesn't have a function to carry out the former one. However it is straightforward to define one.

FUNCTION Proper$ (aText$)
    CONST TRUE = (1 = 1), FALSE = NOT TRUE
    DIM inWord AS INTEGER
    DIM J AS INTEGER
    DIM Q AS STRING
    DIM C AS STRING
    LET Q = LCASE$(aText$)
    IF LEN(Q) > 0 THEN
        LET inWord = FALSE
        FOR J = 1 TO LEN(Q)
            LET C = MID$(Q, J, 1)
            SELECT CASE C
            CASE "a" TO "z"
                IF NOT inWord THEN
                    MID$(Q, J, 1) = UCASE$(C)
                END IF
                LET inWord = TRUE
            CASE ELSE
                LET inWord = FALSE
            END SELECT
        NEXT
    END IF
    LET Proper$ = Q
END FUNCTION

Download code