Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/LU86_2.ZIP/LU86-2.PAS

Pascal/Delphi Source File | 1986-11-08 | 19.7 KB | 768 lines

{$C-}
{     Compile with RawTurbo using mAximum Stack of 800h paragraphs     }
PROGRAM Lu86;
CONST
    Version        = 'Lu86 v 1.06';
    CopyRight      = '  (c)1984 by Charlie Godet-Ceraolo';
    Active         = $00;
    Colon          = ':';
    CRMsg          = ' (<CR> exits) : ';
    Deleted        = $FE;
    LibExt         = '.LBR';
    LinesPerScreen = 20;
    NoFileMsg      = ' not found';
    NoLibMsg       = 'No Library open';
    NumAcross      = 4;
    Period         = '.';
    QMark          = '?';
    ROMsg          = 'Library is READ ONLY';
    SectorSize     = 128;
    SlotsPerSect   =   4;
    Space          = ' ';
    Star           = '*';
    UnUsed         = $FF;
    ZeroCRC        =  0;

TYPE
    AnyFile      = FILE;
    BdosRegs     = RECORD
                     AX,BX,CX,DX,BP,
                     SI,DI,DS,ES,Flags : INTEGER;
                   END;
    LineType     = STRING[80];
    FNamType     = STRING[20];
    NameType     = ARRAY[1..11] OF CHAR;
    DirInfoRec   = RECORD
                      MaxEnts   : INTEGER;
                      HiSlotNum : INTEGER;
                      LiveEnts  : INTEGER;
                   END;
    DirEntryType = RECORD
                      Status : BYTE;
                      Fname  : NameType;
                      Start  : INTEGER;
                      Count  : INTEGER;
                      CRC    : INTEGER;
                      Fill   : ARRAY[0..13] OF BYTE;
                   END;
    DIRType      = ARRAY[0..1000] OF DirEntryType;
    DirPtr       = ^DIRType;
    DirSect      = ARRAY[0..3] OF DirEntryType;
    ResultType   = (LT,SAME,GT);

VAR
    Ch         : CHAR;
    DIR        : DirPtr;
    DirInfo    : DirInfoRec;
    Heap       : ^INTEGER;
    LibChanged : BOOLEAN;
    LibFile    : AnyFile;
    LibName    : FNamType;
    LibOpen    : BOOLEAN;
    LibRO      : BOOLEAN;

PROCEDURE Initialize;
BEGIN { Initialize }
    DIR     := NIL;
    LibName := '';
    LibOpen := FALSE;
    LibChanged := FALSE;
    WITH DirInfo DO BEGIN
        MaxEnts   := 0;
        HiSlotNum := 0;
    END;
END; { Initialize }

PROCEDURE UpString(VAR S : FNamType);
VAR
    X : BYTE;

BEGIN { UpString }
    FOR X := 1 TO LENGTH(S) DO
        IF S[X] IN ['a'..'z'] THEN S[X] := CHR(ORD(S[X])-32);
END; { UpString }

PROCEDURE GetFileName( Msg : LineType; VAR S : FNamType );
BEGIN { GetFileName }
    WRITE(Msg+CRMsg);
    READLN(S);
    UpString(S);
END; { GetFileName }

FUNCTION IsWild( S : FNamType ) : BOOLEAN;
BEGIN { IsWild }
    IsWild := ( (POS(QMark,S) <> 0 ) OR (POS(Star,S) <> 0) )
END; { IsWild }

FUNCTION GetDirSize(VAR NumSlots,NumSects : INTEGER; MinSlots : INTEGER) : BOOLEAN;
LABEL 99;
VAR
    Code     : INTEGER;
    S        : STRING[20];

