Long File Name Utilities (QBASIC)

From LiteratePrograms
Jump to: navigation, search

This program is a code dump.
Code dumps are articles with little or no documentation or rearrangement of code. Please help to turn it into a literate program. Also make sure that the source of this code does consent to release it under the CC0 license.


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
hijacker
hijacker
hijacker
hijacker