home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / qbfaqr01 / dos / dirsubs.bas < prev    next >
Encoding:
BASIC Source File  |  1991-05-06  |  6.2 KB  |  180 lines
  1. DEFINT A-Z
  2. '$INCLUDE: 'DIR.BI'  '***DirSubs header file***
  3.  
  4. FUNCTION FreeSpace& (FCurrentDrive AS INTEGER)
  5.      '*** Return free disk space of drive as pointed to by FCurrentDrive ***
  6.      '*** Where 0 = default, 1=A, 2=B, 3=C etc. ***
  7.  
  8.      Dregs.AX = &H3600
  9.      Dregs.DX = FCurrentDrive
  10.      CALL InterruptX(&H21, Dregs, Dregs)   '***Get bytes free***
  11.      FreeSpace& = CLNG(Dregs.AX) * Dregs.BX * Dregs.CX
  12.  
  13. END FUNCTION
  14.  
  15. FUNCTION GetCurrentDrive%
  16.     '*** Returns default drive number ***
  17.  
  18.     Dregs.AX = &H1900
  19.     CALL InterruptX(&H21, Dregs, Dregs)
  20.     GetCurrentDrive% = (Dregs.AX AND 255) + 1 '***A=1, B=2. C=3 etc.***
  21.  
  22. END FUNCTION
  23.  
  24. FUNCTION GetNumberOfDrives
  25.    '***Returns number of drives or LASTDRIVE whichever is greater***
  26.  
  27.    CurrentDrive = GetCurrentDrive% '*** Save current logged drive ***
  28.    Dregs.AX = &HE00
  29.    Dregs.DX = 0                    '*** Set to drive A (all pc's should have) ***
  30.    CALL InterruptX(&H21, Dregs, Dregs)
  31.    GetNumberOfDrives = (Dregs.AX AND 15)
  32.    Dregs.AX = &HE00
  33.    Dregs.DX = CurrentDrive - 1     '*** Restore drive to default ***
  34.    CALL InterruptX(&H21, Dregs, Dregs)
  35.  
  36. END FUNCTION
  37.  
  38. FUNCTION GetVolumeName$ (VDir$)
  39. '***Returns volume name of disk referenced by VDir$)
  40.  
  41. DIM FileSpec AS STRING * 60
  42. FileSpec = VDir$ + "*.*" + CHR$(0)
  43.  
  44. Dregs.DS = VARSEG(DInfo)            '*** Set Pointers to temporary storage array ***
  45. Dregs.DX = VARPTR(DInfo)
  46. Dregs.AX = &H1A00                   '*** Interrupt $21, Function $1A ***
  47. CALL InterruptX(&H21, Dregs, Dregs) '*** Set disk xfer address ***
  48. Dregs.AX = &H4E00                   '*** Find First entry ***
  49. Dregs.CX = 8                        '*** Only Volume Name returned ***
  50. VSEG% = VARSEG(FileSpec)            '*** Set pointers to FileSpec ***
  51. VPTR% = VARPTR(FileSpec)
  52.  
  53. DoneFlag = FALSE
  54. DO
  55.    Dregs.DS = VSEG%
  56.    Dregs.DX = VPTR%
  57.    CALL InterruptX(&H21, Dregs, Dregs)  '***1st time AX=$4E (find 1st entry) ***
  58.    IF (Dregs.FLAGS AND 1) = FALSE THEN  '***Entry is found***
  59.        IF (ASC(DInfo.ATT) AND 8) = 8 THEN
  60.       VolumeName$ = DInfo.FName
  61.       Period = INSTR(DInfo.FName, ".")
  62.       IF Period <> 0 THEN
  63.          VolumeName$ = LEFT$(DInfo.FName, Period - 1) + MID$(DInfo.FName, Period + 1, LEN(DInfo.FName))
  64.       ELSE
  65.          VolumeName$ = DInfo.FName
  66.       END IF
  67.       GetVolumeName$ = LEFT$(VolumeName$, INSTR(VolumeName$, CHR$(0)) - 1)
  68.       DoneFlag = True               '***If found then quit looking ***
  69.        END IF
  70.        Dregs.AX = &H4F00  '***Read next entry***
  71.    ELSE
  72.        DoneFlag = True    '***No more entries***
  73.    END IF
  74. LOOP UNTIL DoneFlag = True
  75.  
  76. END FUNCTION
  77.  
  78. DEFSNG A-Z
  79. FUNCTION ReadDir& (RDIR$, RFTYPE$)
  80.     
  81.     '*** READS DIRECTORY INTO TD.Info() ARRAY ***
  82.     '*** Returns the number of files found ***
  83.     '*** RDIR$=directory path..must end with \  or left blank for current***
  84.     '*** RFTYPE$=parameters such as *.* ***
  85.  
  86.     DIM FileSpec AS STRING * 60
  87.     FileSpec = RDIR$ + RFTYPE$ + CHR$(0)
  88.  
  89.     FI = 0
  90.  
  91.     Dregs.DS = VARSEG(DInfo)  '*** Set Pointers to temporary storage array ***
  92.     Dregs.DX = VARPTR(DInfo)
  93.     Dregs.AX = &H1A00         '*** Interrupt $21, Function $1A ***
  94.     CALL InterruptX(&H21, Dregs, Dregs)  '***Set disk xfer address ***
  95.     Dregs.AX = &H4E00                    '*** Find First entry ***
  96.     Dregs.CX = 55         '*** Set to 0 to not include directories ***
  97.     VSEG% = VARSEG(FileSpec) '*** Set pointers to FileSpec ***
  98.     VPTR% = VARPTR(FileSpec)
  99.  
  100.      DoneFlag = FALSE
  101.      DO
  102.     Dregs.DS = VSEG%
  103.     Dregs.DX = VPTR%
  104.     CALL InterruptX(&H21, Dregs, Dregs)  '***1st time AX=$4E (find 1st entry) ***
  105.     IF (Dregs.FLAGS AND 1) = FALSE THEN  '***Entry is found***
  106.         FI = FI + 1
  107.         '***Get filename***
  108.         F$ = DInfo.FName
  109.         TDInfo(FI).FName = LEFT$(F$, INSTR(F$, CHR$(0)) - 1)
  110.         TDInfo(FI).Date = "  -  -    "
  111.         TDInfo(FI).Time = "  :  :  "
  112.         '***Assemble date***
  113.         MID$(TDInfo(FI).Date, 1, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Date AND 480) \ 32)), 2)
  114.         MID$(TDInfo(FI).Date, 4, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Date AND 31))), 2)
  115.         MID$(TDInfo(FI).Date, 7, 4) = LTRIM$(STR$((DInfo.Date AND 65024) \ 512 + 1980))
  116.         '***Assemble Time***
  117.         MID$(TDInfo(FI).Time, 1, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Time AND 63488) \ 2048)), 2)
  118.         MID$(TDInfo(FI).Time, 4, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Time AND 2016) \ 32)), 2)
  119.         MID$(TDInfo(FI).Time, 7, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Time AND 31))), 2)
  120.         '***Get filesize***'
  121.         TDInfo(FI).Size = DInfo.Size
  122.         '***Set attributes***
  123.         TDInfo(FI).D = (ASC(DInfo.ATT) AND 16) = 16
  124.         TDInfo(FI).R = (ASC(DInfo.ATT) AND 1) = 1
  125.         TDInfo(FI).A = (ASC(DInfo.ATT) AND 32) = 32
  126.         TDInfo(FI).S = (ASC(DInfo.ATT) AND 4) = 4
  127.         TDInfo(FI).H = (ASC(DInfo.ATT) AND 2) = 2
  128.         IF TDInfo(FI).S = True OR TDInfo(FI).H = True THEN
  129.            '***Make System or Hidden files lower case***
  130.            TDInfo(FI).FName = LCASE$(TDInfo(FI).FName)
  131.            'FI = FI - 1 '***Remove REM to not display System/Hidden files***
  132.         END IF
  133.         Dregs.AX = &H4F00  '***Read next entry***
  134.     ELSE
  135.         DoneFlag = True    '***No more entries***
  136.     END IF
  137.      LOOP UNTIL DoneFlag = True
  138.      ReadDir = FI  '***Return number of entries found***
  139. END FUNCTION
  140.  
  141. SUB SortDir (SNumberOfFiles AS INTEGER)
  142.     '***SORT DIRECTORY BY FILENAME (SHELL SORT)***
  143.     '***Sorts in ascending order***
  144.  
  145.     '***Set number of passes required to sort array***
  146.     IF SNumberOfFiles = 0 THEN
  147.        TPASS = 0
  148.     ELSE
  149.        TPASS = INT(LOG(SNumberOfFiles) / LOG(2))
  150.     END IF
  151.  
  152.     MidPoint = SNumberOfFiles
  153.   
  154.     '***SORT DIRECTORY***
  155.     FOR L = 1 TO TPASS
  156.     MidPoint = MidPoint \ 2
  157.     FOR I = MidPoint TO SNumberOfFiles - 1
  158.         FOR J = (I - MidPoint + 1) TO 1 STEP -MidPoint
  159.         IF (UCASE$(TDInfo(J).FName) > UCASE$(TDInfo(J + MidPoint).FName)) THEN
  160.            '***Put directories at top of listing***
  161.            IF TDInfo(J).D = True AND TDInfo(J + MidPoint).D = FALSE THEN
  162.               EXIT FOR
  163.            ELSE
  164.               SWAP TDInfo(J), TDInfo(J + MidPoint)
  165.            END IF
  166.         ELSE
  167.            IF TDInfo(J).D = FALSE AND TDInfo(J + MidPoint).D = True THEN
  168.               SWAP TDInfo(J), TDInfo(J + MidPoint)
  169.            ELSE
  170.               EXIT FOR
  171.            END IF
  172.         END IF
  173.         NEXT J
  174.     NEXT I
  175.     NEXT L
  176.     '*********************
  177.  
  178. END SUB
  179.  
  180.