ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/MBUG/MBUG094.ARC/NMANAGER.PAS

Pascal/Delphi Source File | 1979-12-31 | 5KB | 193 lines

{$R+}

Const
   MaxDirSize=1100;

type
    FileName= string[12];{e.g. FREDRICK.PAS}
    BlockData=Array [0..15] of byte;
    SectorBuff= array [0..127] of byte;
    DirName = record
                DName:FileName;
                DTrack,DSector,DOffSet:integer;
                DExtNo,DUser:Byte
              end;

var
    Auto:Boolean; {True if auto printing for complete drive}

{$I DISPSECT.PRO}




Procedure ScreenDump;

Var
  line,column:integer;

Const
  VideoStart=$F000;
  Mask      =$7F;

begin
  For line:= 0 to 23 do begin
      For  column:=0 to 79 do
           write(Lst,Char(Mem[VideoStart+line*80+column] and Mask));
      Writeln(Lst);
  end;
end;

{$I NMANGR1.pro}
{$I NMANGR2.PRO}

Procedure WSPFilesDspChg(WSpIndex:integer);

Var Response1,Loop1,PageStart:integer;

begin
     With Directory[DirIndex[WSpIndex]] do  begin
        GetRecord(DriveSelected,Dtrack,DSector);
        for x:=0 to 15 do DirBlocks[x]:= DMA[DOffset+16+x]
     end;
     GetWSPFiles;
     ShellSort(EndWSpDirPtr+1,EndOfDirectory);
     FillIndex(WorkSpaceDirStart,EndWSpDirPtr+1,EndOfDirectory,WorkSpaceDirEnd);
     WorkSpaceDirEnd:= WorkSpaceDirEnd-1;
     If auto then
      begin
          With Directory[DirIndex[WSpIndex]] do
                WriteLn(lst,' ',DriveStr,':',Dname,#10);
          Loop1:=4;
          For Loop:=WorkSpaceDirStart to WorkSpaceDirEnd do
           begin
              If Loop1=4 then
               begin
                  Loop1:=0;
                  WriteLn(Lst);
                  Write('   ')
               end;
              With Directory[DirIndex[Loop]] do Write(Lst,'    ',Dname);
              Loop1:=Loop1+1
            end;
           WriteLn(Lst,#10#10)
      end
     else
      begin
         Index:=WorkSpaceDirStart;
         PageStart:=WorkSpaceDirStart;
         Repeat
           With Directory[DirIndex[WSpIndex]] do
            begin
               If auto then WriteLn(lst,DriveStr,':',Dname,#10)
               else
                begin
                   ClrScr;
                   LowVideo;
                   WriteLn('WorkSpace = ',Dname);
                   NormVideo;
                   Writeln('         TRACK = ',Dtrack,'  SECTOR = ',Dsector,' OFFSET = ',Doffset)
                end
            end;
           Select(PageStart,WorkSpaceDirStart,WorkSpaceDirEnd,Index,Response1);
           Case Response1 of
                127:DeleteFile(Index);
                13 : DisplayWSpFile(WSpIndex,Index);
           end;
         until Response1=27 {ESC}
  end
end;

Procedure WorkSpacesDspChg;

Var WSpIndex,Response,PageStart:integer;

Begin
  GetWSpaces;
  WriteLn;
  ShellSort(0,EndWSPDirPtr);
  FillIndex(0,0,EndWSpDirPtr,WorkSpaceDirStart);
  WSpIndex:=0;
  PageStart:=0;
  repeat
     ClrScr;
     LowVideo;Write('      WORKSPACES     ');
     WriteLn(' ON  DRIVE = ',DriveStr);NormVideo;
     If auto then begin
           Writeln(#10'Please wait printing Work Space File names');
           for WSpIndex:=0 to WorkSpaceDirStart-1 do
           begin
              WSPFilesDspChg(WSpIndex);
              GotoXY(1,10);
              Writeln( WSpIndex+1,' out of ',WorkSpaceDirStart,' Workspaces Completed');
           end;
           Response:=27
     end
     else Select(PageStart,0,WorkSpaceDirStart-1,WSpIndex,Response);
     Case Response of
         127: DeleteFile(WSpIndex);
         13 : WSPFilesDspChg(WSpIndex);
     end;
  until Response=27; {ESC}
end;
Procedure testing;
Var
   count:integer;

Procedure test(var pos:byte);

Var
  Buffer:sectorbuff absolute pos;

begin
     DisplaySector(Buffer)
end;

begin
  For x:=0 to 3 do
   begin
     count:=x*128;
     test(DMA[count]);
     Delay(2000)
   end
end;      {****}

Begin
  SavedDrive:=Mem[4];
  CurDrive:=-1; {No data in DMA}
  {Write('Default Drive = ',SavedDrive,
        ' WarmStart= ',Mem[0],' ',Mem[1],' ',Mem[2]);Delay(1500);}{****}
  Fillchar(DMA,128,0);
  repeat
     ClrScr;
     Writeln('The Starnet Network Manager');
     Writeln(#10,'    Authored by R.K.Hallworth');
     Writeln(    '    of Donvale Christian School,Victoria');
     Writeln(    '    This software is Public Domain');
     WriteLn(    '       Version 1.1   Jan 1987'#10#10);
     Write('Which Drive ( A ... E)  ? ');
     Repeat
        Read(Kbd,DriveStr);
        DriveStr:=UpCase(DriveStr)
     until DriveStr in ['A'..'E',#27];
     If DriveStr=#27 then write('ESC');
     If DriveStr<>#27
        then begin
               Writeln(DriveStr);
               DriveSelected:= ord(DriveStr)-65;
               GetDriveInfo(DriveSelected);
               Write(#10,'Do you want a printout of all WorkSpace Contents ? (Y/N) ');
               Repeat
                   Read(Kbd,Ch);
                   Ch:=UpCase(Ch)
               Until Ch in ['Y','N'];
               WriteLn(Ch);
               Auto:= (Ch='Y');
               WorkSpacesDspChg
             end
  until DriveStr=#27;
  {testing;} {****}
  GetDriveInfo(SavedDrive);
end.