Posts: 43
Threads: 13
Joined: Nov 2002
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.
Posts: 1,166
Threads: 62
Joined: Apr 2003
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
am an asshole. Get used to it.
Posts: 704
Threads: 0
Joined: Dec 2002
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
ravelling Curmudgeon
(geocities sites require copying and pasting URLs.)
I liked spam better when it was something that came in a can.
Windows should be defenestrated.
Posts: 43
Threads: 13
Joined: Nov 2002
Thanks for your help
|
