home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 11 Util / 11-Util.zip / FREE.ZIP / FREE.BAS next >
BASIC Source File  |  1990-08-12  |  5KB  |  116 lines
  1. ' --- FREE 1.2 - OS/2 by Stu Sims
  2. ' --- Copyright (C) 1989,1990 Stuart P. Sims
  3. '                             Software Technologies
  4. '                             1825 23rd Avenue
  5. '                             San Francisco, CA  94122
  6. '                             USA
  7. '                             (415) 731-2222
  8. ' "Free 1.2" - OS/2 - A utility to show available disk space and drive
  9. '                     statistics.  Inspired by Art Merrill's similar utility
  10. '                     for DOS. Demonstrates use of system calls and standard
  11. '                     error handling using OS/2 and BC.
  12. '
  13. ' The right to use this software in its original unmodified form is granted
  14. ' for non-commercial purposes.  Commercial users should contact
  15. ' Software Technologies for details on site licensing.
  16. '                              
  17. ' Inquiries and comments may also be sent through CIS to Stu Sims (74146,2010)
  18. '
  19. ' This program was created using the QB environment running in the DOS box
  20. ' and compiled in protected mode.
  21. '
  22. ' Modification History
  23. '   July 10, 1989       Version 1.0   BC 6.0
  24. '   November 10, 1989   Version 1.1   add support for drive parameter on
  25. '                      command line
  26. '   August 12, 1990     Version 1.2 - support for drives up to 99 gigabytes
  27. '                                     recompiled with BC 7.1 using PWB
  28. '
  29. DEFINT A-Z
  30. REM $INCLUDE: 'bsedosfl.bi'
  31. REM $INCLUDE: 'bsedospc.bi'
  32.  
  33. CONST QFSInfoBufferSize = 18            ' Size in bytes of required buffer to
  34.                     ' receive disk information
  35. CONST QFSLabelBufferSize = 255          ' Size of label buffer
  36.  
  37. TYPE QFSInfoLevelOne
  38.    FileSystemID AS LONG
  39.    SectorsPerAllocUnit AS LONG
  40.    TotalAllocUnit AS LONG
  41.    AvailableAllocUnit AS LONG
  42.    BytesPerSector AS INTEGER
  43. END TYPE
  44.  
  45. TYPE QFSInfoLevelTwo
  46.    VolumeLabelDate AS INTEGER
  47.    VolumeLabelTime AS INTEGER
  48.    VolumeLabelLength AS STRING * 1
  49.    VolumeLabel AS STRING * QFSLabelBufferSize
  50. END TYPE
  51.  
  52. TYPE GetMessageInsertStrings
  53.    InsertStrings AS STRING * 256
  54. END TYPE
  55.  
  56. DIM FreeDiskSpace AS LONG
  57. DIM TotalDiskSpace AS LONG
  58. DIM QFSInfoBuffer AS QFSInfoLevelOne
  59. DIM QFSLabelBuffer AS QFSInfoLevelTwo
  60. DIM GetMessageBuffer AS STRING * 1024
  61. DIM GetMessageLength AS INTEGER
  62. DIM MessageFileString AS STRING * 256
  63.  
  64. MessageFileString = "OSO001.MSG" + CHR$(0)      ' ASCIIZ string with OS/2
  65.                         ' message file name
  66.  
  67. Drive = 0                                       ' Set default drive to current drive
  68. IF LEN(COMMAND$) <> 0 THEN                      ' Convert 1st character to
  69.    Drive = ASC(LEFT$(COMMAND$, 1)) - ASC("A") + 1  ' a drive number
  70. END IF
  71.  
  72. ' --- Check that drive exists and is working.
  73. '     Get volume label (if any).
  74. ReturnCode = DosQFSInfo(Drive, 2, VARSEG(QFSLabelBuffer), VARPTR(QFSLabelBuffer), QFSLabelBufferSize)
  75. SELECT CASE ReturnCode
  76.    CASE 0                ' Has a volume label
  77.       Length = ASC(QFSLabelBuffer.VolumeLabelLength)
  78.       Label$ = LEFT$(QFSLabelBuffer.VolumeLabel, Length)
  79.    CASE 125                ' No volume label
  80.       Label$ = "Unlabeled Disk"
  81.       Length = LEN(Label$)
  82.    CASE ELSE                    ' Invalid disk or other error, use OS/2 error
  83.                 ' code to print error message, then exit.
  84.       MessageFileSeg = VARSEG(MessageFileString)
  85.       MessageFileOffset = VARPTR(MessageFileString)
  86.       MessageFile = DosGetMessage(MessageFileSeg, MessageFileOffset, 0, VARSEG(GetMessageBuffer), VARPTR(GetMessageBuffer), 1024, ReturnCode, MessageFileSeg, MessageFileOffset, SEG GetMessageLength)
  87.       PRINT LEFT$(GetMessageBuffer, GetMessageLength)
  88.       CALL DosExit(2, ReturnCode)       ' Pass return code to caller
  89. END SELECT
  90.  
  91. ' --- Get drive information
  92.  
  93. ReturnCode = DosQFSInfo(Drive, 1, VARSEG(QFSInfoBuffer), VARPTR(QFSInfoBuffer), QFSInfoBufferSize)
  94. IF ReturnCode <> 0 THEN                 ' This is unlikely, but...
  95.    CALL DosExit(1, ReturnCode)
  96. END IF
  97.  
  98. ' --- Calculate free disk space and total disk space
  99.  
  100. FreeDiskSpace = QFSInfoBuffer.SectorsPerAllocUnit * QFSInfoBuffer.AvailableAllocUnit * QFSInfoBuffer.BytesPerSector
  101. TotalDiskSpace = QFSInfoBuffer.SectorsPerAllocUnit * QFSInfoBuffer.TotalAllocUnit * QFSInfoBuffer.BytesPerSector
  102.  
  103. PRINT
  104. PRINT "Free 1.2 - OS/2 by Stu Sims"
  105. PRINT
  106. PRINT Label$; " Statistics"
  107. PRINT USING "##,###,###,### Allocation Units"; QFSInfoBuffer.TotalAllocUnit
  108. PRINT USING "##,###,###,### Sectors per Allocation Unit"; QFSInfoBuffer.SectorsPerAllocUnit
  109. PRINT USING "##,###,###,### Bytes per Sector"; QFSInfoBuffer.BytesPerSector
  110.  
  111. PRINT USING "##,###,###,### Bytes total disk space"; TotalDiskSpace
  112. PRINT USING "##,###,###,### Bytes allocated"; TotalDiskSpace - FreeDiskSpace
  113. PRINT USING "##,###,###,### Bytes free"; FreeDiskSpace
  114.  
  115. END
  116.