BEGIN { GetDirSize }
    GetDirSize := FALSE;
    WRITE('Number of Slots in New Library'+CRMsg);
    READLN(S);
    IF S <> '' THEN  BEGIN
        VAL(S,NumSlots,Code);
        IF Code <> 0 THEN GOTO 99;
        NumSlots := NumSlots + 1;  { for the Directory }
        IF NumSlots < MinSlots THEN NumSlots := MinSlots;
        NumSects := NumSlots DIV SlotsPerSect;
        IF NumSlots MOD SlotsPerSect <> 0 THEN NumSects := NumSects + 1;
        NumSlots := NumSects * SlotsPerSect;
        WRITELN('New Library has  ',NumSlots,' slots');
        GetDirSize := TRUE;
    END;
99:
END; { GetDirSize }

FUNCTION Compare(VAR A,B; Size : INTEGER) : ResultType;
TYPE
    Any = ARRAY[0..100] OF CHAR;

VAR
    A1    : Any ABSOLUTE A;
    B1    : Any ABSOLUTE B;
    Equal : BOOLEAN;
    X     : INTEGER;

BEGIN { Compare }
    Compare := SAME;
    Equal   := TRUE;
    X       := 0;
    WHILE Equal AND (X < Size) DO BEGIN
         IF A1[X] <> QMark THEN Equal := (A1[X] = B1[X]);
         X := X + 1;
    END;
    X := X - 1;
    IF NOT Equal THEN IF (A1[X] < B1[X]) THEN Compare := LT
    ELSE IF (A1[X] > B1[X]) THEN Compare := GT;
END; { Compare }

PROCEDURE PrintFileName(D : DirEntryType);
VAR
    X : INTEGER;

BEGIN { PrintFileName }
    FOR X := 1 TO 8 DO WRITE(D.FName[X]);
    WRITE(Period);
    FOR X := 9 TO 11 DO WRITE(D.FName[X]);
END; { PrintFileName }

PROCEDURE ListNames;
VAR
    X     : BYTE;
    Items : BYTE;
    I     : INTEGER;

PROCEDURE Pause;
VAR
    Ch : CHAR;

BEGIN { Pause }
    WRITE('[More..]');
    READ(KBD,Ch);
END; { Pause }

BEGIN { ListNames }
    Items := 0;
    WRITELN;
    WITH DirInfo DO BEGIN
        WRITE(LibName,': Max ',MaxEnts);
        WRITE(', Free ', MaxEnts - LiveEnts);
    END;
    WRITELN; WRITELN;
    FOR I := 1 TO DirInfo.HiSlotNum DO WITH DIR^[I] DO BEGIN
        IF Status = Active THEN BEGIN
            Items := Items + 1;
            PrintFileName(DIR^[I]);
            WRITE((Count DIV 8)+1:4,'k');
        IF Items MOD NumAcross = 0 THEN BEGIN
                WRITELN;
                IF Items MOD (NumAcross * LinesPerScreen) = 0 THEN Pause;
            END
            ELSE WRITE(' |');
        END;
    END;
    WRITELN; WRITELN;
END; { ListNames }

PROCEDURE ReadDir;
VAR
    DirBuf   : DirSect;
    DirSects : INTEGER;
    X,Y      : INTEGER;

FUNCTION IsReadOnly(VAR F : AnyFile) : BOOLEAN;
TYPE
    FibType = ARRAY[0..48] OF BYTE;
VAR
    P : ^FibType;

BEGIN { IsReadOnly }
    P := ADDR(F);
    IsReadOnly := ( (P^[21] AND $80) <> 0 );
END; { IsReadOnly }

BEGIN { ReadDir }
    BLOCKREAD(LibFile,DirBuf,1);
    DirSects := DirBuf[0].Count;
    GETMEM(DIR,DirSects * SectorSize);
    WITH DirInfo DO BEGIN
        LiveEnts := 0;
        MaxEnts  := (DirSects * SlotsPerSect);
        HiSlotNum := MaxEnts - 1;
        LibRO    := IsReadOnly(LibFile);
    END;
    SEEK(LibFile,0);
    BLOCKREAD(LibFile,DIR^,DirSects);
    FOR X := 0 TO DirInfo.HiSlotNum DO WITH DirInfo DO BEGIN
        IF DIR^[X].Status = Active THEN LiveEnts := LiveEnts + 1;
    END;
