Good evening (here, anyway
)
What I would like to be able to do is to have the user enter a directory, but before it is created, check to see if there is a duplicate directory in the C:\ drive. I would rather not use an Error-handler, as it isn't always reliable and it does slow down the program.
I plan on creating the directory using the MKDIR command in QBASIC and not the SHELL command like you can.
Thanks for any help you can provide.
Well, this will find directories and files, but you can check to see if any of the found directories are the one asked for. This uses the QB.QLB
I got this a long time ago I think from QB45.net... anyways, it was called DIRX.bas if you want the original.
Code:
REM $INCLUDE: 'QB.BI'
DECLARE SUB ShowHeader ()
DECLARE SUB WriteFileInfo (LineNumber%)
DECLARE FUNCTION DirX% (Dirspec$, Filter%, SearchType%)
CONST ALLENTRIES = 0, FILESONLY = 1, DIRSONLY = 2
CONST FALSE = 0, TRUE = NOT FALSE
CONST FINDFIRST = &H4E00, FINDNEXT = &H4F00
CONST NOTMOREFOUND = 0, ENTRYNOTMATCHEDFILTER = 1, ENTRYFOUND = 2
TYPE DTAStructure
DOS AS STRING * 19
CreateTime AS STRING * 1
Attributes AS INTEGER
AccessTime AS INTEGER
AccessDate AS INTEGER
FileSize AS LONG
Filename AS STRING * 12
END TYPE
DIM SHARED Registers AS RegTypeX
DIM SHARED DTA AS DTAStructure
'-----------------------------------
CLS
LOCATE 1, 1: PRINT "This example retries All files and Directories from your C drive in the root."
LOCATE 2, 1: PRINT "The Returned Files/Dir are put in the Variabele DTA which has the Structure"
LOCATE 3, 1: PRINT " DOS AS STRING * 19"
LOCATE 4, 1: PRINT " CreateTime AS STRING * 1"
LOCATE 5, 1: PRINT " Attributes AS INTEGER"
LOCATE 6, 1: PRINT " AccessTime AS INTEGER"
LOCATE 7, 1: PRINT " AccessDate AS INTEGER"
LOCATE 8, 1: PRINT " FileSize AS LONG"
LOCATE 9, 1: PRINT " Filename AS STRING * 12"
LOCATE 11, 1: PRINT "<Press any key to start>"
SLEEP
ShowHeader
CurrLine% = 3
Found% = DirX%("C:\*.*", ALLENTRIES, FINDFIRST)
DO WHILE Found% <> NOTMOREFOUND
IF Found% = ENTRYFOUND THEN
WriteFileInfo CurrLine%
END IF
' Search Next entry
Found% = DirX%("C:\*.*", ALLENTRIES, FINDNEXT)
LOOP
CLS
PRINT "That was it."
PRINT "Having problems or found bugs in this function? Mail me at Peterjonk@usa.net"
PRINT "Also visit the Rush site where I'm member from at: http://welcome.to/Rush"
FUNCTION DirX% (Dirspec$, Filter%, SearchType%)
'-------------------------------------------------
'FUNCTION DirX% (Dirspec$, Filter%, SearchType%)
'
'Action:
' Searches a File/Dir that matches a given up Specification
' Similair to the DOS DIR Command you can also include Wildcard chards
' Like * ? in your DirSpecification
'
'Parameters:
' DirSpec$: The DIR Specification for example C:\*.BAT or C:\*.???
' Filter% : If you only want Directories and not Files
' you can apply a filter on your Query
' Use these Constants: ALLENTRIES, FILESONLY, DIRSONLY
' SearchType%: The TYPE of search Findfirst or Findnext
' The first time you search you'll have yo Use FindFirst
' otherwise FindNext.
' Use these Constants: ALLENTRIES, FILESONLY, DIRSONLY
' FINDFIRST, FINDNEXT
'
'Function Result:
' The result of the function can be:
' NOTMOREFOUND: No more matches on your Query found
' ENTRYNOTMATCHEDFILTER: Found a match, but the Match didn't match
' your given up Filter
' If for example a Directory is found and you've
' given up FILESONLY as Filter the function
' returns this status
' ENTRYFOUND: An entry was found that matches your specification
'-----------------------------------------------------------------------
IF SearchType% <> FINDFIRST AND SearchType% <> FINDNEXT THEN EXIT FUNCTION
IF SearchType% = FINDFIRST THEN
' SETDTA
Registers.ax = &H1A00
Registers.ds = VARSEG(DTA)
Registers.dx = VARPTR(DTA)
CALL INTERRUPTX(&H21, Registers, Registers)
END IF
' Find FIRST or NEXT entry
Dirspec$ = Dirspec$ + CHR$(0)
Registers.ax = SearchType%
Registers.cx = 22
Registers.ds = VARSEG(Dirspec$)
Registers.dx = SADD(Dirspec$)
CALL INTERRUPTX(&H21, Registers, Registers)
' Look after the INT21H call if matches are found
IF Registers.flags AND 1 THEN 'is CF set?
DirX% = NOTMOREFOUND
EXIT FUNCTION
END IF
' Do we have to apply a filter?
Result% = TRUE
SELECT CASE Filter%
CASE FILESONLY
IF DTA.Attributes% = 4096 THEN Result% = FALSE
CASE DIRSONLY
IF DTA.Attributes% <> 4096 THEN Result% = FALSE
END SELECT
IF Result% = TRUE THEN
' Remove the 0 byte that ends up the String in DTA.Filename
NullByte% = INSTR(DTA.Filename, CHR$(0))
IF NullByte% > 0 THEN
DTA.Filename = LEFT$(DTA.Filename, NullByte% - 1) + SPACE$(14 - NullByte%)
END IF
DirX% = ENTRYFOUND
ELSE
DirX% = ENTRYNOTMATCHEDFILTER
END IF
END FUNCTION
SUB ShowHeader
CLS
LOCATE 1, 1: PRINT "Name Type FileSize"
LOCATE 2, 1: PRINT "--------------------------------"
END SUB
SUB WriteFileInfo (LineNumber%)
LOCATE LineNumber%, 1: PRINT DTA.Filename
IF DTA.Attributes = 4096 THEN
LOCATE LineNumber%, 15: PRINT "<DIR>"
END IF
LOCATE LineNumber%, 24: PRINT DTA.FileSize
LineNumber% = LineNumber% + 1
IF LineNumber% = 23 THEN
LOCATE 23, 1: PRINT "<Press a key>": SLEEP
ShowHeader
LineNumber% = 3
END IF
END SUB
you can use the following file-existence detection function. If, for example,
EXIST("C:\MYDIR\JOEY.BAS")
returns any integer but 2 or 3, the C drive and directory \MYDIR on it both exist (but the file JOEY.BAS may or may not--it's just a dummy file name to make the routine work). If it returns 3, either the drive or directory doesn't exist (or both don't). (If it returns 2, the routine doesn't have a clue what's going on. I've never seen it return 2, though.)
'
' This function can be used by QB/Qbasic programs to determine if a file
' (FILE$ in the parameter list) exists. It returns an INTEGER 0 if the
' file doesn't exist, 1 if it does, 3 if the path-specification (if
' included in the file name) is invalid (which may for all intents and
' purposes be the same as the file not existing), and 2 if the function,
' for some reason, cannot determine whether or not the file exists.
'
' Your MAIN routine must include the following DECLARE statement.
'
' DECLARE FUNCTION EXIST%(FILE$)
'
DEFINT E
FUNCTION EXIST%(FILE$)
'
' Alias input file name with F$ and make latter asciiz string.
'
F$=RTRIM$(LTRIM$(FILE$))+CHR$(0)
'
' Set up machine code to open file for read-only access and call it.
'
DIM MCODE(1 TO 21) AS INTEGER,AX AS INTEGER,CF AS INTEGER,SM AS INTEGER
DIM OS AS INTEGER,OSC AS INTEGER
SM=VARSEG(F$) : OS=SADD(F$)
DEF SEG=VARSEG(MCODE(1))
OSC=VARPTR(MCODE(1))
POKE OSC,&H55 'PUSH BP
POKE OSC+1,&H89 : POKE OSC+2,&HE5 'MOV BP,SP
POKE OSC+3,&HB8 : POKE OSC+4,0 : POKE OSC+5,&H3D 'MOV AX,3D00
POKE OSC+6,&HBB 'MOV BX,[SM]
POKE OSC+7,SM AND &HFF
POKE OSC+8,(SM AND &HFF00&)/256
POKE OSC+9,&H8E : POKE OSC+10,&HDB 'MOV DS,BX
POKE OSC+11,&HBA 'MOV DX,[OS]
POKE OSC+12,OS AND &HFF
POKE OSC+13,(OS AND &HFF00&)/256
POKE OSC+14,&HCD : POKE OSC+15,&H21 'INT 21
POKE OSC+16,&H89 : POKE OSC+17,&HC3 'MOV BX,AX
POKE OSC+18,&H9F 'LAHF
POKE OSC+19,&H8B : POKE OSC+20,&H7E : POKE OSC+21,6 'MOV DI,[BP+6]
POKE OSC+22,&H89 : POKE OSC+23,&H1D 'MOV [DI],BX
POKE OSC+24,&H8B : POKE OSC+25,&H7E : POKE OSC+26,8 'MOV DI,[BP+8]
POKE OSC+27,&H89 : POKE OSC+28,5 'MOV [DI],AX
POKE OSC+29,&H5D 'POP BP
POKE OSC+30,&HCA : POKE OSC+31,4 : POKE OSC+32,0 'RETF 4
'
' The following is to close the file (thus freeing the handle) if a file
' gets opened.
'
POKE OSC+33,&HB4 : POKE OSC+34,&H3E 'MOV AH,3E
POKE OSC+35,&HBB : POKE OSC+36,0 : POKE OSC+37,0 'MOV BX,[HANDLE]
POKE OSC+38,&HCD : POKE OSC+39,&H21 'INT 21
POKE OSC+40,&HCB 'RETF
CALL ABSOLUTE(CF,AX,OSC)
'
' Get carry flag. If it's zero, file exists. If it's not zero,
' file either doesn't or interrupt call failed for some other reason.
'
CF=((CF AND &HFF00&)/256) AND 1%
IF CF=0 THEN
'
' File exists. Close it, set function value, and return. (The values
' originally put at offsets 36 and 37 in the machine code were dummy.
' They're made real here, now that the file handle is known.)
'
POKE OSC+36,AX AND &HFF : POKE OSC+37,(AX AND &HFF00&)/256
CALL ABSOLUTE(OSC+33)
EX=1 'Temporary function value
ELSE
'
' Interrupt call couldn't find file. Find out why (look at the value of
' AX returned).
'
IF AX=2 THEN
'
' It apparently failed because file doesn't exist. Set function value
' and return.
'
EX=0
ELSE
'
' Interrupt call failed for some other reason. Set function value to 2
' and return. An exception is if the reason for failure is an invalid
' path-specification. In that event, the file certainly doesn't exist.
' However, in that special case, set function value to 3 (which is the
' value of the error code in this case).
'
EX=2 : IF AX=3 THEN EX=AX
END IF
END IF
DEF SEG
EXIST=EX
END FUNCTION
DEFSNG E