(* This file was mangled by Mangler 1.30 (c) Copyright 1993 by Berend de Boer *)
(****************************************************************************)
(*                                 PRODOS                                   *)
(*--------------------------------------------------------------------------*)
(* Author :  Enrico Croce                                                   *)
(*                                                                          *)
(* Unit: Prodos - Do general I/O with Prodos Harddisk images                *)
(* Version:  1.0                                                            *)
(* Creation Date: 00/00/0000    Last Modify Date: 01/09/96                  *)
(*                                                                          *)
(****************************************************************************)
(* NOTE:                                                                    *)
(* This program source code is copyrighted in the sense that it may be used *)
(* for free purposes (public domain, freeware, ...) until its original      *)
(* copyrights are preserved. The package as a whole, or parts thereof,      *)
(* cannot be included or used in any commercial application without written *)
(* permission granted by the author. See LICENSE.TXT for a complete license *)
(* agreement. All comments concerning the program may be sent to the author *)
(****************************************************************************)
unit Prodos;

interface

uses Dos, Crt;

const
  SizeOfBlock = 512;
  ErrIO          = 1;
  ErrInvalidFile = 2;
  ErrNoFreeblk   = 3;
  ErrBadBlkMrk   = 4;

type

  PProBlock = ^TProBlock;
  TProBlock = array[0..511] of byte;

  PBlockArr = ^TBlockArr;
  TBlockArr = record
    Lo: array[1..256] of byte;
    Hi: array[1..256] of byte;
  end;

  PProDate = ^TProDate;
  TProDate   = array[0..1] of word;

  PProName = ^TProName;
  TProName = array[1..15] of char;

  PNameStr = ^TNameStr;
  TNameStr = string[15];

  PExtStr = ^TNameStr;
  TExtStr = string[3];

  PVolItem = ^TVolItem;
  TVolItem = record
    KndLen  : byte;
    VolName : TProName;
    UnUsed  : array[0..7] of byte;
    CreaDate: TProDate;
    VerPro  : byte;
    MinPro  : byte;
    Access  : byte;
    ItmLen  : byte;
    ItmInBlk: byte;
    NumItem : word;
    VBMBlk  : word;
    NumBlk  : word;
  end;

  PSubItem = ^TSubItem;
  TSubItem = record
    KndLen  : byte;
    SubName : TProName;
    UnUsed  : array[0..7] of byte;
    CreaDate: TProDate;
    VerPro  : byte;
    MinPro  : byte;
    Access  : byte;
    ItmLen  : byte;
    ItmInBlk: byte;
    NumItem : word;
    PrntBlk : word;
    PrntPos : byte;
    PrntItSz: byte;
  end;

  PFileItem = ^TFileItem;
  TFileItem = record
    KndLen  : byte;
    FileName: TProName;
    Kind    : byte;
    PosBlk  : word;
    SizBlk  : word;
    Size    : array[0..2] of byte;
    CreaDate: TProDate;
    VerPro  : byte;
    MinPro  : byte;
    Access  : byte;
    AuxBit  : word;
    ModiDate: TProDate;
    NumBlk  : word;
  end;

  PVBM = ^TVBM;
  TVBM = record
    Strt   : word;
    Size   : word;
    NumBlk : word;
    BlkFree: word;
    Last   : word;
    Map    : array[0..15] of TProBlock;
    Changed: boolean;
  end;

  PProDosDisk = ^TProDosDisk;
  TProDosDisk = record
    dsk   : file;
    FilNam: PathStr;
    VBM   : PVBM;
    VolBlk: word;
    Vol   : TVolItem;
    DirBlk: word;
    Dir   : TSubItem;
  end;

const

  NumExt = 17;
  Exten: array[1..NumExt] of record Num: byte; Ext: TExtStr end = (
    (Num: $00; Ext: '$$$'),
    (Num: $01; Ext: 'BAD'),
    (Num: $04; Ext: 'TXT'),
    (Num: $06; Ext: 'BIN'),
    (Num: $0F; Ext: 'DIR'),
    (Num: $19; Ext: 'ADB'),
    (Num: $1A; Ext: 'AWP'),
    (Num: $1B; Ext: 'ASP'),
    (Num: $E0; Ext: 'SHK'),
    (Num: $EF; Ext: 'PAS'),
    (Num: $F0; Ext: 'CMD'),
    (Num: $FA; Ext: 'INT'),
    (Num: $FB; Ext: 'IVR'),
    (Num: $FC; Ext: 'BAS'),
    (Num: $FD; Ext: 'VAR'),
    (Num: $FE; Ext: 'REL'),
    (Num: $FF; Ext: 'SYS'));

  af_Delete = 128;
  af_Rename =  64;
  af_Modify =  32;
  af_Write  =   2;
  af_Read   =   1;

procedure WaitReturn;
function  FileExist(var FileName: PathStr): Boolean;
procedure MakeDir(Dir: PathStr);
procedure GotoDir(Dir: PathStr);

procedure ReadBlock (var dsk: file; Blk: word; var Buf);
procedure WriteBlock(var dsk: file; Blk: word; var Buf);

procedure ReadVBM (var Disk: TProDosDisk);
procedure WriteVBM(var Disk: TProDosDisk);

function  SeekBitBlock(var Disk: TProDosDisk; blk: word; var i,j: integer; var msk: byte): boolean;
function  GetFreeBlock(var Disk: TProDosDisk): word;
procedure MarkBlock   (var Disk: TProDosDisk; blk: word; free: boolean);

procedure OpenDisk (var Disk: TProDosDisk; FN: PathStr);
procedure CloseDisk(var Disk: TProDosDisk);

procedure OpenDir (var Disk: TProDosDisk; Block: word);
procedure CloseDir(var Disk: TProDosDisk);
procedure PrintDir(var Disk: TProDosDisk; ext: boolean);
function  GetFileName(var Disk: TProDosDisk; var Name: TNameStr; var Item: TFileItem): boolean;

procedure PrintVolItem(Item: PVolItem; ext: boolean);
procedure PrintSubItem(Item: PSubItem; ext: boolean);
procedure PrintFileItem(Item: PFileItem; ext: boolean);
procedure PrintSubFileItem(Item: PFileItem; ext: boolean);