END; { ReadDir }

PROCEDURE MakeName(S : FNamType; VAR N : NameType);
VAR
   State : (Moving, Delimiter, WildCard, EndString);
   X,Y   : BYTE;

PROCEDURE DoExtension(StartinString : BYTE);
BEGIN { DoExtension }
    State := Moving;
    X     := StartinString;
    Y     := 9;
    WHILE State = Moving DO BEGIN
        IF X > LENGTH(S) THEN State := EndString
        ELSE IF S[X] = Star THEN State := WildCard
        ELSE BEGIN
            N[Y] := S[X];
            X    := X + 1;
            Y    := Y + 1;
        END;
    END; { While }
    IF State = WildCard THEN FOR X := Y TO 11 DO N[X] := QMark
END; { DoExtension }

BEGIN { MakeName }
    FILLCHAR(N,SIZEOF(N),Space);
    UpString(S);
    X := POS(Colon,S);
    IF X <> 0 THEN DELETE(S,1,X);
    State := Moving;
    X     := 1;
    WHILE State = Moving DO BEGIN
        IF X > LENGTH(S) THEN State := EndString
        ELSE IF S[X] = Period THEN State := Delimiter
        ELSE IF S[X] = Star THEN State := WildCard
        ELSE BEGIN
            N[X] := S[X];
            X    := X + 1;
        END;
    END; { While }
    IF State = Delimiter THEN DoExtension(X+1)
    ELSE IF State = WildCard THEN BEGIN
             FOR Y := X TO 8 DO N[Y] := QMark;
             DoExtension(X+2);
         END;
END; { MakeName }

PROCEDURE MakeString(N : NameType; VAR S : FNamType);
VAR
    X : BYTE;

BEGIN { MakeString }
    S := '';
    FOR X := 1 TO 8 DO IF N[X] <> Space THEN S := S + N[X];
    S := S + Period;
    FOR X := 9 TO 11 DO IF N[X] <> Space THEN S := S + N[X];
END; { MakeString }

FUNCTION Search(S : FNamType; P : INTEGER) : INTEGER;
VAR
   Matched : BOOLEAN;
   Temp    : NameType;

BEGIN { Search }
    MakeName(S,Temp);
    Matched := FALSE;
    WHILE (P < DirInfo.MaxEnts) AND NOT Matched DO BEGIN
        IF (Compare(Temp,DIR^[P].FName,11) = SAME) AND (DIR^[P].Status = Active)
        THEN Matched := TRUE
        ELSE P := P + 1;
    END;
    IF Matched THEN Search := P ELSE Search := 0;
END; { Search }

PROCEDURE CopyFile(VAR F1,F2 : AnyFile; SecsToCopy : INTEGER);
VAR
    RecsToRead  : INTEGER;
    P           : ^BYTE;
    Free,
    BufSize,
    Buffer      : INTEGER;

BEGIN { CopyFile }
    Free    := (MemAvail * 16) - 1024;    { just in case }
    BufSize := Free DIV 128;
    Buffer  := BufSize * 128;
    GetMem(P,Buffer);
    WHILE (SecsToCopy > 0) DO BEGIN
        IF BufSize <= SecsToCopy THEN RecsToRead := BufSize
        ELSE RecsToRead := SecsToCopy;
        BLOCKREAD(F1,P^,RecsToRead);
        BLOCKWRITE(F2,P^,RecsToRead);
        SecsToCopy := SecsToCopy - RecsToRead;
    END;
    FREEMEM(P,Buffer);
END; { CopyFile }

FUNCTION UserAbort : BOOLEAN;
VAR
    Ch : CHAR;

