Qbasicnews.com
December 15, 2019, 04:12:50 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: Checking for duplicates...  (Read 1232 times)
joey7643
Member
*
Posts: 59


« on: April 16, 2003, 11:36:05 PM »

Good evening (here, anyway  Cheesy )

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.  Smiley

Thanks for any help you can provide.
Logged
Ninkazu
Been there, done that
*****
Posts: 1169



WWW
« Reply #1 on: April 17, 2003, 12:00:30 AM »

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
Logged

am an asshole. Get used to it.
Glenn
I hold this place together
*****
Posts: 786



WWW
« Reply #2 on: April 17, 2003, 02:02:13 AM »

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
Logged

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.
joey7643
Member
*
Posts: 59


« Reply #3 on: April 17, 2003, 11:07:29 AM »

Thanks for your help  Cheesy
Logged
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!