home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PSPPD100.ZIP / TESTPPD.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-09-16  |  3.5 KB  |  146 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║      Test        ║
  5.                                                       ║    PPDatabase    ║
  6.                                                       ║    Rev. 1.00     ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. {$F-} {$O-} {$A+} {$G-}
  12. {$V-} {$B-} {$X-} {$N+} {$E+}
  13.  
  14. {$I FINAL.PAS}
  15.  
  16. {$IFDEF FINAL}
  17.   {$I-} {$R-}
  18.   {$D-} {$L-} {$S-}
  19. {$ENDIF}
  20.  
  21. {$M 8192,100000,655360}
  22.  
  23. Uses DBASE,CRT;
  24.  
  25. Procedure Error(ErrNum:Word);
  26. Begin
  27.   If ErrNum=0 Then Exit;        {No Error}
  28.   WriteLn('Database Error Report: ',DatabaseErrorMsg(ErrNum),'.');
  29.   Halt;
  30. End;
  31.  
  32. Const
  33.   DBName = 'TEST.PPD';
  34.  
  35. Function Menu:Byte;
  36.  
  37. Var
  38.   C:Char;
  39.  
  40. Begin
  41.   WriteLn;
  42.   WriteLn('1.  View Database');
  43.   WriteLn('2.  View Sub Database');
  44.   WriteLn('3.  Join A Database');
  45.   WriteLn('4.  Add Data');
  46.   WriteLn('5.  Delete Data');
  47.   WriteLn('6.  View Data');
  48.   WriteLn;
  49.   WriteLn('Press 1 to 6, [Esc] Quits.');
  50.   WriteLn;
  51.   Repeat
  52.     C:=ReadKey;
  53.   Until C in ['1'..'6',#27];
  54.   If C=#27 Then
  55.   Begin
  56.     WriteLn('You can now delete or rename the file ',DBName,'.');
  57.     Menu:=0;
  58.   End
  59.   Else
  60.     Menu:=Ord(C)-Ord('0');
  61. End;
  62.  
  63. Var
  64.   DB:DBaseFile;
  65.  
  66. Procedure DDB;  {Display Database Directory For User}
  67. Begin
  68.   WriteLn;
  69.   WriteLn('Name':12,'   ','Number':6,'   ','Offset':8,'    ','Size':6,'   ','Attr');
  70.   WriteLn;
  71.   DB.Dir.Data:=DB.Dir.Root;
  72.   While DB.Dir.Data<> NIL do
  73.   Begin
  74.     With DB.Dir.Data^ do
  75.       WriteLn(Name:12,'   ',Number:6,'   ',Offset:8,'    ',Size:6,'   ',Attr);
  76.     DB.Dir.Data:=DB.Dir.Data^.Next;
  77.   End;
  78. End;
  79.  
  80. Var
  81.   IncludeBase :String[79];
  82.   St          :String[10];
  83.   C           :Char;
  84.   Num,
  85.   Er          :Word;
  86.   QuitNow     :Boolean;
  87.  
  88. Begin
  89.   ClrScr;
  90.   WriteLn('Creating Database ',DBName,'...');
  91.   DB.Init;
  92.   Er:=DB.CreateDatabase(DBName,False);          {Create a Database}
  93.   Er:=DB.OpenDatabase(DBName,0,MaxLongInt);     {Open It}
  94.   Error(Er);
  95.  
  96.   QuitNow:=False;
  97.   Repeat
  98.     Case Menu Of
  99.       0:QuitNow:=True;
  100.       1:DDB;
  101.       2:Begin
  102.           Write('Select a number: ');
  103.           ReadLn(Num);
  104.           Er:=DB.CrossIntoDatabase('',Num);         {Access Sub-Database}
  105.           Error(Er);
  106.           DDB;
  107.           Er:=DB.CrossOutOfDatabase;                {Return to Calling Database}
  108.           Error(Er);
  109.         End;
  110.       3:Begin
  111.           Write('Select a new number: ');
  112.           ReadLn(Num);
  113.           Write('Select a database: ');
  114.           ReadLn(IncludeBase);
  115.           Er:=DB.NewDataFile('',Num,IncludeBase);       {Include Data From File}
  116.           Er:=DB.SetDirFlag('',Num,True);               {Set Attr to Directory}
  117.           Error(Er);
  118.         End;
  119.       4:Begin
  120.           Write('Enter a new number: ');
  121.           ReadLn(Num);
  122.           Write('Enter a Line of Data: ');
  123.           ReadLn(IncludeBase);
  124.           Er:=DB.NewData('',Num,Addr(IncludeBase),SizeOf(IncludeBase));  {Add Line of Data}
  125.           Error(Er);
  126.         End;
  127.       5:Begin
  128.           Write('Enter a number: ');
  129.           ReadLn(Num);
  130.           Er:=DB.DelData('',Num);
  131.           Error(Er);
  132.         End;
  133.       6:Begin
  134.           Write('Enter a number: ');
  135.           ReadLn(Num);
  136.           Er:=DB.GetData('',Num,Addr(IncludeBase));     {Get Line of Data}
  137.           Error(Er);
  138.           WriteLn('Collected: ',IncludeBase);
  139.         End;
  140.     End;
  141.   Until QuitNow;
  142.  
  143.   Er:=DB.CloseDatabase; {Don't forget to Close it}
  144.   Error(Er);
  145. End.
  146.