BEGIN { UserAbort }
    UserAbort := FALSE;
    IF KEYPRESSED THEN BEGIN
        READ(KBD,Ch);
        IF Ch = CHR(3) THEN BEGIN
            WRITELN; WRITELN('User Abort'); WRITELN;
            UserAbort := TRUE
        END;
    END;
END; { UserAbort }

PROCEDURE Extract;
VAR
    Drive   : STRING[3];
    OutName : FNamType;
    P       : INTEGER;
    S       : FNamType;
    X       : INTEGER;

PROCEDURE ExtractOne(OutName : FNamType; P : INTEGER);
VAR
    OutFile : AnyFile;

BEGIN { ExtractOne }
    ASSIGN(OutFile,OutName);
    REWRITE(OutFile);
    SEEK(LibFile,DIR^[P].Start);
    CopyFile(LibFile,OutFile,DIR^[P].Count);
    CLOSE(OutFile);
    WRITELN(OutName,' extracted');
END; { ExtractOne }

BEGIN { Extract }
    GetFileName('File(s) to extract',OutName);
    IF OutName <> '' THEN BEGIN
        X := POS(Colon,OutName);
        IF X <> 0 THEN BEGIN
            Drive := COPY(OutName,1,X);
            DELETE(OutName,1,X);
        END
        ELSE Drive := '';
        P := Search(OutName,1);
        IF P = 0 THEN WRITELN(OutName,NoFileMsg)
        ELSE WHILE (P <> 0) AND (NOT UserAbort) DO BEGIN
                MakeString(DIR^[P].FName,S);
                ExtractOne(Drive + S,P);
                P := Search(OutName,P+1);
             END;
    END;
END; { Extract }

PROCEDURE DeleteFile;
VAR
    OutName : FNamType;
    P       : INTEGER;

PROCEDURE DeleteOne( P : INTEGER );
BEGIN { DeleteOne }
    DIR^[P].Status   := Deleted;
    LibChanged       := TRUE;
    DirInfo.LiveEnts := DirInfo.LiveEnts - 1;
    PrintFileName(DIR^[P]);
    WRITELN(' deleted');
END; { DeleteOne }

BEGIN { DeleteFile }
    GetFileName('File(s) to delete',OutName);
    IF OutName <> '' THEN BEGIN
        P := Search(OutName,1);
        IF P = 0 THEN WRITELN(OutName,NoFileMsg)
        ELSE WHILE (P <> 0) AND (NOT UserAbort) DO BEGIN
                DeleteOne(P);
                P := Search(OutName,P+1);
             END;
    END;
END; { DeleteFile }

PROCEDURE AddFiles;
CONST
    SrchFirst = 17;
    SrchNext  = 18;
    SetDMA    = 26;
    DmaBase   = 51;
    FCBRC     = 15;
    FCBEX     = 12;

TYPE
    BufferType   = ARRAY[0..127] OF BYTE;
    FcbType      = ARRAY[0..32] OF BYTE;
    FileRecPtr   = ^FileRec;
    FileRec      = RECORD
                      Next : FileRecPtr;
                      Name : NameType;
                   END;

VAR
    Buffer   : BufferType;
    Drive    : STRING[3];
    Fcb      : FcbType;
    ListHead : FileRecPtr;
    ListTail : FileRecPtr;
    Name     : NameType;
    P,Q      : FileRecPtr;
    S        : FNamType;
    X        : BYTE;
    Which    : BYTE;


PROCEDURE AddOne( FN : NameType);
LABEL 99;
VAR
    Found    : BOOLEAN;
    P        : INTEGER;
    S        : FNamType;
    TempFile : AnyFile;

