home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / utils / dskutl / swp-ms10.ark / TRAMDF.IF4 < prev    next >
Encoding:
Text File  |  1989-09-27  |  7.1 KB  |  190 lines
  1.  
  2. {* -------------------------------------------------------------------------
  3.  *           C P / M   F I L E   M A N A G E R   U T I L I T I E S
  4.  * ------------------------------------------------------------------------- *}
  5.  
  6. procedure DeleteCpmFile ;
  7. {*
  8.  * Delete the CP/M file associated with the current filelist entry.
  9.  *}
  10. var
  11.    CpmFib: CpmFibs absolute ACpmFile ;  { Type casting file -> FIB }
  12. begin
  13.    SplitFileName ( ACpmFileName, GetFileEntryName ) ;
  14.    ACpmFileName.Drive:= CpmDriveName.Drive ;
  15.    ACpmFileName.User := CpmDriveName.User ;
  16. {*
  17.  * Build the FCB for the CP/M file by the invokation of procedure Assign.
  18.  * The file attribute ReadOnly is reset, together with any other attribute,
  19.  * in order to avoid BDOS errors when deleting the file.  Note that BDOS
  20.  * errors cause a premature termination of the program: the error handler
  21.  * of TP does not gain control in such a case.
  22.  *}
  23.    RegisterFile  ( ACpmFileName, ACpmFile ) ;
  24.    Assign        ( ACpmFile, ExpandFileName(ACpmFileName,DNE_Format) ) ;
  25.    Bdos( SetFileAttributes, Addr(CpmFib.Fcb) ) ;
  26.    Erase         ( ACpmFile ) ;
  27.    UnRegisterFile( ACpmFile ) ;
  28. end ;  { of DeleteCpmFile }
  29.  
  30. function GetCpmFreeSpace : Integer ;
  31. {*
  32.  * Return the amount of free space, in KByte, on the current CP/M disk.
  33.  *}
  34. var
  35.    CpmDpb    :   ^DPBs ;  { Address of drive's DPB (XLT) }
  36.    BitMap    : Integer ;  { Address in memory of allocation bitmap }
  37.    FreeBlocks: Integer ;  { Number of free blocks on disk }
  38.    BitNumber : Integer ;  { Ordinal of next bit to test }
  39.    I         : Integer ;  { Loop control variable }
  40. begin
  41.    CpmCurrentDrive:= BdosHL( GetCurrentDrive ) ;
  42.  
  43.    Bdos( SetCurrentDrive, CpmDrive ) ;  { Login CP/M disk, build bitmap }
  44.    CpmDpb    := DriveAttribute[ExtractDisk(CpmDriveName)].DpbAddress ;
  45.    BitMap    := BdosHL( GetAllocationMap ) ;
  46.    FreeBlocks:= 0 ;
  47.    for I:= 0 to CpmDpb^.DSM do
  48.     begin
  49.      BitNumber:= I and $0007 ;
  50.      if ((Mem[BitMap] shr BitNumber) and $01)=$00 then
  51.        FreeBlocks:= Succ( FreeBlocks ) ;
  52.      if BitNumber=7 then
  53.        BitMap    := Succ( BitMap ) ;
  54.     end ;  { of for }
  55.    GetCpmFreeSpace:= FreeBlocks shl (CpmDpb^.BSH-3) ;
  56.  
  57.    Bdos( SetCurrentDrive, CpmCurrentDrive ) ;
  58. end ;  { of GetCpmFreeSpace }
  59.  
  60. function LocateCpmFile : Boolean ;
  61. {*
  62.  * Determine if an CP/M file, with the name given in the current filelist
  63.  * entry, exists or not.  If it exists, the function result is True and
  64.  * the FIB ACpmFile is prepared for CP/M file operations.
  65.  *}
  66. begin
  67.    SplitFileName( ACpmFileName, GetFileEntryName ) ;
  68.    ACpmFileName.Drive:= CpmDriveName.Drive ;
  69.    ACpmFileName.User := CpmDriveName.User  ;
  70. {*
  71.  * Open this file for read access.  If this is possible without any
  72.  * error being detected, the file exists.
  73.  *}
  74.    RegisterFile( ACpmFileName, ACpmFile ) ;
  75.    Assign( ACpmFile, ExpandFileName(ACpmFileName,DNE_Format) ) ;
  76.    {$I-}  Reset( ACpmFile ) ;  {$I+}
  77.    if IoResult=0 then
  78.     begin
  79.      Close( ACpmFile ) ;
  80.      LocateCpmFile:= True ;
  81.     end
  82.    else
  83.      LocateCpmFile:= False ;
  84. end ;  { of LocateCpmFile }
  85.  
  86. procedure ReadCpmDirectory ;
  87. {*
  88.  * Build a filelist containing the files on the selected CP/M drive in the
  89.  * selected user area.
  90.  *}
  91. var
  92. {*
  93.  * Define the layout of the directory entries as read from the disk.  Note
  94.  * that this definition inhibits the use of the CpmFCB for actual I/O, as
  95.  * the last field(s) of the FCB are not stored on disk!
  96.  *}
  97.    Directory: array[0..3] of CpmFCBs absolute ClusterBuffer ;
  98.  
  99.    CpmUserNumber:      Integer ;  { Selected user number }
  100.    CpmDpb       :        ^DPBs ;  { DPB of selected CP/M drive }
  101.    I, J, K      :      Integer ;  { Loop control variables }
  102. begin
  103.    PresetFileList ;  { Cleanup the filelist }
  104.  
  105.    CpmUserNumber:= ExtractUser( CpmDriveName ) ;
  106.    CpmDpb       := DriveAttribute[ExtractDisk(CpmDriveName)].DpbAddress ;
  107. {*
  108.  * Read the directory entries from disk.  It is assumed that all the records
  109.  * of the directory are located in the first data track of the disk.
  110.  *
  111.  * BDOS is NOT used to retrieve the file names for two reasons:
  112.  * -1- reading the directory through BIOS is faster  and
  113.  * -2- it delivers at the same time the size of the individual files.
  114.  *}
  115.    Bios( SelectDrive , CpmDrive        ) ;  { Select CP/M disk drive }
  116.    Bios( SelectTrack , CpmDpb^.OFF     ) ;  { Select track with directory }
  117.    Bios( SelectBuffer, Addr(Directory) ) ;  { Select buffer area }
  118.    for I:= 0 to (CpmDpb^.DRM div 4) do
  119.     begin
  120.      Bios( SelectRecord, I ) ;  { Select next record to read }
  121.      Bios( ReadRecord      ) ;  { Read next directory record }
  122.  
  123.      for J:= 0 to 3 do
  124.        with Directory[J] do
  125.          if Drive=CpmUserNumber then
  126.           begin
  127.            New( FileEntry ) ;
  128.            FileEntry^.Next:=   Nil ;
  129.            FileEntry^.Prev:=   Nil ;
  130.            FileEntry^.Attr:=    [] ;
  131.            FileEntry^.Mark:= False ;
  132.            for K:= 1 to 11 do
  133.              FileEntry^.Name[K]:=  Chr( Ord(FileName[K]) and $7F ) ;
  134.            if Ord(FileName[09])>$7F then
  135.              FileEntry^.Attr:= [ReadOnly] ;
  136.            if Ord(FileName[10])>$7F then
  137.              FileEntry^.Attr:= FileEntry^.Attr + [System] ;
  138.            FileEntry^.Size:= Extent*16 + (RecCnt+7) div 8 ;
  139.  
  140.            EnterFileInList ;
  141.           end ;  { of if/with/for }
  142.     end ;  { of for }
  143.  
  144.    FileEntry:= HeadFileList ;  { Preset 'current' file }
  145.    FileIndex:=            1 ;
  146.    Bios( SelectDrive, CpmCurrentDrive ) ;  { Reselect default drive }
  147. end ;  { of ReadCpmDirectory }
  148.  
  149. procedure SetCpmDrive ;
  150. {*
  151.  * Select the drive and the user area as the default CP/M file area.  It
  152.  * must meet the following criteria:
  153.  *  1- the user area is in the range [0,15],
  154.  *  2- the drive is an existing CP/M drive,
  155.  *  3- the drive is not the MS-DOS drive  and
  156.  *  4- the device address of the CP/M drive differs from the device
  157.  *     address of the MS-DOS drive.
  158.  *}
  159. var
  160.    DriveUserName  :   FullFileNames ;  { New CP/M default drive & user }
  161.    NewCpmDefault  : FileDescriptors ;  { New CP/M default drive & user }
  162.    NewCpmDriveName:            Char ;  { New CP/M default drive name }
  163.    Success        :         Boolean ;  { SetCpmDrive succeeded }
  164. begin
  165.    Write('Enter drive/user : ' ) ;
  166.    ReadLn( DriveUserName ) ;
  167.    DriveUserName:= DriveUserName + ':' ;
  168.    SplitFileName( NewCpmDefault, DriveUserName ) ;  { Crack string }
  169.  
  170.    Success:= False ;  { Assume some error }
  171.    if ExtractUser(NewCpmDefault) in [0..15] then
  172.     begin
  173.      NewCpmDriveName:= ExtractDisk( NewCpmDefault ) ;
  174.      if NewCpmDriveName in (ConfiguredDrives-[MsdosDriveName]) then
  175.        with DriveAttribute[NewCpmDriveName] do
  176.          if DevAddress<>MsdosDriveAddress then
  177.           begin
  178.            CpmDrive       := Ord(NewCpmDriveName) - Ord('A') ;
  179.            CpmDriveName   := NewCpmDefault ;
  180.            CpmDriveAddress:= DevAddress ;
  181.            Success        := True ;
  182.           end ;  { of if/with/if }
  183.     end ;  { of if }
  184.  
  185.    if not Success then
  186.      FlagError( 'SetCD: Illegal specification : ' +
  187.                  ExpandFileName(NewCpmDefault,DU_Format) ) ;
  188. end ;  { of SetCpmDrive }
  189.  
  190.