Download code

Jump to: navigation, search

Back to Long_File_Name_Utilities_(QBASIC)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

filemgr.bas

  1 REM The authors of this work have released all rights to it and placed it
  2 REM in the public domain under the Creative Commons CC0 1.0 waiver
  3 REM (http://creativecommons.org/publicdomain/zero/1.0/).
  4 REM 
  5 REM THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  6 REM EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  7 REM MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  8 REM IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  9 REM CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 10 REM TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 11 REM SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 12 REM 
 13 REM Retrieved from: http://en.literateprograms.org/Long_File_Name_Utilities_(QBASIC)?oldid=16025
 14 
 15 
 16 DECLARE FUNCTION Proper$ (aText$)
 17 DECLARE FUNCTION qCR$ ()
 18 DECLARE FUNCTION GetTempDir$ ()
 19 DECLARE FUNCTION RndFileName$ ()
 20 DECLARE FUNCTION qDir$ (aText$)
 21 DECLARE FUNCTION qTrim$ (aText$)
 22 DECLARE SUB ShellCommand (aCmd$)
 23 DECLARE FUNCTION qKW$ ()
 24 
 25 CLS
 26 LET F$ = qDir$("C:\*.*")
 27 DO WHILE F$ <> ""
 28    PRINT F$
 29    LET F$ = qDir$("")
 30 LOOP
 31 SYSTEM
 32 
 33 SUB FileCopy (This$, That$)
 34 
 35    ShellCommand "COPY /B " + This$ + " " + That$ + " >NUL"
 36 
 37 END SUB
 38 
 39 DEFINT A-Z
 40 FUNCTION GetTempDir$
 41    ' Returns a Temporary Directory path
 42 
 43    STATIC Ready%, TempDir$
 44  
 45    IF NOT Ready% THEN GOSUB GetTempDirInit: Ready% = NOT Ready%
 46     
 47    LET GetTempDir$ = TempDir$
 48  
 49    EXIT FUNCTION
 50 
 51 GetTempDirInit:
 52  
 53    IF ENVIRON$("TEMP") > "" THEN
 54       LET TempDir$ = ENVIRON$("TEMP")
 55    ELSEIF ENVIRON$("temp") > "" THEN
 56       LET TempDir$ = ENVIRON$("temp")
 57    ELSEIF ENVIRON$("TMP") > "" THEN
 58       LET TempDir$ = ENVIRON$("TMP")
 59    ELSEIF ENVIRON$("tmp") > "" THEN
 60       LET TempDir$ = ENVIRON$("tmp")
 61    ELSEIF ENVIRON$("WINTMP") > "" THEN
 62       LET TempDir$ = ENVIRON$("WINTMP")
 63    ELSEIF ENVIRON$("wintmp") > "" THEN
 64       LET TempDir$ = ENVIRON$("wintmp")
 65    ELSE
 66       LET TempDir$ = "."   ' Can't find the temp dir so return the current dir
 67    END IF
 68  
 69    IF TempDir$ > "" THEN
 70       IF RIGHT$(TempDir$, 1) <> "\" THEN TempDir$ = TempDir$ + "\"
 71    END IF
 72  
 73    RETURN
 74 
 75 END FUNCTION
 76 
 77 FUNCTION qCR$
 78 
 79    CONST TRUE = (1 = 1), FALSE = NOT TRUE
 80  
 81    STATIC Ready%, sCR$
 82 
 83    IF NOT Ready% THEN sCR$ = CHR$(13) + CHR$(10): Ready% = TRUE
 84 
 85    LET qCR$ = sCR$
 86 
 87 END FUNCTION
 88 
 89 DEFSNG A-Z
 90 FUNCTION qDir$ (aText$)
 91 
 92    CONST DirListMAX = 500
 93    CONST TRUE = (1 = 1), FALSE = NOT TRUE
 94 
 95    STATIC Ready%, tmpFile$, DirIndex%, DirList$()
 96    IF NOT Ready% THEN GOSUB qDirInit: Ready% = TRUE
 97 
 98    IF aText$ > "" THEN
 99       ShellCommand "DIR " + aText$ + " /b >" + tmpFile$
100       LET F% = FREEFILE: OPEN tmpFile$ FOR INPUT AS #F%
101       LET DirIndex% = 0
102       DO WHILE NOT EOF(F%) AND DirIndex% < DirListMAX
103          LET DirIndex% = DirIndex% + 1
104          LINE INPUT #F%, DirList$(DirIndex%)
105       LOOP
106       CLOSE #F%
107       KILL tmpFile$
108    ELSEIF DirIndex% > 0 THEN
109       LET DirIndex% = DirIndex% - 1
110    END IF
111   
112    LET qDir$ = DirList$(DirIndex%)
113    EXIT FUNCTION
114 
115 qDirInit:
116    REDIM DirList$(DirListMAX)
117    LET tmpFile$ = GetTempDir$ + RndFileName$
118    LET DirIndex% = 0
119    LET DirList$(DirIndex%) = ""
120    RETURN
121 
122 END FUNCTION
123 
124 DEFINT A-Z
125 FUNCTION qKW$
126 
127    CONST TRUE = (1 = 1), FALSE = NOT TRUE
128    STATIC Ready%, sKW$
129 
130    IF NOT Ready% THEN sKW$ = CHR$(34): Ready% = TRUE
131 
132    LET qKW$ = sKW$
133 
134 END FUNCTION
135 
136 DEFSNG A-Z
137 FUNCTION qTrim$ (aText$)
138    
139     LET qTrim$ = LTRIM$(RTRIM$(aText$))
140 
141 END FUNCTION
142 
143 DEFINT A-Z
144 FUNCTION RndFileName$
145 ' Returns a random filename for making a temporary file
146 
147    CONST CharLIST = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
148    CONST LenCharLIST = 36
149 
150    DIM TempName$, J%
151  
152    LET TempName$ = ""
153    LET J% = 1
154    DO WHILE J% <= 11
155       LET TempName$ = TempName$ + MID$(CharLIST, INT(RND * LenCharLIST) + 1, 1)
156       LET J% = J% + 1
157    LOOP
158 
159    LET RndFileName$ = LEFT$(TempName$, 8) + "." + MID$(TempName$, 9)
160 
161 END FUNCTION
162 
163 SUB ShellCommand (aCmd$)
164 
165    CONST TRUE = (1 = 1), FALSE = NOT TRUE
166  
167    STATIC Ready%, ShellFile$
168    IF NOT Ready% THEN GOSUB ShellCommandInit: Ready% = TRUE
169  
170    SHELL ShellFile$ + aCmd$
171  
172    EXIT SUB
173 
174 ShellCommandInit:
175    LET ShellFile$ = ENVIRON$("COMSPEC")
176    IF LEN(ShellFile$) = 0 THEN LET ShellFile$ = ENVIRON$("comspec")
177    IF LEN(ShellFile$) = 0 THEN LET ShellFile$ = "COMMAND"
178    LET ShellFile$ = ShellFile$ + " /C "
179    RETURN
180 
181 END SUB
182 


hijacker
hijacker
hijacker
hijacker