BEGIN { AddOne }
    P     := 1;
    Found := FALSE;
    WHILE (P < DirInfo.MaxEnts) AND NOT Found DO
        IF (DIR^[P].Status = Deleted) OR (DIR^[P].Status = UnUsed) THEN Found := TRUE
        ELSE P := P + 1;
    IF NOT Found THEN BEGIN
        WRITELN('Library is FULL');
        GOTO 99;
    END;
    MakeString(FN,S);
    ASSIGN(TempFile,Drive+S);
    {$I-}
    RESET(TempFile);
    {$I+}
    IF IORESULT <> 0 THEN BEGIN
        WRITELN(S,NoFileMsg);
        GOTO 99;
    END;
    WITH DIR^[P] DO BEGIN
        Status := 0;
        FName  := FN;
        Start  := FILESIZE(LibFile);
        Count  := FILESIZE(TempFile);
        CRC    := ZeroCRC;
    END;
    SEEK(LibFile,FILESIZE(LibFile));
    CopyFile(TempFile,LibFile,FILESIZE(TempFile));
    CLOSE(TempFile);
    LibChanged := TRUE;
    WITH DirInfo DO BEGIN
        LiveEnts  := LiveEnts + 1;
    END;
    WRITELN(Drive+S,' added');
99:
END; { AddOne }

PROCEDURE InitList;
BEGIN
    ListTail := NIL;
    ListHead := NIL;
END;

PROCEDURE InitFcb(Name : NameType);
VAR
    X : BYTE;

BEGIN
    IF Drive = '' THEN Fcb[0] := 0
    ELSE Fcb[0] := ORD(Drive[1]) - ORD('@');
    Fcb[FCBEX] := 0;
    Fcb[FCBRC] := 0;
    Fcb[32]    := 0;
    Move(Name,Fcb[1],11);
END;

PROCEDURE AddName(Entry : NameType);
VAR
    P : FileRecPtr;

BEGIN { AddName }
    NEW(P);
    P^.Name := Entry;
    P^.Next := NIL;
    IF ListHead = NIL THEN ListHead := P
    ELSE ListTail^.Next := P;
    ListTail := P;
END; { AddName }

PROCEDURE DoDMA86;
VAR
    Regs : BdosRegs;

BEGIN { DoDMA86 }
    WITH Regs DO BEGIN
        CX := SetDMA;
        DX := OFS(Buffer);
        DS := SEG(Buffer);
    END;
    BDOS(Regs);
    WITH Regs DO BEGIN
        CX := DMABase;
        DX := SEG(Buffer);
        DS := SEG(Buffer);
    END;
    BDOS(Regs);
END; { DoDMA86 }

FUNCTION Bdos86(FunctNum : BYTE) : BYTE;
VAR
    Regs : BdosRegs;

BEGIN { Bdos86 }
    WITH Regs DO BEGIN
        CX := FunctNum;
        DX := OFS(Fcb);
        DS := SEG(Fcb);
    END;
    BDOS(Regs);
    Bdos86 := Regs.AX AND $FF;
END; { Bdos86 }

FUNCTION SysDir(Funct : BYTE; VAR Entry : NameType) : BOOLEAN;
VAR
    BufIndex,X : BYTE;

BEGIN { SysDir }
    BufIndex  := Bdos86(Funct);
    IF BufIndex <> 255 THEN BEGIN
        BufIndex := BufIndex SHL 5;
        MOVE(Buffer[BufIndex+1],Entry,11);
        FOR X := 1 TO 11 DO Entry[X] := CHR(ORD(Entry[X]) AND $7F);
        SysDir := TRUE;
    END
    ELSE SysDir := FALSE;
END; { SysDir }

BEGIN { AddFiles }
    GetFileName('File(s) to Add',S);
    IF S <> '' THEN BEGIN
        DoDMA86;
        InitList;
        X := POS(Colon,S);
        IF X <> 0 THEN BEGIN
            Drive := COPY(S,1,X);
            DELETE(S,1,X);
        END
        ELSE Drive := '';
        MakeName(S,Name);
        InitFcb(Name);
        Which  := SrchFirst;
        WHILE SysDir(Which,Name) DO BEGIN
              AddName(Name);
              Which := SrchNext;
        END;
        P := ListHead;
        WHILE P <> NIL DO BEGIN
            AddOne(P^.Name);
            Q := P;
            P := P^.Next;
            DISPOSE(Q);
        END;
    END;
