home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / IMB9005.ZIP / FCBLABEL.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-05-01  |  3.9 KB  |  169 lines
  1. 'PROGRAM - FCBLABEL.BAS
  2.  
  3. 'Microsoft BASIC module for manipulating volume
  4. 'labels
  5.  
  6. 'BASIC Version 7.0 users should change the next
  7. 'line to use the QBX.BI file
  8.  
  9. '$INCLUDE: 'QB.BI'
  10. '$INCLUDE: 'FCBLABEL.BI'
  11.  
  12. TYPE ExtendedFCBRecord
  13.     ExtFCB   AS STRING * 1
  14.     Res1     AS STRING * 5
  15.     Attr     AS STRING * 1
  16.     Drive    AS STRING * 1
  17.     Name1    AS STRING * 11
  18.     Unused1  AS STRING * 5
  19.     Name2    AS STRING * 11
  20.     Unused2  AS STRING * 9
  21. END TYPE
  22.  
  23. FUNCTION DeleteDiskID% (Drive$)
  24.  
  25.     DIM EFCB AS ExtendedFCBRecord
  26.     DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
  27.  
  28.     EFCB.ExtFCB = CHR$(&HFF)  'Set EFCB flag
  29.     EFCB.Attr = CHR$(&H8)     'Vol label attribute
  30.     EFCB.Drive = CHR$(ASC(Drive$) - 64)
  31.     EFCB.Name1 = "*.*        "
  32.  
  33.     InRegsX.ax = &H1300        'Call find first FCB
  34.     InRegsX.ds = VARSEG(EFCB)  'Load DS:DX with
  35.     InRegsX.dx = VARPTR(EFCB)  'address of EFCB
  36.     CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
  37.  
  38. 'Set error codes
  39.  
  40.     IF Lo(OutRegsX.ax) = 0 THEN     'Successful
  41.         DeleteDiskID = -1 'True
  42.     ELSE
  43.         DeleteDiskID = 0  'False
  44.     END IF
  45.  
  46. END FUNCTION
  47.  
  48. FUNCTION GetDiskID$ (Drive$)
  49.     DIM EFCB AS ExtendedFCBRecord
  50.     DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
  51.  
  52. '  Get Address of Data Transfer Area (DTA)
  53.  
  54.     CALL GetDTAAddr(Segment, Offset)
  55.  
  56. '  Call the Find First FCB function
  57. '  using the Volume attribute
  58.  
  59.     EFCB.ExtFCB = CHR$(&HFF)   'Set EFCB flag
  60.     EFCB.Attr = CHR$(&H8)      'Vol label attribute
  61.     EFCB.Drive = CHR$(ASC(Drive$) - 64)
  62.     EFCB.Name1 = "*.*        "
  63.     InRegsX.ax = &H1100        'Call find first FCB
  64.     InRegsX.ds = VARSEG(EFCB)  'Load DS:DX with
  65.     InRegsX.dx = VARPTR(EFCB)  'address of EFCB
  66.     CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
  67.  
  68.     GetDiskID$ = ""
  69.  
  70.     IF Lo(OutRegsX.ax) = 0 THEN  'Successful
  71.         VOL$ = ""
  72.         DEF SEG = Segment       'Set Segment to DTA
  73.         FOR I = Offset + 8 TO Offset + 18
  74.             VOL$ = VOL$ + CHR$(PEEK(I))
  75.         NEXT I
  76.         DEF SEG
  77.         GetDiskID$ = VOL$
  78.     END IF
  79. END FUNCTION
  80.  
  81. SUB GetDTAAddr (Segment, Offset)
  82.  
  83.     DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
  84.  
  85.     InRegsX.ax = &H2F00
  86.     CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
  87.     Segment = OutRegsX.es   'Return address of DTA
  88.     Offset = OutRegsX.bx    'Segment:Offset format
  89.  
  90. END SUB
  91.  
  92. FUNCTION Lo (IntegerVar)
  93.     Lo = IntegerVar MOD 256
  94. END FUNCTION
  95.  
  96. FUNCTION RenameDiskID_
  97.                 (Drive$, OldDiskID$, NewDiskID$)
  98.  
  99.     DIM EFCB AS ExtendedFCBRecord
  100.     DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
  101.  
  102. 'EFCB setup
  103.  
  104.     EFCB.ExtFCB = CHR$(&HFF) 'Set EFCB flag
  105.     EFCB.Attr = CHR$(&H8)    'Vol label attribute
  106.     EFCB.Drive = CHR$(ASC(Drive$) - 64)
  107.  
  108. 'Rename specific instructions
  109.  
  110.     L = LEN(OldDiskID$)
  111.     IF L < 11 THEN
  112.         OldDiskID$ = OldDiskID$ + SPACE$(11 - L)
  113.     END IF
  114.     EFCB.Name1 = OldDiskID$
  115.  
  116.     L = LEN(NewDiskID$)
  117.     IF L < 11 THEN
  118.         NewDiskID$ = NewDiskID$ + SPACE$(11 - L)
  119.     END IF
  120.     EFCB.Name2 = NewDiskID$
  121.  
  122. '  Call Service 17H to RENAME a volume label
  123.  
  124.     InRegsX.ax = &H1700        'Call find first FCB
  125.     InRegsX.ds = VARSEG(EFCB)  'Load DS:DX with
  126.     InRegsX.dx = VARPTR(EFCB)  'address of EFCB
  127.     CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
  128.  
  129. 'Set error codes
  130.  
  131.     IF Lo(OutRegsX.ax) = 0 THEN     'Successful
  132.         RenameDiskID = -1 'True
  133.     ELSE
  134.         RenameDiskID = 0  'False
  135.     END IF
  136.  
  137. END FUNCTION
  138.  
  139. FUNCTION SetDiskID (Drive$, VolumeName$)
  140.  
  141.     DIM EFCB AS ExtendedFCBRecord
  142.     DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
  143.  
  144.     CALL GetDTAAddr(Segment, Offset)
  145.  
  146. '  Call the Find First FCB function
  147. '  using the Volume attribute
  148.  
  149.     EFCB.ExtFCB = CHR$(&HFF) 'Set EFCB flag
  150.     EFCB.Attr = CHR$(&H8)    'Vol label attribute
  151.     EFCB.Drive = CHR$(ASC(Drive$) - 64)
  152.     L = LEN(VolumeName$)
  153.     IF L < 11 THEN
  154.         VolumeName$ = VolumeName$ + SPACE$(11 - L)
  155.     END IF
  156.     EFCB.Name1 = VolumeName$
  157.     InRegsX.ax = &H1600        'Call find first FCB
  158.     InRegsX.ds = VARSEG(EFCB)  'Load DS:DX with
  159.     InRegsX.dx = VARPTR(EFCB)  'address of EFCB
  160.     CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
  161.  
  162.     IF Lo(OutRegsX.ax) = 0 THEN     'Successful
  163.         SetDiskID = -1 'True
  164.     ELSE
  165.         SetDiskID = 0  'False
  166.     END IF
  167. END FUNCTION
  168.  
  169.