function  MsDosName(Name: TNameStr; Kind: byte): PathStr;
procedure ExportFile (var Disk: TProDosDisk; var Item: TFileItem; var OutName: PathStr);
procedure ExportDir  (var Disk: TProDosDisk);
procedure ImportFile (var Disk: TProDosDisk; var InName: PathStr);
procedure ImportFiles(var Disk: TProDosDisk);

 IMPLEMENTATION CONST Ol00II0I1IOl:ARRAY [ 0 .. 15 ]  OF CHAR='0123456789ABCDEF';O1010I1I111Ol:ARRAY [ 0 .. 7 ]
 OF BYTE=(128 , 64 , 32 , 16 , 8 , 4 , 2 , 1 );FUNCTION OlllO010OO (OOIO, OOIl:INTEGER):LONGINT ;INLINE($5A / $58 / $F7 /
$EA );PROCEDURE OOllOI0IO011 (O10OII1011lOl:INTEGER);BEGIN CASE O10OII1011lOl  OF ERRIO :WRITELN ('ERROR: IO error');
ERRINVALIDFILE :WRITELN ('ERROR: invalid file');ERRNOFREEBLK :WRITELN ('ERROR: no free block');ERRBADBLKMRK :WRITELN
('ERROR: bad block mark');ELSE WRITELN ('Error #', O10OII1011lOl );END ;HALT (1 );END ;PROCEDURE WAITRETURN ;
VAR OOIl:INTEGER;BEGIN OOIl := WHEREY ;GOTOXY (1 , OOIl );CLREOL ;WRITE ('Press any key');IF READKEY =#0THEN READKEY ;
GOTOXY (1 , OOIl );CLREOL ;END ;FUNCTION FILEEXIST (VAR FILENAME:PATHSTR):BOOLEAN ;VAR O1lO011lO110:TEXT;
OOlOIO1IOIIl:WORD;BEGIN IF FILENAME =''THEN BEGIN FILEEXIST := FALSE ;EXIT ;END ;ASSIGN (O1lO011lO110 , FILENAME );
GETFATTR (O1lO011lO110 , OOlOIO1IOIIl );FILEEXIST := (DOSERROR =0 );END ;PROCEDURE MAKEDIR (DIR:PATHSTR);
VAR O10Ill00,O10IIOOl,O11l0IO1,O110l10I:DIRSTR;O11I01IO:NAMESTR;O11l0IOI:EXTSTR;OIlO:INTEGER;BEGIN GETDIR (0 , O10Ill00
);FOR OIlO := 1 TO LENGTH (DIR ) DO IF DIR [ OIlO ] ='/'THEN DIR [ OIlO ] := '\';IF DIR [ LENGTH (DIR )] <> '\'THEN DIR
:= DIR + '\';FSPLIT (DIR , O11l0IO1 , O11I01IO , O11l0IOI );{$I-}CHDIR (O11l0IO1 );{$I+}IF IORESULT <> 0 THEN BEGIN IF
O11l0IO1 [ 2 ] =':'THEN BEGIN CHDIR (COPY (O11l0IO1 , 1 , 2 )+ '\');DELETE (O11l0IO1 , 1 , 2 );END ;REPEAT IF O11l0IO1 [
1 ] ='\'THEN DELETE (O11l0IO1 , 1 , 1 );OIlO := POS ('\', O11l0IO1 );IF OIlO =0 THEN O110l10I := O11l0IO1 ELSE O110l10I
:= COPY (O11l0IO1 , 1 , OIlO - 1 );{$I-}CHDIR (O110l10I );{$I+}IF IORESULT <> 0 THEN BEGIN MKDIR (O110l10I );CHDIR
(O110l10I );END ;DELETE (O11l0IO1 , 1 , OIlO );UNTIL OIlO =0 ;END ;CHDIR (O10Ill00 );END ;PROCEDURE GOTODIR
(DIR:PATHSTR);VAR OIlO:INTEGER;BEGIN IF DIR [ LENGTH (DIR )] ='\'THEN DEC (BYTE (DIR [ 0 ] ));{$I-}CHDIR (FEXPAND (DIR
));{$I+}OIlO := IORESULT ;IF OIlO =3 THEN BEGIN DIR := DIR + '\';{$I-}CHDIR (DIR );{$I+}OIlO := IORESULT ;END ;
OOllOI0IO011 (- OIlO );END ;FUNCTION Ol001II0IO0O (OIO0:WORD):STRING ;BEGIN IF OIO0 < 10 THEN WRITE ('0', OIO0 )ELSE
WRITE (OIO0 );Ol001II0IO0O := '';END ;FUNCTION Ol11OlO1l1 (O11OOO0l:WORD):STRING ;VAR OIOI1l01I01:STRING ;
BEGIN OIOI1l01I01 := Ol00II0I1IOl [ (O11OOO0l SHR 12 )AND $F ] + Ol00II0I1IOl [ (O11OOO0l SHR 8 )AND $F ] + Ol00II0I1IOl
[ (O11OOO0l SHR 4 )AND $F ] + Ol00II0I1IOl [ (O11OOO0l )AND $F ] ;Ol11OlO1l1 := OIOI1l01I01 ;END ;FUNCTION OO0I00l11Il
(O10OO111lI0Il:BYTE):STRING ;BEGIN IF (O10OO111lI0Il AND AF_DELETE )<> 0 THEN WRITE ('+d')ELSE WRITE ('-d');IF
(O10OO111lI0Il AND AF_RENAME )<> 0 THEN WRITE ('+n')ELSE WRITE ('-n');IF (O10OO111lI0Il AND AF_MODIFY )<> 0 THEN WRITE
('+a')ELSE WRITE ('-a');IF (O10OO111lI0Il AND AF_WRITE )<> 0 THEN WRITE ('+w')ELSE WRITE ('-w');IF (O10OO111lI0Il AND
AF_READ )<> 0 THEN WRITE ('+r')ELSE WRITE ('-r');OO0I00l11Il := '';END ;FUNCTION O1lII01Il1IO
(OI1III11OOII:TPRODATE):STRING ;BEGIN IF (OI1III11OOII [ 0 ] =0 )AND (OI1III11OOII [ 1 ] =0 )THEN BEGIN WRITE
('<NO DATE>        ');END ELSE BEGIN WRITE (Ol001II0IO0O (OI1III11OOII [ 0 ] AND $1F ), '-', Ol001II0IO0O ((OI1III11OOII
[ 0 ] SHR 5 )AND $0F ), '-', 1900 + OI1III11OOII [ 0 ] SHR 9 , ' ');WRITE (Ol001II0IO0O (OI1III11OOII [ 1 ] SHR 8 ), ':',
Ol001II0IO0O (OI1III11OOII [ 1 ] AND $FF ), ' ');END ;O1lII01Il1IO := '';END ;FUNCTION OOII0OI10OlI
(OI1I1II1lO1:BYTE):STRING ;VAR OIOI1l01I01:STRING ;BEGIN IF OI1I1II1lO1 > 10 THEN OIOI1l01I01 := '$0'+ CHR (55 +
OI1I1II1lO1 )ELSE OIOI1l01I01 := '$0'+ CHR (OI1I1II1lO1 + 48 );CASE OI1I1II1lO1  OF 0 :OIOI1l01I01 := OIOI1l01I01 +
' deleted file';1 :OIOI1l01I01 := OIOI1l01I01 + ' 1 block file';2 :OIOI1l01I01 := OIOI1l01I01 + ' <128K file';3
:OIOI1l01I01 := OIOI1l01I01 + ' big file';$D :OIOI1l01I01 := OIOI1l01I01 + ' subdirectory file';$E :OIOI1l01I01 :=
OIOI1l01I01 + ' subdirectory header';$F :OIOI1l01I01 := OIOI1l01I01 + ' volume header';ELSE OIOI1l01I01 := OIOI1l01I01 +
' unknown';END ;OOII0OI10OlI := OIOI1l01I01 ;END ;FUNCTION O10100OOl0I (OIOIOII1OI0:BYTE):TEXTSTR ;
VAR OIOI1l01I01:TEXTSTR;OIlO:INTEGER;BEGIN OIOI1l01I01 := '';FOR OIlO := 1 TO NUMEXT  DO IF OIOIOII1OI0 =EXTEN [ OIlO ] .
NUM THEN BEGIN OIOI1l01I01 := EXTEN [ OIlO ] . EXT ;BREAK ;END ;IF OIOI1l01I01 =''THEN OIOI1l01I01 := '$'+ Ol00II0I1IOl [
OIOIOII1OI0 SHR 4 ] + Ol00II0I1IOl [ OIOIOII1OI0 AND $0F ] ;O10100OOl0I := OIOI1l01I01 ;END ;FUNCTION OlOlIIOI1O
(OI1IIIO10l01:EXTSTR):BYTE ;VAR OIlO:INTEGER;BEGIN IF OI1IIIO10l01 [ 1 ] ='.'THEN DELETE (OI1IIIO10l01 , 1 , 1 );
FOR OIlO := 1 TO 3  DO OI1IIIO10l01 [ OIlO ] := UPCASE (OI1IIIO10l01 [ OIlO ] );OlOlIIOI1O := $06 ;FOR OIlO := 1 TO
NUMEXT  DO IF EXTEN [ OIlO ] . EXT =OI1IIIO10l01 THEN BEGIN OlOlIIOI1O := EXTEN [ OIlO ] . NUM ;BREAK ;END ;END ;
FUNCTION O1lIIOl001IO (OIIll1OIOll:PFILEITEM;OI10OIO00IOO:BOOLEAN):TNAMESTR ;VAR OI111IlIOOl0:TNAMESTR;
BEGIN WITH OIIll1OIOll^ DO BEGIN FILLCHAR (OI111IlIOOl0 , SIZEOF (OI111IlIOOl0 ), ' ');IF OI10OIO00IOO THEN OI111IlIOOl0
[ 0 ] := CHR (KNDLEN AND $0F )ELSE OI111IlIOOl0 [ 0 ] := #15;MOVE (FILENAME , OI111IlIOOl0 [ 1 ] , KNDLEN AND $0F );
END ;O1lIIOl001IO := OI111IlIOOl0 ;END ;PROCEDURE PRINTVOLITEM (ITEM:PVOLITEM;EXT:BOOLEAN);VAR OI111IlIOOl0:TNAMESTR;
BEGIN WITH ITEM^ DO BEGIN OI111IlIOOl0 := O1lIIOl001IO (PFILEITEM (ITEM ), FALSE );IF EXT THEN BEGIN WRITELN
('Kind         : ', OOII0OI10OlI ((KNDLEN AND $F0 )SHR 4 ));WRITELN ('FileName Len : ', (KNDLEN AND $0F ));WRITELN
('FileName     : ', OI111IlIOOl0 );WRITELN ('Creation Date: ', O1lII01Il1IO (CREADATE ));WRITELN ('Prodos Vers. : ',
VERPRO );WRITELN ('Min Prodos   : ', MINPRO );WRITELN ('Access flag  : ', OO0I00l11Il (ACCESS ));WRITELN
('Item length  : ', ITMLEN );WRITELN ('Item in block: ', ITMINBLK );WRITELN ('Num of items : ', NUMITEM );WRITELN
('VBM position : ', VBMBLK );WRITELN ('Num of Bloks : ', NUMBLK );WAITRETURN ;END ELSE BEGIN WRITELN ('/', OI111IlIOOl0 ,
' Access:', OO0I00l11Il (ACCESS ));END ;END END ;PROCEDURE PRINTSUBITEM (ITEM:PSUBITEM;EXT:BOOLEAN);
VAR OI111IlIOOl0:TNAMESTR;BEGIN WITH ITEM^ DO BEGIN OI111IlIOOl0 := O1lIIOl001IO (PFILEITEM (ITEM ), FALSE );IF EXT THEN
BEGIN WRITELN ('Kind         : ', OOII0OI10OlI ((KNDLEN AND $F0 )SHR 4 ));WRITELN ('FileName Len : ', (KNDLEN AND $0F ));
WRITELN ('FileName     : ', OI111IlIOOl0 );WRITELN ('Creation Date: ', O1lII01Il1IO (CREADATE ));WRITELN
('Prodos Vers. : ', VERPRO );WRITELN ('Min Prodos   : ', MINPRO );WRITELN ('Access flag  : ', OO0I00l11Il (ACCESS ));
WRITELN ('Item length  : ', ITMLEN );WRITELN ('Item in block: ', ITMINBLK );WRITELN ('Num of items : ', NUMITEM );
WRITELN ('Parent Pos.  : ', PRNTPOS );WRITELN ('Prnt Itm Size: ', PRNTITSZ );WAITRETURN ;END ELSE BEGIN WRITELN ('../',
OI111IlIOOl0 , ' Access:', OO0I00l11Il (ACCESS ));END ;END ;END ;PROCEDURE PRINTFILEITEM (ITEM:PFILEITEM;EXT:BOOLEAN);
VAR OI111IlIOOl0:TNAMESTR;OO00OOI10I1:LONGINT;BEGIN WITH ITEM^ DO BEGIN OI111IlIOOl0 := O1lIIOl001IO (ITEM , FALSE );
OO00OOI10I1 := (OlllO010OO (SIZE [ 2 ] , 256 )+ SIZE [ 1 ] )* 256 + SIZE [ 0 ] ;IF EXT THEN BEGIN WRITELN
('Kind         : ', OOII0OI10OlI ((KNDLEN AND $F0 )SHR 4 ));WRITELN ('FileName Len : ', (KNDLEN AND $0F ));WRITELN
('FileName     : ', OI111IlIOOl0 );WRITELN ('File Kind    : ', O10100OOl0I (KIND ));WRITELN ('File Pos     : ', POSBLK );
WRITELN ('Blocks Size  : ', SIZBLK );WRITELN ('Size         : ', OO00OOI10I1 );WRITELN ('Creation Date: ', O1lII01Il1IO
(CREADATE ));WRITELN ('Modifify Date: ', O1lII01Il1IO (MODIDATE ));WRITELN ('Prodos Vers. : ', VERPRO );WRITELN
('Min Prodos   : ', MINPRO );WRITELN ('Access flag  : ', OO0I00l11Il (ACCESS ));WRITELN ('Aux. Bits    : $', Ol11OlO1l1
(AUXBIT ));WRITELN ('Num. Block   : ', NUMBLK );WAITRETURN ;END ELSE BEGIN IF (KNDLEN AND $F0 )=0 THEN EXIT ;IF (ACCESS
AND 2 )=0 THEN WRITE ('*')ELSE WRITE (' ');WRITELN (OI111IlIOOl0 , ' ', O10100OOl0I (KIND ), SIZBLK :5 , ' ',
O1lII01Il1IO (MODIDATE ), ' ', O1lII01Il1IO (CREADATE ), ' ', OO00OOI10I1 :8 , ' $', Ol11OlO1l1 (AUXBIT ));END ;END ;
END ;PROCEDURE PRINTSUBFILEITEM (ITEM:PFILEITEM;EXT:BOOLEAN);VAR OI111IlIOOl0:TNAMESTR;OO00OOI10I1:LONGINT;
BEGIN WITH ITEM^ DO BEGIN OI111IlIOOl0 := O1lIIOl001IO (ITEM , FALSE );OO00OOI10I1 := (OlllO010OO (SIZE [ 2 ] , 256 )+
SIZE [ 1 ] )* 256 + SIZE [ 0 ] ;IF EXT THEN BEGIN WRITELN ('Kind         : ', OOII0OI10OlI ((KNDLEN AND $F0 )SHR 4 ));
WRITELN ('FileName Len : ', (KNDLEN AND $0F ));WRITELN ('FileName     : ', OI111IlIOOl0 );WRITELN ('File Kind    : ',
O10100OOl0I (KIND ));WRITELN ('File Pos     : ', POSBLK );WRITELN ('Blocks Size  : ', SIZBLK );WRITELN
('Size         : ', OO00OOI10I1 );WRITELN ('Creation Date: ', O1lII01Il1IO (CREADATE ));WRITELN ('Modifify Date: ',
O1lII01Il1IO (MODIDATE ));WRITELN ('Prodos Vers. : ', VERPRO );WRITELN ('Min Prodos   : ', MINPRO );WRITELN
('Access flag  : ', OO0I00l11Il (ACCESS ));WRITELN ('Aux. Bits    : $', Ol11OlO1l1 (AUXBIT ));WRITELN ('Num. Block   : ',
NUMBLK );WAITRETURN ;END ELSE BEGIN IF (KNDLEN AND $F0 )=0 THEN EXIT ;IF (ACCESS AND 2 )=0 THEN WRITE ('*')ELSE WRITE
(' ');WRITELN (OI111IlIOOl0 , ' ', O10100OOl0I (KIND ), SIZBLK :5 , ' ', O1lII01Il1IO (MODIDATE ), ' ', O1lII01Il1IO
(CREADATE ), OO0I00l11Il (ACCESS ));END ;END ;END ;PROCEDURE READBLOCK (VAR DSK:FILE ;BLK:WORD;VAR BUF);
VAR O10IllO0:WORD;BEGIN SEEK (DSK , OlllO010OO (BLK , SIZEOFBLOCK ));BLOCKREAD (DSK , BUF , SIZEOFBLOCK , O10IllO0 );IF
O10IllO0 <> SIZEOFBLOCK THEN OOllOI0IO011 (ERRIO );END ;PROCEDURE WRITEBLOCK (VAR DSK:FILE ;BLK:WORD;VAR BUF);
VAR O11OOO0l:WORD;BEGIN SEEK (DSK , OlllO010OO (BLK , SIZEOFBLOCK ));BLOCKWRITE (DSK , BUF , SIZEOFBLOCK , O11OOO0l );IF
O11OOO0l <> SIZEOFBLOCK THEN OOllOI0IO011 (ERRIO );END ;PROCEDURE READVBM (VAR DISK:TPRODOSDISK);
VAR OIlO,OIll,OO00:INTEGER;OIIO0l0IOlI:LONGINT;O10OOI110lOO1:INTEGER;LABEL _ESCI ;BEGIN WITH DISK DO BEGIN NEW (VBM );
WITH VBM^ DO BEGIN STRT := VOL.VBMBLK ;NUMBLK := VOL.NUMBLK ;O10OOI110lOO1 := NUMBLK MOD 8 ;BLKFREE := 0 ;SIZE :=
(LONGINT (NUMBLK )+ SIZEOFBLOCK - 1 )DIV (512 * 8 );LAST := 0 ;CHANGED := FALSE ;FOR OIlO := 0 TO SIZE - 1
 DO BEGIN READBLOCK (DSK , STRT + OIlO , MAP [ OIlO ] );END ;OIIO0l0IOlI := 0 ;FOR OIlO := 0 TO SIZE - 1
 DO BEGIN FOR OIll := 0 TO 511  DO BEGIN FOR OO00 := 0 TO 7  DO BEGIN INC (OIIO0l0IOlI );IF (MAP [ OIlO ] [ OIll ] AND
O1010I1I111Ol [ OO00 ] )<> 0 THEN INC (BLKFREE );END ;IF OIIO0l0IOlI >= NUMBLK THEN GOTO _ESCI ;END ;END ;_ESCI :END ;
END ;END ;PROCEDURE WRITEVBM (VAR DISK:TPRODOSDISK);VAR OIlO:INTEGER;BEGIN WITH DISK DO BEGIN WITH VBM^ DO BEGIN IF
CHANGED THEN BEGIN FOR OIlO := 0 TO SIZE - 1  DO BEGIN WRITEBLOCK (DSK , STRT + OIlO , MAP [ OIlO ] );END ;CHANGED :=
FALSE ;END ;END ;END ;END ;FUNCTION SEEKBITBLOCK (VAR DISK:TPRODOSDISK;BLK:WORD;VAR I,J:INTEGER;VAR MSK:BYTE):BOOLEAN ;
BEGIN I := BLK SHR (3 + 9 );J := (BLK SHR (3 )AND 511 );MSK := O1010I1I111Ol [ BLK AND $07 ] ;SEEKBITBLOCK := (DISK.VBM
^. MAP [ I , J ] AND MSK )=MSK ;END ;FUNCTION GETFREEBLOCK (VAR DISK:TPRODOSDISK):WORD ;VAR OIlO:WORD;
O11IlI1I,OIOll11llII:INTEGER;OIIO0lOI100:BYTE;BEGIN WITH DISK.VBM^ DO BEGIN FOR OIlO := LAST TO NUMBLK  DO BEGIN IF
SEEKBITBLOCK (DISK , OIlO , O11IlI1I , OIOll11llII , OIIO0lOI100 )THEN BEGIN LAST := OIlO ;GETFREEBLOCK := OIlO ;EXIT ;
END ;END ;END ;OOllOI0IO011 (ERRNOFREEBLK );END ;PROCEDURE MARKBLOCK (VAR DISK:TPRODOSDISK;BLK:WORD;FREE:BOOLEAN);
VAR O11IlI1I,OIOll11llII:INTEGER;OIIO0lOI100:BYTE;BEGIN WITH DISK.VBM^ DO BEGIN IF FREE THEN BEGIN IF NOT SEEKBITBLOCK
(DISK , BLK , O11IlI1I , OIOll11llII , OIIO0lOI100 )THEN BEGIN CHANGED := TRUE ;MAP [ O11IlI1I , OIOll11llII ] := MAP [
O11IlI1I , OIOll11llII ] OR OIIO0lOI100 ;IF BLK < LAST THEN LAST := BLK ;INC (BLKFREE );END ELSE OOllOI0IO011
(ERRBADBLKMRK );END ELSE BEGIN IF SEEKBITBLOCK (DISK , BLK , O11IlI1I , OIOll11llII , OIIO0lOI100 )THEN BEGIN CHANGED :=
TRUE ;MAP [ O11IlI1I , OIOll11llII ] := MAP [ O11IlI1I , OIOll11llII ] AND (NOT OIIO0lOI100 );DEC (BLKFREE );END ELSE
OOllOI0IO011 (ERRBADBLKMRK );END ;END ;END ;PROCEDURE OPENDISK (VAR DISK:TPRODOSDISK;FN:PATHSTR);
VAR OI0l1Il0I0OO:DIRSTR;OIIll00OlO0:NAMESTR;OIl0OOl0ll1:EXTSTR;OI1OllllOl1:TPROBLOCK;BEGIN WITH DISK DO BEGIN FILNAM :=
FEXPAND (FN );FSPLIT (FILNAM , OI0l1Il0I0OO , OIIll00OlO0 , OIl0OOl0ll1 );IF OIl0OOl0ll1 ='.dsk'THEN VOLBLK := 4 ELSE
VOLBLK := 2 ;ASSIGN (DSK , FILNAM );RESET (DSK , 1 );READBLOCK (DSK , VOLBLK , OI1OllllOl1 );MOVE (OI1OllllOl1 [ 4 ] ,
VOL , SIZEOF (VOL ));READVBM (DISK );END ;END ;PROCEDURE CLOSEDISK (VAR DISK:TPRODOSDISK);
BEGIN WITH DISK DO BEGIN WRITEVBM (DISK );DISPOSE (VBM );CLOSE (DSK );END ;END ;PROCEDURE OPENDIR (VAR DISK:TPRODOSDISK;
BLOCK:WORD);VAR OI1OllllOl1:TPROBLOCK;BEGIN WITH DISK DO BEGIN DIRBLK := BLOCK ;READBLOCK (DSK , BLOCK , OI1OllllOl1 );
MOVE (OI1OllllOl1 [ 4 ] , DIR , SIZEOF (DIR ));END ;END ;PROCEDURE CLOSEDIR (VAR DISK:TPRODOSDISK);
VAR OI1OllllOl1:TPROBLOCK;OIIO0l11lOl:ARRAY [ 0 .. 1 ]  OF WORD ABSOLUTE OI1OllllOl1;BEGIN WITH DISK DO BEGIN IF
((DIR.KNDLEN AND $F0 )=$E0 )THEN BEGIN DIRBLK := DIR.PRNTBLK ;REPEAT READBLOCK (DSK , DIRBLK , OI1OllllOl1 );IF
OIIO0l11lOl [ 0 ] <> 0 THEN DIRBLK := OIIO0l11lOl [ 0 ] ;UNTIL OIIO0l11lOl [ 0 ] =0 ;MOVE (OI1OllllOl1 [ 4 ] , DIR ,
SIZEOF (DIR ));END ;END ;END ;PROCEDURE PRINTDIR (VAR DISK:TPRODOSDISK;EXT:BOOLEAN);VAR OI1OllllOl1:TPROBLOCK;
OIIO0l11lOl:ARRAY [ 0 .. 1 ]  OF WORD ABSOLUTE OI1OllllOl1;OIIll1OIOll:POINTER;OIOllI0O1OI:WORD;OIlO:WORD;
BEGIN OIOllI0O1OI := 4 ;WITH DISK DO BEGIN READBLOCK (DSK , DIRBLK , OI1OllllOl1 );MOVE (OI1OllllOl1 [ 4 ] , DIR , SIZEOF
(DIR ));OIlO := 0 ;REPEAT INC (OIlO );IF OIOllI0O1OI >= 511 THEN BEGIN OIOllI0O1OI := 4 ;READBLOCK (DSK , OIIO0l11lOl [ 1
] , OI1OllllOl1 );END ;OIIll1OIOll := @ OI1OllllOl1 [ OIOllI0O1OI ] ;CASE (PVOLITEM (OIIll1OIOll )^. KNDLEN AND $F0 )SHR
4  OF $0F :PRINTVOLITEM (OIIll1OIOll , EXT );$0E :PRINTSUBITEM (OIIll1OIOll , EXT );$0D :PRINTSUBFILEITEM (OIIll1OIOll ,
EXT );1 .. 3 :PRINTFILEITEM (OIIll1OIOll , EXT );0 :BEGIN PRINTFILEITEM (OIIll1OIOll , EXT );DEC (OIlO );END ;END ;IF
(OIlO MOD 20 )=0 THEN WAITRETURN ;INC (OIOllI0O1OI , DIR.ITMLEN );UNTIL OIlO > DIR.NUMITEM ;END ;END ;
FUNCTION GETFILENAME (VAR DISK:TPRODOSDISK;VAR NAME:TNAMESTR;VAR ITEM:TFILEITEM):BOOLEAN ;VAR OI1OllllOl1:TPROBLOCK;
OIIO0l11lOl:ARRAY [ 0 .. 1 ]  OF WORD ABSOLUTE OI1OllllOl1;OIIll1OIOll:PFILEITEM;OIOllI0O1OI:WORD;OIlO:WORD;
O111O1O0:TNAMESTR;BEGIN OIOllI0O1OI := 4 ;WITH DISK DO BEGIN READBLOCK (DSK , DIRBLK , OI1OllllOl1 );MOVE (OI1OllllOl1 [
4 ] , DIR , SIZEOF (DIR ));OIlO := 0 ;REPEAT IF OIOllI0O1OI >= 511 THEN BEGIN OIOllI0O1OI := 4 ;READBLOCK (DSK ,
OIIO0l11lOl [ 1 ] , OI1OllllOl1 );END ;OIIll1OIOll := @ OI1OllllOl1 [ OIOllI0O1OI ] ;IF (OIIll1OIOll ^. KNDLEN AND $F0
)<> 0 THEN BEGIN INC (OIlO );O111O1O0 := O1lIIOl001IO (OIIll1OIOll , TRUE );IF NAME =O111O1O0 THEN BEGIN ITEM :=
OIIll1OIOll ^;GETFILENAME := TRUE ;EXIT ;END ;END ;INC (OIOllI0O1OI , DIR.ITMLEN );UNTIL OIlO > DIR.NUMITEM ;END ;
GETFILENAME := FALSE ;END ;FUNCTION MSDOSNAME (NAME:TNAMESTR;KIND:BYTE):PATHSTR ;VAR OIOI1l01I01:PATHSTR;
O11l0O0O:INTEGER;BEGIN FOR O11l0O0O := 1 TO LENGTH (NAME ) DO IF NAME [ O11l0O0O ] ='.'THEN DELETE (NAME , O11l0O0O , 1
);IF LENGTH (NAME )> 8 THEN NAME [ 0 ] := #8;OIOI1l01I01 := NAME + '.'+ O10100OOl0I (KIND );IF FILEEXIST (OIOI1l01I01
)THEN BEGIN O11l0O0O := LENGTH (NAME )+ 1 ;IF O11l0O0O > 8 THEN O11l0O0O := 8 ;NAME [ 0 ] := CHR (O11l0O0O );NAME [
O11l0O0O ] := '0';OIOI1l01I01 := NAME + '.'+ O10100OOl0I (KIND );WHILE FILEEXIST (OIOI1l01I01 ) DO INC (OIOI1l01I01 [
O11l0O0O ] );END ;MSDOSNAME := OIOI1l01I01 ;END ;PROCEDURE EXPORTFILE (VAR DISK:TPRODOSDISK;VAR ITEM:TFILEITEM;
VAR OUTNAME:PATHSTR);VAR OOlOO1OIOOIO:DIRSTR;OIIll00OlO0:NAMESTR;OIl0OOl0ll1:EXTSTR;OO00OOI10I1:LONGINT;
OIlO,OIll,O11l0O0O,O11l0IIl:INTEGER;OIOl01I00IO:WORD;OI1OllllOl1:TPROBLOCK;OIl0OO00II1,OI1I1lIIIO11:TBLOCKARR;
OIl0OOIllIO:FILE ;O10lIlll:CHAR;BEGIN OUTNAME := FEXPAND (OUTNAME );FSPLIT (OUTNAME , OOlOO1OIOOIO , OIIll00OlO0 ,
OIl0OOl0ll1 );OUTNAME := OOlOO1OIOOIO + OIIll00OlO0 + OIl0OOl0ll1 ;MAKEDIR (OOlOO1OIOOIO );IF FILEEXIST (OUTNAME )THEN
BEGIN WRITE ('File exists. Overwrite? ');READLN (O10lIlll );IF NOT (UPCASE (O10lIlll )IN [ 'Y', 'S', 'J'] )THEN EXIT ;
END ;ASSIGN (OIl0OOIllIO , OUTNAME );REWRITE (OIl0OOIllIO , 1 );WITH ITEM DO BEGIN OO00OOI10I1 := (OlllO010OO (SIZE [ 2 ]
, 256 )+ SIZE [ 1 ] )* 256 + SIZE [ 0 ] ;CASE KNDLEN SHR 4  OF 1 :BEGIN READBLOCK (DISK.DSK , POSBLK , OI1OllllOl1 );
BLOCKWRITE (OIl0OOIllIO , OI1OllllOl1 , SIZEOFBLOCK , OIOl01I00IO );IF OIOl01I00IO <> SIZEOFBLOCK THEN OOllOI0IO011
(ERRIO );END ;2 :BEGIN READBLOCK (DISK.DSK , POSBLK , OIl0OO00II1 );FOR OIlO := 1 TO SIZBLK - 1  DO BEGIN READBLOCK
(DISK.DSK , OIl0OO00II1.LO [ OIlO ] + 256 * OIl0OO00II1.HI [ OIlO ] , OI1OllllOl1 );BLOCKWRITE (OIl0OOIllIO , OI1OllllOl1
, SIZEOFBLOCK , OIOl01I00IO );IF OIOl01I00IO <> SIZEOFBLOCK THEN OOllOI0IO011 (ERRIO );END ;END ;3 :BEGIN READBLOCK
(DISK.DSK , POSBLK , OI1I1lIIIO11 );O11l0IIl := 1 + (OO00OOI10I1 + (256 * 512 - 1 ))DIV (256 * 512 );OIll := 0 ;O11l0O0O
:= 999 ;FOR OIlO := 1 TO SIZBLK - O11l0IIl  DO BEGIN IF O11l0O0O > 256 THEN BEGIN O11l0O0O := 1 ;INC (OIll );READBLOCK
(DISK.DSK , OI1I1lIIIO11.LO [ OIll ] + 256 * OI1I1lIIIO11.HI [ OIll ] , OIl0OO00II1 );END ;READBLOCK (DISK.DSK ,
OIl0OO00II1.LO [ O11l0O0O ] + 256 * OIl0OO00II1.HI [ O11l0O0O ] , OI1OllllOl1 );BLOCKWRITE (OIl0OOIllIO , OI1OllllOl1 ,
SIZEOFBLOCK , OIOl01I00IO );IF OIOl01I00IO <> SIZEOFBLOCK THEN OOllOI0IO011 (ERRIO );INC (O11l0O0O );END ;END ;ELSE
OOllOI0IO011 (ERRINVALIDFILE );END ;END ;SEEK (OIl0OOIllIO , OO00OOI10I1 );TRUNCATE (OIl0OOIllIO );CLOSE (OIl0OOIllIO );
END ;PROCEDURE EXPORTDIR (VAR DISK:TPRODOSDISK);VAR OI1OllllOl1:TPROBLOCK;OIIO0l11lOl:ARRAY [ 0 .. 1 ]
 OF WORD ABSOLUTE OI1OllllOl1;OIIll1OIOll:PFILEITEM;OIOllI0O1OI:WORD;OIlO:WORD;OI111IlIOOl0:PATHSTR;BEGIN OIOllI0O1OI :=