END; { AddFiles }

PROCEDURE WriteDir(VAR F : AnyFile; VAR D : DirPtr; NumSectors : INTEGER);
BEGIN { WriteDir }
    SEEK(F,0);
    BLOCKWRITE(F,D^,NumSectors);
END; { WriteDir }

PROCEDURE CloseLibrary;
BEGIN { CloseLibrary }
    IF LibChanged
    THEN WriteDir(LibFile,DIR,DirInfo.MaxEnts DIV SlotsPerSect);
    CLOSE(LibFile);
    RELEASE(Heap);
    Initialize;
END; { CloseLibrary }

PROCEDURE InitDir(VAR D : DirPtr; NumSlots,NumSects : INTEGER);
VAR
    I : INTEGER;

BEGIN { InitDir }
    FOR I := 1 TO NumSlots-1 DO BEGIN
        D^[I].Status := UnUsed;
        FILLCHAR(D^[I].FName,11,Space);
    END;
    WITH D^[0] DO BEGIN
        Status := Active;
        Start  := $00;
        Count  := NumSects;
        FILLCHAR(FName,11,Space);
        FILLCHAR(CRC,16,UnUsed);    { To assure compatibility with CRC }
    END;
END; { InitDir }

FUNCTION CreateLibrary(VAR LF : AnyFile; VAR D : DirPtr) : BOOLEAN;
LABEL 99;

VAR
    NumSects : INTEGER;
    NumSlots : INTEGER;

BEGIN { CreateLibrary }
    CreateLibrary := FALSE;
    IF NOT GetDirSize(NumSlots,NumSects,1) THEN GOTO 99;
    GETMEM(D,NumSects * SectorSize);
    REWRITE(LF);
    InitDir(D,NumSlots,NumSects);
    WriteDir(LF,D,NumSects);
    FREEMEM(D,NumSects * SectorSize);
    CLOSE(LF);
    RESET(LF);
    CreateLibrary := TRUE;
99:
END; { CreateLibrary }

PROCEDURE OpenLibrary(VAR LF : AnyFile; VAR D : DirPtr; VAR FN : FNamType);
LABEL 99;
BEGIN { OpenLibrary }
    ASSIGN(LF,FN);
    {$I-}
    RESET(LF);
    {$I+}
    IF (IORESULT <> 0) THEN IF NOT CreateLibrary(LF,D) THEN GOTO 99;
    MARK(Heap);
    ReadDir;
    LibOpen := TRUE;
    WRITELN;
99:
END; { OpenLibrary }

PROCEDURE Open(VAR LF : AnyFile; VAR D : DirPtr; VAR FN : FNamType);
VAR
    S : FNamType;

BEGIN { Open }
    GetFileName('Library file',S);
    IF S <> '' THEN BEGIN
        IF LibOpen THEN CloseLibrary;
        FN := S;
        WHILE FN[1] = Space DO DELETE(FN,1,1);
        IF POS(Period,FN) = 0 THEN FN := FN + LibExt;
        OpenLibrary(LF,D,FN);
    END;
END; { Open }

PROCEDURE Reorganize;
LABEL 99;

VAR
   NewDir   : DirPtr;
   P,N      : INTEGER;
   NewLib   : AnyFile;
   NumSects : INTEGER;
   NumSlots : INTEGER;
   S        : FNamType;

PROCEDURE ShellSort;
LABEL 0;
VAR
    I,H,J : INTEGER;
    Temp  : DirEntryType;

