DECLARE SUB ShowFileAttributes (Attributes%)
DECLARE SUB GetSetFileAttr (Operation%, FileName$,_
                            Attributes%)
DECLARE SUB DoDosCall (FileName$)
DECLARE FUNCTION Exist% (FileName$)

' Demonstrates how to change a file's attributes

' If you don't have MS PDS 7.0, change all
' occurrences of SSEG to VARSEG.

DEFINT A-Z

'  QB 4.5 users should use the QB.BI file in the 
'  next instruction

'$INCLUDE: 'QBX.BI'

' Version 7.0 users MUST use RegTypeX instead of
' RegType because of far strings.  Note that error
' trapping code is not included. In your programs,
' you may want to handle error trapping in the
' event of "critical" errors.

DIM SHARED InRegs AS RegTypeX, OutRegs AS RegTypeX

INPUT "Enter file name or <Enter> to end: ", A$
IF LEN(A$) = 0 THEN END

PRINT
																  
IF Exist(A$) THEN ' If file exists, get attributes
	GetSetFileAttr 0, A$, Attributes%
	PRINT "The file's attributes are:"
	ShowFileAttributes Attributes%

	PRINT " 0 = Normal, non-archived file"
	PRINT " 1 = Read-only"
	PRINT " 2 = Hidden"
	PRINT " 4 = System"
	PRINT "32 = Archive"
	PRINT
	INPUT _
   "Enter any combination of the above numbers:",_
	  NewAttributes%

' Set the new attributes

	GetSetFileAttr 1, A$, NewAttributes%

' Check results by getting the file's attributes

	GetSetFileAttr 0, A$, Attributes%
	PRINT
	PRINT "The file's attributes were changed to:"
	ShowFileAttributes Attributes%
ELSE
	PRINT "File does not exist,"
	PRINT "so we can't change the attributes!"
END IF

SUB DoDosCall (FileName$)

' This SUB was created because the same code is
' used by both the Exist% FUNCTION and the
' GetSetFileAttr SUBprogram

' DOS requires an ASCIIZ string so add CHR$(0)
	 Spec$ = FileName$ + CHR$(0) 
	 InRegs.ds = SSEG(Spec$) ' Load DS:DX with
	 InRegs.dx = SADD(Spec$) ' address of Spec$
	 CALL InterruptX(&H21, InRegs, OutRegs) ' CALL DOS

END SUB

FUNCTION Exist% (FileName$)
' See if a given file exists using
' DOS "Search for first match" service &H4E
	 InRegs.ax = &H4E00 
	 InRegs.cx = 63  ' Search for all files
	 DoDosCall (FileName$)
' If AX contains a value, then file does not exist
	 SELECT CASE OutRegs.ax
       CASE 0
          Exist% = -1
       CASE ELSE
          Exist% = 0
	 END SELECT
END FUNCTION

SUB GetSetFileAttr (Operation%, FileName$,_
                    Attributes%)
' Operation: 0 = Get file attributes
'            1 = Set file attributes
	InRegs.cx = Attributes%
	InRegs.ax = &H4300 + Operation%
	DoDosCall (FileName$)
'If getting attributes, then return them
	IF Operation% = 0 THEN Attributes% = OutRegs.cx
END SUB

SUB ShowFileAttributes (Attributes%)

	IF Attributes% = 0 THEN
		Lin$ = "None"
	END IF
	IF (Attributes% AND 1) = 1 THEN
		Lin$ = Lin$ + "Read-only  "
	END IF
	IF (Attributes% AND 2) = 2 THEN
		Lin$ = Lin$ + "Hidden  "
	END IF
	IF (Attributes% AND 4) = 4 THEN
		Lin$ = Lin$ + "System  "
	END IF
	IF (Attributes% AND 8) = 8 THEN
		Lin$ = Lin$ + "Volume label  "
	END IF
	IF (Attributes% AND 16) = 16 THEN
		Lin$ = Lin$ + "Subdirectory  "
	END IF
	IF (Attributes% AND 32) = 32 THEN
		Lin$ = Lin$ + "Archive  "
	END IF
	PRINT Lin$
	PRINT
END SUB