home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / TURBODBT.ZIP / ADDKEY.BOX < prev    next >
Text File  |  1996-07-15  |  4KB  |  161 lines
  1.  
  2.  
  3. (*******************************************************)
  4. (*                                                     *)
  5. (*         TURBO-ACCESS Version 1.2 (CP/M-80)          *)
  6. (*                                                     *)
  7. (*                   ADDKEY module                     *)
  8. (*                                                     *)
  9. (*         Use with TURBO PASCAL 2.0 or later          *)
  10. (*                                                     *)
  11. (*              Copyright (C) 1984,85 by               *)
  12. (*               Borland International                 *)
  13. (*                                                     *)
  14. (*******************************************************)
  15.  
  16.  
  17. (*$A+,R-*)
  18.  
  19. procedure AddKey(var IdxF       : IndexFile;
  20.                  var ProcDatRef : Integer;
  21.                  var ProcKey                );
  22. var
  23.   PKey      : TaKeyStr absolute ProcKey;
  24.   PrPgRef1,
  25.   PrPgRef2,
  26.   C,I,K,L   : Integer;
  27.   PassUp    : Boolean;
  28.   PagePtr1,
  29.   PagePtr2  : TaPagePtr;
  30.   ProcItem1,
  31.   ProcItem2 : TaItem;
  32.  
  33. (*$A-*)
  34.  
  35. procedure Search(PrPgRef1 : Integer);
  36. var
  37.   R : Integer;
  38.  
  39. (*$A+*)
  40.  
  41. procedure Insert;
  42. begin
  43.   TaGetPage(IdxF,PrPgRef1,PagePtr1);
  44.   with PagePtr1^ do
  45.   begin
  46.     if ItemsOnPage < PageSize then
  47.     begin
  48.       ItemsOnPage := ItemsOnPage + 1;
  49.       for I := ItemsOnPage downto R + 2 do 
  50.         ItemArray[I] := ItemArray[I - 1];
  51.       ItemArray[R + 1] := ProcItem1; 
  52.       PassUp := false;
  53.     end
  54.     else
  55.     begin
  56.       TaNewPage(IdxF,PrPgRef2,PagePtr2);
  57.       if R <= Order then
  58.       begin
  59.         if R = Order then 
  60.           ProcItem2 := ProcItem1
  61.         else
  62.         begin
  63.           ProcItem2 := ItemArray[Order];
  64.           for I := Order downto R + 2 do 
  65.             ItemArray[I] := ItemArray[I - 1];
  66.           ItemArray[R + 1] := ProcItem1;
  67.         end;
  68.         for I := 1 to Order do 
  69.           PagePtr2^.ItemArray[I] := ItemArray[I + Order];
  70.       end
  71.       else
  72.       begin
  73.         R := R - Order; 
  74.         ProcItem2 := ItemArray[Order + 1];
  75.         for I := 1 to R - 1 do 
  76.           PagePtr2^.ItemArray[I] := ItemArray[I + Order + 1];
  77.         PagePtr2^.ItemArray[R] := ProcItem1;
  78.         for I := R + 1 to Order do 
  79.           PagePtr2^.ItemArray[I] := ItemArray[I + Order];
  80.       end;
  81.       ItemsOnPage := Order;
  82.       PagePtr2^.ItemsOnPage := Order; 
  83.       PagePtr2^.BckwPageRef := ProcItem2.PageRef; 
  84.       ProcItem2.PageRef := PrPgRef2;
  85.       ProcItem1 := ProcItem2; 
  86.       TaUpdatePage(PagePtr2);
  87.     end;
  88.   end;
  89.   TaUpdatePage(PagePtr1);
  90. end;
  91.  
  92. begin
  93.   if PrPgRef1 = 0 then
  94.   begin
  95.     PassUp := true;
  96.     with ProcItem1 do
  97.     begin
  98.       Key := PKey; 
  99.       DataRef := ProcDatRef; 
  100.       PageRef := 0;
  101.     end;
  102.   end
  103.   else
  104.   begin
  105.     TaGetPage(IdxF,PrPgRef1,PagePtr1);
  106.     with PagePtr1^ do
  107.     begin
  108.       L := 1; 
  109.       R := ItemsOnPage;
  110.       repeat
  111.         K := (L + R) div 2;
  112.         C := TaCompKeys(PKey,
  113.                         ItemArray[K].Key,
  114.                         ProcDatRef,
  115.                         ItemArray[K].DataRef,
  116.                         IdxF.AllowDuplKeys   );
  117.         if C <= 0 then 
  118.           R := K - 1;
  119.         if C >= 0 then 
  120.           L := K + 1;
  121.       until R < L;
  122.       if L - R > 1 then
  123.       begin
  124.         OK := false; 
  125.         PassUp := false;
  126.       end
  127.       else
  128.       begin
  129.     if R = 0 then 
  130.           Search(BckwPageRef)
  131.         else Search(ItemArray[R].PageRef);
  132.     if PassUp then 
  133.           Insert;
  134.       end;
  135.     end;
  136.   end;
  137. end;
  138.  
  139. begin
  140.   with IdxF do
  141.   begin
  142.     TaXKey(PKey,KeyL); 
  143.     OK := true; 
  144.     Search(RR);
  145.     if PassUp then
  146.     begin
  147.       PrPgRef1 := RR; 
  148.       TaNewPage(IdxF,RR,PagePtr1);
  149.       with PagePtr1^ do
  150.       begin
  151.         ItemsOnPage := 1; 
  152.         BckwPageRef := PrPgRef1; 
  153.         ItemArray[1] := ProcItem1;
  154.       end;
  155.       TaUpdatePage(PagePtr1);
  156.     end;
  157.     pp := 0;
  158.   end;
  159. end;
  160.  
  161.