home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG094.ARC / NMANGR1.PRO < prev    next >
Text File  |  1979-12-31  |  14KB  |  465 lines
  1. Var
  2.    DriveStr:char;
  3.    x,recrd,Block,SavedDrive,DriveSelected,DirCount,
  4.    Index,Loop,Loop2,OffSet,RecNo,Track,Sector,ExtNo:integer;
  5.    RecNoF,OffSetF,TrackF,SectorF,ExtNoF:integer;
  6.    CurSector,CurTrack,CurDrive:integer; {Current sector in DMA}
  7.    UserNF                              :Byte;
  8.    DMA                  : array[0..511] of Byte; {this needs to be large
  9.                                                   I don't know why but if
  10.                                                   small causes crash on exit
  11.                                                   from program}
  12.    SectorData:SectorBuff absolute DMA;
  13.    DirIndex: Array [0..MaxDirSize] of integer; {Points to posns in Directory
  14.                                                 where FIRST extents
  15.                                                 of files are}
  16.    WorkSpaceDirStart:integer; {Points to posn in DirIndex where files IN a
  17.                                WorkSpace are found}
  18.    WorkSpaceDirEnd:integer;
  19.    DirCounter:Integer; {used to load Directory}
  20.    Directory: Array [0..MaxDirSize] of DirName; {Points to disk location
  21.                                                  of directory entries
  22.                                                  (extents)}
  23. {File managing routines to directly access records in a file
  24.    need to obtain the Directory entry first}
  25.  
  26.  
  27. var
  28.  
  29.  
  30.   DPH,SPT,DSM,DPB,OFF,DRM:Integer;
  31.   SkewTrans:Boolean;
  32.   BSH,BLM:byte;
  33.  
  34.  
  35.  
  36. Procedure GetDriveInfo(Drive:integer);
  37.  
  38. Const
  39.    SelDsk=8;
  40.    GetDPB=31;
  41.  
  42. Procedure DefaultDrive(Drive:integer);
  43. Begin
  44.          bdos(13);{Reset drives causes disk allocation table to be built}
  45.          bdos(14,Drive);Mem[4]:=Drive;   {Select Drive }
  46.          {Bdos(13); Dont. It sets back to A}      {Reset Drives}
  47. end;
  48.  
  49. Begin
  50.   DefaultDrive(Drive);
  51.   DPH:=BiosHL(SelDsk,Drive);
  52.   If DPH=0 then Begin write('DPH error'); Halt end;
  53.   SkewTrans:=( (Mem[DPH]+Mem[DPH+1])<>0 );
  54.   DPB:=BdosHL(GetDPB);
  55.   DSM:=Mem[DPB+5]+256*Mem[DPB+6];
  56.   BLM:=Mem[DPB+3];
  57.   BSH:=Mem[DPB+2];
  58.   SPT:=Mem[DPB]+256*Mem[DPB+1];
  59.   OFF:=Mem[DPB+$0D]+256*Mem[DPB+$0D+1];
  60.   DRM:=Mem[DPB+$07]+256*Mem[DPB+$07+1];
  61. end;
  62.  
  63. Procedure LocateRecord(Var Blocks:BlockData;
  64.                        Var RecordInExtent,Track,Sector:Integer;
  65.                        BigDrv:Boolean);
  66.  
  67.   {Find track and sector within track
  68.        *** only operates on blocks covered by extent
  69.            must obtain drive info first}
  70. Var
  71.    X1,RemX1,Block,BlockNo,RecordInBlock:Integer;
  72. Begin
  73.   RecordInBlock:= RecordInExtent AND BLM;
  74.   BlockNo:= RecordInExtent shr BSH;
  75.   If BigDrv then
  76.         Block:= Blocks[BlockNo shl 1] + (Blocks[(BlockNo shl 1) +1] shl 8)
  77.   else
  78.         Block:= Blocks[BlockNo];
  79.   If (Block<0) or (Block>DSM) then begin write('Block too big');Halt end;
  80.   x1:= (Block div SPT) SHL BSH;
  81.   RemX1 := (Block mod SPT) SHL BSH;
  82.   Track := X1 + ((RemX1 + RecordinBlock) div SPT)+OFF;
  83.   Sector:= (RemX1+RecordinBlock) mod SPT; {Sector within track}
  84. end;
  85.  
  86. Procedure  GetRecord( Drive,Track,Sector:integer);
  87.  
  88. {Record placed in DMA}
  89.  
  90. Var Error :Byte;
  91. Const
  92.    SelDsk=8;
  93.    GetDPB=31;
  94.    SetTrk=9;
  95.    SetSec=10;
  96.    SecTran=15;
  97.    Read=12;
  98.    Set_DMA=26;
  99.  
  100. Begin
  101.   { GotoXY(20,23);Write('                   ');} {******}
  102.   If (Drive<>CurDrive) or (Track<>CurTrack) or (Sector<>CurSector)
  103.     then
  104.      begin
  105.        {GotoXY(20,23);Write('Reading ',Drive,' ',Track,' ',Sector);} {******}
  106.        BDos(Set_DMA,Addr(DMA));
  107.        If (Drive<>CurDrive) then Bios(SelDsk,Drive);
  108.        If (Drive<>CurDrive) or (Track<>CurTrack) then Bios(SetTrk,Track);
  109.        If SkewTrans then Sector:=BiosHL(SecTran,Sector);
  110.        Bios(SetSec,Sector);
  111.        Error:=Bios(Read);
  112.        If Error<>0 then begin write('I/O error =  ',Error);Halt end;
  113.        CurDrive:=Drive;
  114.        CurTrack:=Track;
  115.        CurSector:=Sector;
  116.      end
  117. end;
  118.  
  119. Procedure DeleteFile( Var Index:Integer);
  120.  
  121. Var
  122.   Ch:Char;
  123.   Oname:FileName;
  124.   DirIx:Integer;
  125.  
  126. Procedure WriteSector(Drive,Track,Sector:integer);
  127.  
  128. Var Error :Byte;
  129. Const
  130.    SelDsk=8;
  131.    GetDPB=31;
  132.    SetTrk=9;
  133.    SetSec=10;
  134.    SecTran=15;
  135.    Write=13;
  136.    Set_DMA=26;
  137.  
  138. Begin
  139.   BDos(Set_DMA,Addr(DMA));
  140.   Bios(SelDsk,Drive);
  141.   Bios(SetTrk,Track);
  142.   If SkewTrans then Sector:=BiosHL(SecTran,Sector);
  143.   Bios(SetSec,Sector);
  144.   {Write('***',Track,' ',Sector,' ',Offset,'***');}
  145.   Error:=Bios(Write);
  146.   If Error<>0 then begin write('I/O error =  ',Error);Halt end;
  147. end;
  148.  
  149. Begin
  150.     GotoXY(1,23);
  151.     DirIx:=DirIndex[Index];
  152.     OName:=Directory[DirIx].Dname;
  153.     Write('Do you want to delete ',Oname,' (Y/N) ? ');
  154.     Repeat
  155.        Read(Kbd,Ch);
  156.        Ch:=Upcase(Ch);
  157.     until Ch in ['Y','N'];
  158.     WriteLn(Ch);
  159.     If Ch='Y' then
  160.      begin
  161.          GoToXY(1,23);DelLine;
  162.          Repeat
  163.             with Directory[DirIx] do
  164.              begin
  165.                   OName:=Dname;
  166.                   GetRecord(DriveSelected,Dtrack,Dsector);
  167.                   DMA[Doffset]:=$E5;
  168.                   writesector(DriveSelected,Dtrack,Dsector)
  169.              end;
  170.              DirIx:=DirIx+1
  171.          until OName<>Directory[DirIx].DName;
  172.          WorkSpaceDirEnd:=WorkSpaceDirEnd-1;
  173.          For x:=Index to WorkSpaceDirEND do DirIndex[x]:=DirIndex[X+1];
  174.          If Index<WorkSpaceDirStart then
  175.           begin
  176.              WorkSpaceDirStart:=WorkSpaceDirStart-1;
  177.              If Index=WorkSpaceDirStart then Index:=WorkSpaceDirStart-1
  178.           end;
  179.          If Index>WorkSpaceDirEnd then Index:=WorkSpaceDirEnd;
  180.       end
  181. end;
  182.  
  183. Procedure GetNextFileName(     DirSize:integer;
  184.                                BigDrv :Boolean;
  185.                            Var RecNo,Track,Sector,Offset,ExtNo:Integer;
  186.                            Var UserNo:byte;
  187.                                UserMax,UserMin:Byte;
  188.                            Var DirBlocks:BlockData;   {array 0 to 15 int}
  189.                            Var EndDir:Boolean;
  190.                            Var Name:FileName);   {str[12]}
  191. begin
  192.      Repeat
  193.         Offset:=Offset+32;
  194.         if offSet>127 then begin
  195.             Offset:=0;
  196.             RecNo:=RecNo+1
  197.         end;
  198.         EndDir:= RecNo>DirSize;
  199.         If Not(EndDir) then begin
  200.            LocateRecord(DirBlocks,RecNo,Track,Sector,BigDrv);
  201.  
  202.            GetRecord(DriveSelected,Track,Sector); {DriveSelected a global integer}
  203.            Loop:=0;
  204.            Repeat
  205.              Loop:=Loop+1
  206.            until (DMA[Offset+Loop]<>$E5) or (loop>16);
  207.            If Loop>16 then EndDir:=TRUE
  208.         end
  209.      Until EndDir or ((DMA[OffSet]<=UserMax) and (DMA[Offset]>=UserMin) {and
  210.                             ((DMA[Offset+$C] shr 1)=0)} ); {First Entry TEMP**}
  211.      If Not(EndDir) then begin
  212.          UserNo:=DMA[Offset];
  213.          Name:='            ';
  214.          For Loop :=1 to 8 do Name[Loop]:=Char(DMA[OffSet+Loop] AND $7F);
  215.          Name[9]:='.';
  216.          For Loop :=9 to 11 do Name[Loop+1]:=Char(DMA[OffSet+Loop] AND $7F);
  217.          ExtNo:=DMA[Offset+$0C]
  218.      end;
  219. end;
  220. Var
  221.    DirBlocks,MainDirBlks:BlockData;   {array 0 to 15 int}
  222.    EndDirWSP,EndDirFLS:Boolean;
  223.    Name:FileName;
  224.    EndOfDirectory,DirSize,EndWSPDirPtr:integer; {Pointer to Directory}
  225.    Ch     :Char;
  226.    OName:FileName;
  227. Const
  228.    MainDirBlksL:BlockData=(0,0,1,0,2,0,3,0,4,0,5,0,6,0,7,0);
  229.    MainDirBlksS:BlockData=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15);
  230.  
  231. Procedure GetWSPFiles;
  232. begin
  233.    DirCounter:=EndWSPDirPtr+1;
  234.    RecNoF:=0;OffSetF:=-32;
  235.    Repeat
  236.  
  237.       GetNextFileName(   59,(DSM>$FF),RecNoF,TrackF,SectorF,OffsetF,ExtNoF,
  238.                          UserNF,
  239.                            $F,$0, {UserMax,UserMin}
  240.                            DirBlocks,
  241.                            EndDirFLS,
  242.                            Name);
  243.       If not(EndDirFLS) then begin
  244.          with Directory[DirCounter] do begin
  245.             DName:=Name;
  246.             DTrack:=TrackF;
  247.             DSector:=SectorF;
  248.             DOffset:=OffsetF;
  249.             DExtNo :=ExtNoF;
  250.             DUser  :=UserNF
  251.          end;
  252.          DirCounter:=DirCounter+1;
  253.       end
  254.    until EndDirFLS or (DirCounter>MaxDirSize);
  255.    EndOfDirectory:=DirCounter-1;
  256. end;
  257.  
  258. Procedure GetWSpaces;
  259. begin
  260.      DirCounter:=0;
  261.      DirSize:=DRM shr 2;
  262.      RecNo:=0;Offset:=-32;
  263.      If DSM>$FF then MainDirBlks:=MainDirBlksL else MainDirBlks:=MainDirBlksS;
  264.   repeat
  265.      GetNextFileName(DirSize,(DSM>$FF),RecNo,Track,Sector,Offset,ExtNo,UserNF,
  266.                            $20,$20, {UserMax,UserMin}
  267.                            MainDirBlks,
  268.                            EndDirWSP,
  269.                            Name);
  270.       If not(EndDirWSP) then begin
  271.          with Directory[DirCounter] do begin
  272.             DName:=Name;
  273.             DTrack:=Track;
  274.             DSector:=Sector;
  275.             DOffset:=Offset;
  276.             DExtNo :=ExtNo;
  277.             DUser  :=UserNF;
  278.          end;
  279.          DirCounter:=DirCounter+1;
  280.       end
  281.    until EndDirWSP or (DirCounter>(MaxDirSize-10));
  282.    EndWSPDirPtr:=DirCounter-1;
  283. end;
  284.  
  285. Procedure ShellSort(Start,Enddata:integer);
  286.  
  287. Var
  288.   ListMax,Indx,Jndx,Inc:Integer;
  289.   Temp:DirName;
  290.   Swap:Boolean;
  291.  
  292. Function DoSwap(Pos1,Pos2:DirName):Boolean;
  293.  
  294. begin
  295. If Pos1.DUser>Pos2.DUser
  296.    Then DoSwap:=True
  297.    else if (Pos1.DUser=Pos2.DUser) and (Pos1.Dname>Pos2.Dname)
  298.            then DoSwap:=True
  299.            else If (Pos1.DUser=Pos2.DUser) and (Pos1.Dname=Pos2.Dname) and (Pos1.DExtNo>Pos2.DExtNo)
  300.                    then  DoSwap:=True
  301.                    else DoSwap:=False
  302.  end;
  303.  
  304.  
  305. Function Index(Indx:integer):Integer;
  306.  
  307. Begin
  308.    Index:=Indx+Start-1
  309. end;
  310.  
  311. Begin
  312.   ListMax:=EndData-Start+1;
  313.   Inc:=1;
  314.   Repeat
  315.      Inc := 3*Inc+1
  316.   until Inc>ListMax;
  317.   Repeat
  318.      Inc := Inc div 3;
  319.      For Indx := Inc+1 to ListMax do begin
  320.          Temp := Directory[Index(Indx)];
  321.          Jndx := Indx;
  322.          Swap:= DoSwap(Directory[Index(Jndx-Inc)],Temp);
  323.          while  swap  do begin
  324.             Directory[Index(Jndx)] := Directory[Index(Jndx-Inc)];
  325.             Jndx := Jndx-Inc;
  326.             If Jndx>Inc then Swap:= DoSwap(Directory[Index(Jndx-Inc)],Temp)
  327.                         else Swap:=False
  328.          end;
  329.          Directory[Index(Jndx)] := Temp
  330.       end
  331.    until Inc = 1;
  332. end;
  333.  
  334. Procedure FillIndex(StartInx,StartDir,EndDir:Integer; Var IdxCounter:integer);
  335. Var
  336.    Oname      :FileName;
  337.    OUser      :byte;
  338.  
  339. Begin
  340.    Oname:='';
  341.    IdxCounter:=StartInx;
  342.    For DirCounter:=StartDir to EndDir do
  343.        If (Oname<>Directory[DirCounter].Dname) or (OUser<>Directory[DirCounter].DUser) then begin
  344.           Oname:= Directory[DirCounter].Dname;
  345.           OUser:=Directory[DirCounter].DUser;
  346.           DirIndex[IdxCounter]:=DirCounter;
  347.           IdxCounter:=IdxCounter+1
  348.    end
  349. end;
  350.  
  351. Procedure Select( Var ScreenStart:integer; IndexStart,IndexEnd:integer; Var Index,Response:integer);
  352.  
  353. Var OIndex:integer;
  354.  
  355. Const
  356.       LineStart=4;
  357.       Cmd=22;
  358.       PageSize=85;
  359.  
  360. Function ScrX(Index:integer):integer;
  361.  
  362. Var Scr:integer;
  363.  
  364. begin
  365.    Scr:=(Index-ScreenStart) mod 5;
  366.    ScrX:= Scr*16+1; {80 div 5}
  367. end;
  368.  
  369. Function ScrY(Index:integer):integer;
  370.  
  371. begin
  372.    ScrY:=((Index-ScreenStart) div 5) +lineStart
  373. end;
  374.  
  375. Procedure HighL(index:integer);
  376.  
  377. Begin
  378.     GotoXY(ScrX(index),ScrY(index));
  379.     LowVideo;
  380.     Write(Directory[DirIndex[Index]].Dname);
  381.     NormVideo
  382. end;
  383.  
  384. Procedure LowL(index:integer);
  385.  
  386. Begin
  387.     GotoXY(ScrX(index),ScrY(index));
  388.     NormVideo;
  389.     Write(Directory[DirIndex[Index]].Dname)
  390. end;
  391.  
  392. Procedure PutOnScreenIndex;
  393.  
  394. begin
  395.    If Index>ScreenStart+PageSize-1 then
  396.     begin
  397.        GotoXY(1,LineStart);
  398.        DelLine;
  399.        ScreenStart:=ScreenStart+5;
  400.        Loop:=ScreenStart+PageSize-5;
  401.        Repeat
  402.           GotoXY(ScrX(Loop),ScrY(loop));
  403.           with Directory[DirIndex[Loop]] do write(DName,'    ');
  404.           Loop:=Loop+1
  405.        until (Loop>IndexEnd) or (loop>ScreenStart+PageSize-1);
  406.        WriteLn;
  407.        InsLine;
  408.     end;
  409.    If Index<ScreenStart then
  410.     begin
  411.        GotoXY(1,LineStart);
  412.        InsLine;
  413.        ScreenStart:=ScreenStart-5;
  414.        For Loop:=ScreenStart to ScreenStart+4 do
  415.         begin
  416.            GotoXY(ScrX(Loop),ScrY(loop));
  417.            with Directory[DirIndex[Loop]] do write(DName,'    ')
  418.         end;
  419.        GotoXY(1,ScrY(ScreenStart+PageSize-1)+1);
  420.        DelLine;
  421.     end;
  422.    If (Index>IndexEnd) or (Index<IndexStart) then
  423.     begin
  424.        Writeln(**** error out of page bounds ****);
  425.        Halt
  426.     end;
  427. end;
  428.  
  429. begin
  430.    GotoXY(1,LineStart);
  431.    Loop:=ScreenStart;
  432.    While (Loop<=IndexEnd) and (loop<=ScreenStart+PageSize-1) do
  433.     begin
  434.         with Directory[DirIndex[Loop]] do write(DName,'    ');
  435.         Loop:=Loop+1
  436.     end;
  437.    WriteLn;
  438.    If IndexEnd<IndexStart then begin
  439.       WriteLn('No files');
  440.       Delay(1000);
  441.       Ch:=#27
  442.    end
  443.    else
  444.    begin
  445.       GotoXY(1,Cmd);
  446.       WriteLn('Commands => RETURN , DEL, ^E, ^X, ^S, ^D, (arrows), P, ESC         ');
  447.       Repeat
  448.         PutOnScreenIndex;
  449.         Oindex:=Index;
  450.         GotoXY(1,Cmd+1);
  451.         Write('UserArea= ',Directory[DirIndex[Index]].DUser);
  452.         HighL(Index);
  453.         Read(Kbd,Ch);
  454.         Case ch of
  455.            'P','p':ScreenDump;
  456.            #5     : If Index-5>=IndexStart then Index:=Index-5;
  457.            #24    : If Index+5<=IndexEnd then Index:=Index+5;
  458.            #19    : If Index-1>=IndexStart then Index:=Index-1;
  459.            #4     : If Index+1<=IndexEnd then Index:=Index+1
  460.         end;
  461.         If OIndex<>Index then LowL(OIndex);
  462.       until Ch in [#13,#127,#27];
  463.    end;
  464.  Response:=Ord(Ch);
  465. end;