BEGIN { ShellSort }
    H := 1;
    REPEAT H := 3*H + 1; UNTIL H > DirInfo.HiSlotNum;
    REPEAT
        H := H DIV 3;
        FOR I := H + 1 TO DirInfo.HiSlotNum DO BEGIN
            MOVE(DIR^[I],Temp,SIZEOF(Temp));
            J := I;
            WHILE Compare(DIR^[J-H],Temp.Status,12) = GT DO BEGIN
                MOVE(DIR^[J-H],DIR^[J],SIZEOF(DirEntryType));
                J := J - H;
                IF J <= H THEN GOTO 0;
            END; { While }
        0: MOVE(Temp,DIR^[J],SIZEOF(Temp));
        END; { For }
    UNTIL H = 1;
END; { ShellSort }

BEGIN { Reorganize }
    GetFileName('Name of New Library',S);
    IF S = '' THEN GOTO 99;
    IF POS(Period,S) = 0 THEN S := S + LibExt;
    IF NOT GetDirSize(NumSlots,NumSects,DirInfo.LiveEnts) THEN GOTO 99;
    GETMEM(NewDir,NumSects * SectorSize);
    ASSIGN(NewLib,S);
    REWRITE(NewLIb);
    InitDir(NewDir,NumSlots,NumSects);
    WriteDir(NewLib,NewDir,NumSects);
    ShellSort;
    P := 1;
    N := 1;
    WHILE (P < DirInfo.MaxEnts) AND (DIR^[P].Status <> UnUsed) DO BEGIN
        IF UserAbort THEN GOTO 99;
        IF DIR^[P].Status = Active THEN BEGIN
            NewDir^[N] := DIR^[P];
            SEEK(NewLib,FILESIZE(NewLib));
            NewDir^[N].Start  := FILEPOS(NewLib);
            NewDir^[N].CRC    := ZeroCRC;
            SEEK(LibFile,DIR^[P].Start);
            CopyFile(LibFile,NewLib,DIR^[P].Count);
            PrintFileName(DIR^[P]);
            WRITELN(' copied to new library');
            N := N + 1;
        END;
        P := P + 1;
    END;
    WriteDir(NewLib,NewDir,NumSects);
    FREEMEM(NewDir,NumSects * SectorSize);
    CLOSE(NewLib);
    CloseLibrary;
    LibName := S;
    OpenLibrary(LibFile,DIR,LibName);
99:
END; { Reorganize }

BEGIN { UnLu }
    Initialize;
    WRITELN(Version,CopyRight); WRITELN;
    REPEAT
        IF LibOpen THEN WRITELN(LibName,':');
        WRITE('L(ist, E(xtract, O(pen, C(lose, A(dd, D(elete, R(eorg, Q(uit ? ');
        REPEAT
            READ(KBD,Ch);
            Ch := UPCASE(Ch);
        UNTIL Ch IN ['L','E','O','C','Q','A','D','R',#3];
        WRITELN(Ch);
        CASE Ch OF
            #3  : HALT;
            'L' : IF LibOpen THEN ListNames ELSE WRITELN(NoLibMsg);
            'E' : IF LibOpen THEN Extract ELSE WRITELN(NoLibMsg);
            'A' : IF NOT LibOpen THEN WRITELN(NoLibMsg)
                  ELSE IF NOT LibRO THEN AddFiles ELSE WRITELN(ROMsg);
            'D' : IF NOT LibOpen THEN WRITELN(NoLibMsg)
                  ELSE IF NOT LibRO THEN DeleteFile ELSE WRITELN(ROMsg);
            'O' : Open(LibFile,DIR,LibName);
            'C' : IF LibOpen THEN CloseLibrary ELSE WRITELN(NoLibMsg);
            'R' : IF LibOpen THEN Reorganize ELSE WRITELN(NoLibMsg);
            'Q' : IF LibOpen THEN CloseLibrary;
        END; { Case }
    UNTIL Ch = 'Q';
END. { UnLu }