4 ;WITH DISK DO BEGIN READBLOCK (DSK , DIRBLK , OI1OllllOl1 );MOVE (OI1OllllOl1 [ 4 ] , DIR , SIZEOF (DIR ));OIlO := 0 ;
REPEAT INC (OIlO );IF OIOllI0O1OI >= 511 THEN BEGIN OIOllI0O1OI := 4 ;READBLOCK (DSK , OIIO0l11lOl [ 1 ] , OI1OllllOl1 );
END ;OIIll1OIOll := @ OI1OllllOl1 [ OIOllI0O1OI ] ;CASE (OIIll1OIOll ^. KNDLEN AND $F0 )SHR 4  OF 1 .. 3
:BEGIN OI111IlIOOl0 := O1lIIOl001IO (OIIll1OIOll , TRUE );OI111IlIOOl0 := MSDOSNAME (OI111IlIOOl0 , OIIll1OIOll ^. KIND
);WRITELN ('Exporting... ', OI111IlIOOl0 );EXPORTFILE (DISK , OIIll1OIOll ^, OI111IlIOOl0 );END ;END ;INC (OIOllI0O1OI ,
DIR.ITMLEN );UNTIL OIlO > DIR.NUMITEM ;END ;END ;PROCEDURE IMPORTFILE (VAR DISK:TPRODOSDISK;VAR INNAME:PATHSTR);
VAR OIOI1l0O1l1:FILE ;OI1000l1II00:TFILEITEM;OOlOO1OIOOIO:DIRSTR;OI111IlIOOl0:NAMESTR;OIIll00OlO0:STRING [ 12 ] ;
OIl0OOl0ll1:EXTSTR;OO00OOI10I1:LONGINT;OIlO,OIll:INTEGER;
OIOl01I00IO,OIOllI0O1OI,OIIO0l0IOlI,O10OI00l1011I,Ol00IO0IOlO0:WORD;OI1I1II1lO1:BYTE;
OOlI1O0l1lO0,OIlIl1O1O00,OIlll1l01II,O1OlOIlOI10I:WORD;OIl0OO00II1,OI1I1lIIIO11:TBLOCKARR;OI1OllllOl1:TPROBLOCK;
OIIO0l11lOl:ARRAY [ 0 .. 1 ]  OF WORD ABSOLUTE OI1OllllOl1;BEGIN IF NOT FILEEXIST (INNAME )THEN EXIT ;FSPLIT (INNAME ,
OOlOO1OIOOIO , OI111IlIOOl0 , OIl0OOl0ll1 );OIIll00OlO0 := OI111IlIOOl0 + OIl0OOl0ll1 ;ASSIGN (OIOI1l0O1l1 , INNAME );
RESET (OIOI1l0O1l1 , 1 );OO00OOI10I1 := FILESIZE (OIOI1l0O1l1 );IF OO00OOI10I1 < 512 THEN OI1I1II1lO1 := 1 ELSE IF
OO00OOI10I1 < 256 * 512 THEN OI1I1II1lO1 := 2 ELSE OI1I1II1lO1 := 3 ;WITH OI1000l1II00,DISK DO BEGIN KIND := OlOlIIOI1O
(OIl0OOl0ll1 );IF LENGTH (OIIll00OlO0 )> 15 THEN OIIll00OlO0 [ 0 ] := #15;KNDLEN := OI1I1II1lO1 * 16 + LENGTH
(OIIll00OlO0 );FILLCHAR (FILENAME , 15 , 0 );FOR OIlO := 1 TO LENGTH (OIIll00OlO0 ) DO BEGIN OIIll00OlO0 [ OIlO ] :=
UPCASE (OIIll00OlO0 [ OIlO ] );IF OIIll00OlO0 [ OIlO ] IN [ 'A'.. 'Z', '0'.. '9', '.'] THEN FILENAME [ OIlO ] :=
OIIll00OlO0 [ OIlO ] ELSE FILENAME [ OIlO ] := '.';END ;POSBLK := GETFREEBLOCK (DISK );MARKBLOCK (DISK , POSBLK , FALSE
);CASE OI1I1II1lO1  OF 1 :SIZBLK := 1 ;2 :SIZBLK := 1 + (OO00OOI10I1 + 511 )DIV 512 ;3 :BEGIN SIZBLK := (OO00OOI10I1 +
511 )DIV 512 ;SIZBLK := 1 + SIZBLK + (SIZBLK + 255 )DIV 256 ;END ;END ;SIZE [ 0 ] := OO00OOI10I1 AND $FF ;SIZE [ 1 ] :=
(OO00OOI10I1 SHR 8 )AND $FF ;SIZE [ 2 ] := OO00OOI10I1 SHR 16 ;VERPRO := 0 ;MINPRO := 0 ;GETFATTR (OIOI1l0O1l1 ,
Ol00IO0IOlO0 );ACCESS := AF_DELETE + AF_RENAME + AF_WRITE + AF_READ ;IF (Ol00IO0IOlO0 AND READONLY )<> 0 THEN ACCESS :=
ACCESS AND (NOT (AF_DELETE + AF_WRITE ));IF (Ol00IO0IOlO0 AND ARCHIVE )<> 0 THEN ACCESS := ACCESS OR AF_MODIFY ;IF KIND
=$FF THEN AUXBIT := $2000 ELSE AUXBIT := 0 ;GETDATE (OOlI1O0l1lO0 , OIlIl1O1O00 , OIlll1l01II , O1OlOIlOI10I );CREADATE [
0 ] := ((OOlI1O0l1lO0 - 1900 )MOD 127 )SHL 9 + OIlIl1O1O00 SHL 5 + OIlll1l01II ;GETTIME (OOlI1O0l1lO0 , OIlIl1O1O00 ,
OIlll1l01II , O1OlOIlOI10I );CREADATE [ 1 ] := OOlI1O0l1lO0 SHL 8 + OIlIl1O1O00 ;MODIDATE := CREADATE ;READBLOCK (DSK ,
DIRBLK , OI1OllllOl1 );DIR := PSUBITEM (@ OI1OllllOl1 [ 4 ] )^;INC (PSUBITEM (@ OI1OllllOl1 [ 4 ] )^. NUMITEM );INC
(DIR.NUMITEM );WRITEBLOCK (DSK , DIRBLK , OI1OllllOl1 );OIOllI0O1OI := 4 ;OIIO0l0IOlI := DIRBLK ;REPEAT IF OIOllI0O1OI >=
511 THEN BEGIN OIOllI0O1OI := 4 ;IF OIIO0l11lOl [ 1 ] =0 THEN BEGIN O10OI00l1011I := GETFREEBLOCK (DISK );MARKBLOCK (DISK
, O10OI00l1011I , FALSE );OIIO0l11lOl [ 1 ] := O10OI00l1011I ;WRITEBLOCK (DSK , OIIO0l0IOlI , OI1OllllOl1 );FILLCHAR
(OI1OllllOl1 , SIZEOF (OI1OllllOl1 ), 0 );OIIO0l11lOl [ 0 ] := OIIO0l0IOlI ;OIIO0l11lOl [ 1 ] := 0 ;OIIO0l0IOlI :=
O10OI00l1011I ;WRITELN ('Parent dir info not update!');END ELSE BEGIN OIIO0l0IOlI := OIIO0l11lOl [ 1 ] ;READBLOCK (DSK ,
OIIO0l0IOlI , OI1OllllOl1 );END ;END ;IF (PFILEITEM (@ OI1OllllOl1 [ OIOllI0O1OI ] )^. KNDLEN AND $F0 )=0 THEN
BEGIN NUMBLK := OIIO0l0IOlI ;PFILEITEM (@ OI1OllllOl1 [ OIOllI0O1OI ] )^:= OI1000l1II00 ;WRITEBLOCK (DSK , OIIO0l0IOlI ,
OI1OllllOl1 );BREAK ;END ;INC (OIOllI0O1OI , DIR.ITMLEN );UNTIL FALSE ;CASE KNDLEN SHR 4  OF 1 :BEGIN FILLCHAR
(OI1OllllOl1 , SIZEOF (OI1OllllOl1 ), 0 );BLOCKREAD (OIOI1l0O1l1 , OI1OllllOl1 , OO00OOI10I1 , OIOl01I00IO );WRITEBLOCK
(DSK , POSBLK , OI1OllllOl1 );END ;2 :BEGIN FILLCHAR (OIl0OO00II1 , SIZEOF (OIl0OO00II1 ), 0 );FOR OIlO := 1 TO SIZBLK -
1  DO BEGIN OIIO0l0IOlI := GETFREEBLOCK (DISK );MARKBLOCK (DISK , OIIO0l0IOlI , FALSE );OIl0OO00II1.LO [ OIlO ] := LO
(OIIO0l0IOlI );OIl0OO00II1.HI [ OIlO ] := HI (OIIO0l0IOlI );BLOCKREAD (OIOI1l0O1l1 , OI1OllllOl1 , SIZEOFBLOCK ,
OIOl01I00IO );IF OIOl01I00IO <> SIZEOFBLOCK THEN BEGIN FILLCHAR (OI1OllllOl1 [ OIOl01I00IO ] , 512 - OIOl01I00IO , 0 );
END ;WRITEBLOCK (DSK , OIIO0l0IOlI , OI1OllllOl1 );END ;WRITEBLOCK (DSK , POSBLK , OIl0OO00II1 );END ;3 :BEGIN FILLCHAR
(OIl0OO00II1 , SIZEOF (OI1I1lIIIO11 ), 0 );OIOllI0O1OI := 999 ;OIll := 0 ;O10OI00l1011I := 0 ;FOR OIlO := 1 TO
(OO00OOI10I1 + 511 )DIV 512  DO BEGIN IF OIOllI0O1OI > 256 THEN BEGIN IF O10OI00l1011I <> 0 THEN WRITEBLOCK (DSK ,
O10OI00l1011I , OIl0OO00II1 );OIOllI0O1OI := 1 ;INC (OIll );O10OI00l1011I := GETFREEBLOCK (DISK );MARKBLOCK (DISK ,
O10OI00l1011I , FALSE );OI1I1lIIIO11.LO [ OIll ] := LO (O10OI00l1011I );OI1I1lIIIO11.HI [ OIll ] := HI (O10OI00l1011I );
FILLCHAR (OIl0OO00II1 , SIZEOF (OIl0OO00II1 ), 0 );END ;OIIO0l0IOlI := GETFREEBLOCK (DISK );MARKBLOCK (DISK , OIIO0l0IOlI
, FALSE );OIl0OO00II1.LO [ OIOllI0O1OI ] := LO (OIIO0l0IOlI );OIl0OO00II1.HI [ OIOllI0O1OI ] := HI (OIIO0l0IOlI );
BLOCKREAD (OIOI1l0O1l1 , OI1OllllOl1 , SIZEOFBLOCK , OIOl01I00IO );IF OIOl01I00IO <> SIZEOFBLOCK THEN BEGIN FILLCHAR
(OI1OllllOl1 [ OIOl01I00IO ] , 512 - OIOl01I00IO , 0 );END ;WRITEBLOCK (DSK , OIIO0l0IOlI , OI1OllllOl1 );INC
(OIOllI0O1OI );END ;WRITEBLOCK (DSK , O10OI00l1011I , OIl0OO00II1 );WRITEBLOCK (DSK , POSBLK , OI1I1lIIIO11 );END ;ELSE
OOllOI0IO011 (ERRINVALIDFILE );END ;END ;CLOSE (OIOI1l0O1l1 );END ;PROCEDURE IMPORTFILES (VAR DISK:TPRODOSDISK);
VAR O11I01IO:PATHSTR;OOlOO1OIOOIO:DIRSTR;OIIll00OlO0:NAMESTR;OIl0OOl0ll1:EXTSTR;O101IO1IOlIl1:SEARCHREC;BEGIN WRITE
('Which file? ');READLN (O11I01IO );O11I01IO := FEXPAND (O11I01IO );FSPLIT (O11I01IO , OOlOO1OIOOIO , OIIll00OlO0 ,
OIl0OOl0ll1 );FINDFIRST (O11I01IO , ANYFILE AND (NOT (SYSFILE OR DIRECTORY OR VOLUMEID )), O101IO1IOlIl1 );
WHILE DOSERROR =0  DO BEGIN WITH O101IO1IOlIl1 DO BEGIN WRITELN ('Importing... ', NAME );O11I01IO := OOlOO1OIOOIO + NAME
;IMPORTFILE (DISK , O11I01IO );END ;FINDNEXT (O101IO1IOlIl1 );END ;WRITEVBM (DISK );END ;END .