home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / utilitys / library.arc / LIBRARY.PAS < prev   
Pascal/Delphi Source File  |  1990-11-30  |  11KB  |  441 lines
  1. {A simple library database}
  2. const
  3.   DATA_FILE = 'LIBRARY.DAT';
  4.   BIGGEST = 500;  {biggest library allowable}
  5.   NO_OF_CATS = 99;{biggest no. of categories listable with <T>opic}
  6. type
  7.   CAT_STRING = string[20];
  8.   line = string[75];
  9.   number = 0..5;
  10.   rec = record
  11.           Title : string[50];
  12.           Author : string[30];
  13.           Cat : CAT_STRING;
  14.           Year : string[4];
  15.           Desc : line;
  16.           Comm : line;
  17.         end;
  18. var
  19.   lib : file of rec;
  20.   i : byte;
  21.   book : rec;
  22.   reply, inkey : char;
  23.   big : integer;
  24.  
  25. function GetKey(teststr : CAT_STRING; option : number) : char;
  26. var TestChar : char;
  27. begin
  28.   repeat read(kbd,testchar) until pos(upcase(testchar),teststr)>0;
  29.   if option=1 then writeln(upcase(testchar));
  30.   GetKey:=upcase(testchar);
  31. end;
  32.  
  33. procedure Topic_List;
  34. var
  35.   categ : array[1..NO_OF_CATS] of CAT_STRING;
  36.   j, k, listcat, catno, code : integer;
  37.   used : boolean;
  38.   in1, in2 : char;
  39.   listcatstr : string[2];
  40. begin
  41.   for i:=1 to NO_OF_CATS do categ[i]:='';
  42.   big:=filesize(lib);
  43.   seek(lib,0);
  44.   catno:=0;
  45.   for k:=1 to big do
  46.     begin
  47.       write('.');
  48.       read(lib,book);
  49.       used:=FALSE;       {used to get an unduplicated list of cat's.}
  50.       j:=1;
  51.       while j<k do
  52.         begin
  53.           if book.cat=categ[j] then used:=TRUE;{already in list, so forget it}
  54.           j:=j+1;
  55.         end;
  56.       if not(used) then     {not in list so far, so}
  57.         begin
  58.           catno:=catno+1;          {move to next pos. on list}
  59.           categ[catno]:=book.cat;  {add cat to list,}
  60.         end;
  61.     end;
  62.   writeln;
  63.  repeat
  64.   writeln;
  65.   for i:=1 to catno do
  66.     begin
  67.       write(i:2,'. ',categ[i]);
  68.       for k:=length(categ[i]) to 21 do write(' ');
  69.       if (i mod 3)=0 then writeln;
  70.     end;
  71.     writeln;
  72.   repeat
  73.     writeln;
  74.     write('Enter category to list (1-',catno,') or [Q]uit : ');
  75.     in1:=GetKey('123456789Q',0);
  76.     if in1='Q' then begin writeln(in1); exit end;
  77.     write(in1);
  78.     in2:=GetKey(^M+'0123456789',0);
  79.     if in2=^M then listcatstr:=in1 else
  80.       begin
  81.         write(in2);
  82.         listcatstr:=in1+in2;
  83.       end;
  84.     Val(listcatstr,listcat,code);
  85.   writeln;
  86.   writeln;
  87.   until (listcat in [1..catno]) and (code=0);
  88.   seek(lib,0);
  89.   j:=0;
  90.   for i:=1 to big do
  91.     begin
  92.       read(lib,book);
  93.       if book.cat=categ[listcat] then
  94.         begin
  95.           j:=j+1;
  96.           writeln(i:2,'. ',book.title);
  97.           if (((j mod 10)=0) and (i<big-2)) then
  98.             begin
  99.               writeln('Press any key to continue');
  100.               repeat until keypressed;
  101.             end;
  102.         end;
  103.     end;
  104.   writeln;
  105.   write('Press any key to quit, or <T>opic list & search : ');
  106.   read(kbd,inkey);
  107.   writeln(inkey);
  108.   until not(inkey in ['T','t']);
  109. end;
  110.  
  111. procedure Add_Entry;
  112. var
  113.   Temp : array[1..5] of line;
  114.   no : byte;
  115. begin
  116.   writeln('Add Entry');
  117.   writeln;
  118.   writeln('Book #',filesize(lib)+1,'.');
  119.   with book do
  120.     begin
  121.       writeln('Enter title : -----------------------------------|');
  122.       buflen:=50;
  123.       readln(Title);
  124.       if (pos('The ',Title)=1) and (length(Title)<50) then
  125.        begin
  126.          Delete(Title,1,4);
  127.          Title:=Title+', The';
  128.        end;
  129.       writeln('Enter author : --------------|');
  130.       buflen:=30;
  131.       readln(Author);
  132.       writeln('Enter category ----|');
  133.       buflen:=20;
  134.       readln(Cat);
  135.       write('Enter year : ');
  136.       buflen:=4;
  137.       readln(Year);
  138.       buflen:=75;
  139.       writeln('Enter description --------------------------------|');
  140.       readln(Desc);
  141.       buflen:=75;
  142.       writeln('Enter comment ---------------------------------------|');
  143.       readln(Comm);
  144.       no:=0;
  145.     end;
  146.   writeln;
  147.   write('Would you like to <S>ave or <A>bort this entry : ');
  148.   inkey:=GetKey('SA',1);
  149.   if inkey='S' then
  150.     begin
  151.       big:=filesize(lib);
  152.       seek(lib,big);
  153.       write(lib,book);
  154.       close(lib);
  155.       reset(lib);
  156.     end;
  157. end;
  158.  
  159. procedure Sort_Books;
  160. var
  161.   ind : array[1..BIGGEST] of integer;
  162.   tit : array[1..BIGGEST] of string[20];
  163.   newlib : file of rec;
  164.   j, k, tempind : integer;
  165.   book1, temp : rec;
  166.   temptit : string[50];
  167. begin
  168.   big:=filesize(lib);
  169.   writeln('Sort books by Title');
  170.   writeln;
  171.   writeln('N.B. This is a disk-based sort.');
  172.   writeln('If there isn''t enough space on the disk, LIBRARY will crash...');
  173.   write('Loading, ');
  174.   seek(lib,0);
  175.   for i:=1 to big do
  176.     begin
  177.       ind[i]:=i;
  178.       read(lib,temp);
  179.       tit[i]:=temp.title;
  180.       for j:=1 to 20 do tit[i][j]:=upcase(tit[i][j]);
  181.     end;
  182.   write('Sorting, ');
  183.   for k:=big-1 downto 1 do
  184.     begin
  185.     for j:=1 to k do
  186.       begin
  187.         if tit[j+1]<tit[j] then
  188.           begin
  189.             temptit:=tit[j];     tempind:=ind[j];
  190.             tit[j]:=tit[j+1]; ind[j]:=ind[j+1];
  191.             tit[j+1]:=temptit;   ind[j+1]:=tempind;
  192.           end
  193.       end; {now ind & titles have been sorted in memory.}
  194.     end;
  195.   assign(newlib,'LIBRARY.$$$');
  196.   write('Writing, ');
  197.   rewrite(newlib);
  198.   for i:=1 to big do
  199.     begin
  200.       seek(lib,ind[i]-1);
  201.       read(lib,book1);
  202.       if pos('~~~~~~~',book1.title)=0 then write(newlib,book1);
  203.     end;
  204.   write('Closing, ');
  205.   close(newlib);
  206.   close(lib);
  207.   erase(lib);
  208.   rename(newlib,DATA_FILE);
  209.   assign(lib,DATA_FILE);
  210.   writeln('Finished.');
  211.   reset(lib);
  212. end;
  213.  
  214. procedure Quit;
  215. begin
  216.   writeln('Quit...');
  217.   close(lib);
  218.   halt;
  219. end;
  220.  
  221. procedure Display_Entry;
  222. var
  223.   code, no : integer;
  224.   nostr : string[3];
  225. begin
  226.   big:=filesize(lib);
  227.   repeat
  228.     write('Enter no. of book to display (1-',big,') : ');
  229.     buflen:=3;
  230.     readln(nostr);
  231.     Val(nostr,no,code);
  232.     if (code<>0) or (nostr='') then no:=0;
  233.   until no in [1..big];
  234.   seek(lib,no-1);
  235.   read(lib,book);
  236.   writeln;
  237.   with book do
  238.     begin
  239.       write('Title  : ');
  240.       writeln(Title);
  241.       write('Author : ');
  242.       writeln(Author);
  243.       write('Category : ');
  244.       writeln(Cat);
  245.       write('Year  : ');
  246.       writeln(Year);
  247.       writeln('Description');
  248.       writeln(Desc);
  249.       writeln('Comments');
  250.       writeln(Comm);
  251.     end;
  252. end;
  253.  
  254. procedure Display_Titles;
  255. var
  256.   Print_Authors : boolean;
  257.   startstr : string[3];
  258.   code, start : integer;
  259. begin
  260.   write('Display authors too (Y/N) : ');
  261.   inkey:=GetKey('YN',1);
  262.   Print_Authors:=(inkey='Y');
  263.   big:=filesize(lib);
  264.   writeln;
  265.   repeat
  266.     write('Start display at book no [1] : ');
  267.     buflen:=3;
  268.     readln(startstr);
  269.     Val(startstr,start,code);
  270.     if (code<>0) or (startstr='') then start:=1;
  271.   until start in [1..big];
  272.   seek(lib,start-1);
  273.   for i:=start to big do
  274.     begin
  275.       read(lib,book);
  276.       write(i:2,': ');
  277.       write(book.title);
  278.       if Print_Authors then
  279.         if (length(book.author)+length(book.title)>71) then
  280.           write(#10,#13,'                  / ',book.author)
  281.           else write(' / ',book.author);
  282.       writeln;
  283.       if ((i+1-start) mod 10)=0 then
  284.         begin
  285.           writeln('Press any key to continue, or [Q]uit.');
  286.           read(kbd,inkey);
  287.           if upcase(inkey)='Q' then exit;
  288.         end;
  289.     end;
  290.   if (i mod 10)>2 then
  291.     begin
  292.       writeln('Press any key to continue');
  293.       repeat until keypressed;
  294.     end;
  295. end;
  296.  
  297. procedure Edit_Entry;
  298. var
  299.   code, no, ln : integer;
  300.   nostr, lnstr : string[3];
  301.   temp : string[50];
  302. begin
  303.   big:=filesize(lib);
  304.   repeat
  305.     write('Enter no. of book to edit (1-',big,') : ');
  306.     buflen:=3;
  307.     readln(nostr);
  308.     Val(nostr,no,code);
  309.     if (code<>0) or (nostr='') then no:=0;
  310.   until no in [1..big];
  311.   seek(lib,no-1);
  312.   read(lib,book);
  313.   writeln;
  314.   with book do
  315.     begin
  316.       writeln('1: ',Title);
  317.       writeln('2: ',Author);
  318.       writeln('3: ',Cat);
  319.       writeln('4: ',Year);
  320.       writeln('5: ',Desc);
  321.       writeln('6: ',Comm);
  322.       writeln;
  323.   repeat
  324.     write('Enter line to edit (1-6 or any other key to quit) : ');
  325.     buflen:=1;
  326.     readln(lnstr);
  327.     Val(lnstr,ln,code);
  328.     if (code<>0) or (lnstr='') then exit;
  329.   until ln in [1..6];
  330.   writeln('Enter new field : ');
  331.   case ln of
  332.   1 : buflen:=50;
  333.   2 : buflen:=30;
  334.   3 : buflen:=10;
  335.   4 : buflen:=4;
  336.   5,6 : buflen:=75;
  337.   end;
  338.   readln(temp);
  339.   case ln of
  340.   1 : title:=temp;
  341.   2 : author:=temp;
  342.   3 : cat:=temp;
  343.   4 : year:=temp;
  344.   5 : desc:=temp;
  345.   6 : comm:=temp;
  346.   end;
  347.   write('Would you like to <S>ave or <A>bort this edit : ');
  348.   inkey:=GetKey('SA',1);
  349.   if inkey='S' then
  350.    begin
  351.      seek(lib,no-1);
  352.      write(lib,book);
  353.      close(lib);
  354.      reset(lib);
  355.    end;
  356.   end;
  357. end;
  358.  
  359. procedure Gobble;
  360. var
  361.   in1, in2 : char;
  362.   gobno, code : integer;
  363.   gobnostr : string[2];
  364. begin
  365.   big:=filesize(lib);
  366.   repeat
  367.     repeat
  368.       writeln;
  369.       writeln('Get rid of a book.');
  370.       writeln;
  371.       writeln('This involves a disk-based sort, so if there isn''t enough');
  372.       writeln('room on the disk, LIBRARY will crash.');
  373.       writeln;
  374.       write('Enter book to get rid of (1-',big,') or [Q]uit : ');
  375.       in1:=GetKey('123456789Q',0);
  376.       if in1='Q' then begin writeln(in1); exit; end;
  377.       write(in1);
  378.       in2:=GetKey(^M+'1234567890',0);
  379.       if in2=^M then gobnostr:=in1 else
  380.         begin
  381.           write(in2);
  382.           gobnostr:=in1+in2;
  383.         end;
  384.       Val(gobnostr,gobno,code);
  385.       writeln;
  386.       writeln;
  387.     until (gobno in [1..big]) and (code=0);
  388.     seek(lib,gobno-1);
  389.     read(lib,book);
  390.     writeln(gobno,': ',book.title);
  391.     writeln;
  392.     write('Are you sure that you want to erase the above book (Y/N) : ');
  393.     reply:=GetKey('YN',0);
  394.     if reply='N' then begin writeln; exit end;
  395.     book.title:='~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~';
  396.     seek(lib,gobno-1);
  397.     write(lib,book);
  398.     writeln;
  399.     write('Press any key to quit and save changes, or <G>et rid of another book : ');
  400.     read(kbd,inkey);
  401.     writeln(inkey)
  402.   until not(inkey in ['G','g']);
  403.   Sort_Books;
  404. end;
  405.  
  406. procedure Menu;
  407. begin
  408.   writeln;
  409.   big:=filesize(lib);
  410.   write('--- LIBRARY v1.0 ---------------------------------- ');
  411.   writeln(big:3,' books in the library ---');
  412.   writeln('   <A>dd a book to library');
  413.   writeln('   <B>ooks in the library');
  414.   writeln('   <D>isplay a book''s details');
  415.   writeln('   <E>dit a book''s details');
  416.   writeln('   <G>et rid of a book');
  417.   writeln('   <S>ort by title');
  418.   writeln('   <T>opic list & search');
  419.   writeln('   [Q]uit the library.');
  420.   writeln;
  421.   write('Please enter your choice : ');
  422.   inkey:=GetKey('ABDEGSQT',1);
  423.   writeln;
  424.   case inkey of
  425.     'A' : Add_Entry;
  426.     'B' : Display_Titles;
  427.     'D' : Display_Entry;
  428.     'E' : Edit_Entry;
  429.     'G' : Gobble;
  430.     'Q' : Quit;
  431.     'S' : Sort_Books;
  432.     'T' : Topic_List;
  433.   end;
  434. end;
  435.  
  436. begin
  437.   assign(lib,DATA_FILE);
  438.   reset(lib);
  439.   repeat Menu until false;
  440. end.
  441.