home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / IMB9004.ZIP / FILEATTR.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-04-01  |  3.2 KB  |  129 lines
  1. DECLARE SUB ShowFileAttributes (Attributes%)
  2. DECLARE SUB GetSetFileAttr (Operation%, FileName$,_
  3.                             Attributes%)
  4. DECLARE SUB DoDosCall (FileName$)
  5. DECLARE FUNCTION Exist% (FileName$)
  6.  
  7. ' Demonstrates how to change a file's attributes
  8.  
  9. ' If you don't have MS PDS 7.0, change all
  10. ' occurrences of SSEG to VARSEG.
  11.  
  12. DEFINT A-Z
  13.  
  14. '  QB 4.5 users should use the QB.BI file in the 
  15. '  next instruction
  16.  
  17. '$INCLUDE: 'QBX.BI'
  18.  
  19. ' Version 7.0 users MUST use RegTypeX instead of
  20. ' RegType because of far strings.  Note that error
  21. ' trapping code is not included. In your programs,
  22. ' you may want to handle error trapping in the
  23. ' event of "critical" errors.
  24.  
  25. DIM SHARED InRegs AS RegTypeX, OutRegs AS RegTypeX
  26.  
  27. INPUT "Enter file name or <Enter> to end: ", A$
  28. IF LEN(A$) = 0 THEN END
  29.  
  30. PRINT
  31.                                                                   
  32. IF Exist(A$) THEN ' If file exists, get attributes
  33.     GetSetFileAttr 0, A$, Attributes%
  34.     PRINT "The file's attributes are:"
  35.     ShowFileAttributes Attributes%
  36.  
  37.     PRINT " 0 = Normal, non-archived file"
  38.     PRINT " 1 = Read-only"
  39.     PRINT " 2 = Hidden"
  40.     PRINT " 4 = System"
  41.     PRINT "32 = Archive"
  42.     PRINT
  43.     INPUT _
  44.    "Enter any combination of the above numbers:",_
  45.       NewAttributes%
  46.  
  47. ' Set the new attributes
  48.  
  49.     GetSetFileAttr 1, A$, NewAttributes%
  50.  
  51. ' Check results by getting the file's attributes
  52.  
  53.     GetSetFileAttr 0, A$, Attributes%
  54.     PRINT
  55.     PRINT "The file's attributes were changed to:"
  56.     ShowFileAttributes Attributes%
  57. ELSE
  58.     PRINT "File does not exist,"
  59.     PRINT "so we can't change the attributes!"
  60. END IF
  61.  
  62. SUB DoDosCall (FileName$)
  63.  
  64. ' This SUB was created because the same code is
  65. ' used by both the Exist% FUNCTION and the
  66. ' GetSetFileAttr SUBprogram
  67.  
  68. ' DOS requires an ASCIIZ string so add CHR$(0)
  69.      Spec$ = FileName$ + CHR$(0) 
  70.      InRegs.ds = SSEG(Spec$) ' Load DS:DX with
  71.      InRegs.dx = SADD(Spec$) ' address of Spec$
  72.      CALL InterruptX(&H21, InRegs, OutRegs) ' CALL DOS
  73.  
  74. END SUB
  75.  
  76. FUNCTION Exist% (FileName$)
  77. ' See if a given file exists using
  78. ' DOS "Search for first match" service &H4E
  79.      InRegs.ax = &H4E00 
  80.      InRegs.cx = 63  ' Search for all files
  81.      DoDosCall (FileName$)
  82. ' If AX contains a value, then file does not exist
  83.      SELECT CASE OutRegs.ax
  84.        CASE 0
  85.           Exist% = -1
  86.        CASE ELSE
  87.           Exist% = 0
  88.      END SELECT
  89. END FUNCTION
  90.  
  91. SUB GetSetFileAttr (Operation%, FileName$,_
  92.                     Attributes%)
  93. ' Operation: 0 = Get file attributes
  94. '            1 = Set file attributes
  95.     InRegs.cx = Attributes%
  96.     InRegs.ax = &H4300 + Operation%
  97.     DoDosCall (FileName$)
  98. 'If getting attributes, then return them
  99.     IF Operation% = 0 THEN Attributes% = OutRegs.cx
  100. END SUB
  101.  
  102. SUB ShowFileAttributes (Attributes%)
  103.  
  104.     IF Attributes% = 0 THEN
  105.         Lin$ = "None"
  106.     END IF
  107.     IF (Attributes% AND 1) = 1 THEN
  108.         Lin$ = Lin$ + "Read-only  "
  109.     END IF
  110.     IF (Attributes% AND 2) = 2 THEN
  111.         Lin$ = Lin$ + "Hidden  "
  112.     END IF
  113.     IF (Attributes% AND 4) = 4 THEN
  114.         Lin$ = Lin$ + "System  "
  115.     END IF
  116.     IF (Attributes% AND 8) = 8 THEN
  117.         Lin$ = Lin$ + "Volume label  "
  118.     END IF
  119.     IF (Attributes% AND 16) = 16 THEN
  120.         Lin$ = Lin$ + "Subdirectory  "
  121.     END IF
  122.     IF (Attributes% AND 32) = 32 THEN
  123.         Lin$ = Lin$ + "Archive  "
  124.     END IF
  125.     PRINT Lin$
  126.     PRINT
  127. END SUB
  128.  
  129.