home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
ins_msb
/
9004
/
fileattr.bas
< prev
next >
Wrap
BASIC Source File
|
1990-04-01
|
3KB
|
129 lines
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