home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR36 / BTV200.ZIP / EXTEND.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-18  |  8KB  |  322 lines
  1. {$X+,V-}
  2. uses
  3.   {$IFDEF WINDOWS}
  4.   WinCrt,
  5.   {$ELSE}
  6.   Crt,
  7.   {$ENDIF}
  8.   {$IFDEF VER70}
  9.   WinDos,
  10.   {$ELSE}
  11.   Dos,
  12.   {$ENDIF}
  13.   Btv, BtvType, BtvConst, BtvX;
  14.  
  15. type
  16.   ErrorType = Object(BTV.ErrorDisplay)
  17.     Function    Display(Error     : Integer;
  18.                         ErrorMsg  : String;
  19.                         OpCode    : Integer;
  20.                         OpCodeMsg : String;
  21.                         FileName  : PathStr
  22.                         ): ErrorAction;             Virtual;
  23.   end;
  24.  
  25.   RecBuf = record
  26.     LastName  : String[15];   {0}
  27.     FirstName : String[15];   {16}
  28.     Date      : BDateRec;     {32}
  29.   end;
  30.  
  31.   ReadBuffType = record
  32.     Len       : Word;
  33.     Pos       : LongInt;
  34.     LastName  : String[15];
  35.     FirstName : String[15];
  36.     Date      : BDateRec;
  37.   end;
  38.  
  39.   WriteBuffType = record
  40.     Len       : Word;
  41.     LastName  : String[15];
  42.     FirstName : String[15];
  43.     Date      : BDateRec;
  44.   end;
  45.  
  46.  
  47. Function ErrorType.Display(Error     : Integer;
  48.                            ErrorMsg  : String;
  49.                            OpCode    : Integer;
  50.                            OpCodeMsg : String;
  51.                            FileName  : PathStr
  52.                            ): ErrorAction;
  53.   begin
  54.     ClrScr;
  55.     Writeln('Btrieve IO error for ' + FileName);
  56.     Writeln(Error,  ' - ', ErrorMsg);
  57.     Writeln(Opcode, ' - ', OpCodeMsg);
  58.     Writeln('Press any key ....');
  59.     ReadKey;
  60.     Display := erDone;  { just let the program continue }
  61.     ClrScr;
  62.   end;
  63.  
  64.  
  65. Procedure Trim(var S : String);
  66.  
  67.   var
  68.     i : Byte;
  69.  
  70.   begin
  71.     while (Byte(S[0]) > 0) and (S[Byte(S[0])] = ' ') do
  72.       Dec(Byte(S[0]));
  73.  
  74.     i := 1;
  75.  
  76.     while (i <= Byte(S[0])) and (S[i] = ' ') do
  77.       Inc(i);
  78.  
  79.     if (i > 1) then
  80.     begin
  81.       Byte(S[0]) := Byte(S[0]) - i + 1;
  82.       Move(S[i], S[1], Byte(S[0]));
  83.     end;
  84.   end;
  85.  
  86.  
  87. var
  88.   F         : Text;
  89.   ErrHandler: ErrorHandler;
  90.   ErrDisplay: ErrorType;
  91.   B         : XBtrieveFile;
  92.  
  93.   Buff      : ReadBuffType;
  94.   ReadBuff  : record
  95.     Count : Word;
  96.     Data  : Array[1..10] of ReadBuffType;
  97.   end;
  98.  
  99.   WriteBuff : record
  100.     Count : Word;
  101.     Data  : Array[1..60] of WriteBuffType;
  102.   end;
  103.  
  104.   S         : String;
  105.   dTemp     : BDateRec;
  106.   Offset    : Word;
  107.  
  108.   i         : Byte;
  109.   x         : Word;
  110.   Err       : Integer;
  111.   Name      : String[30];
  112.  
  113. begin
  114.   ErrDisplay.Init;
  115.   ErrHandler.Init(@ErrDisplay);
  116.  
  117.   { set up the demo file }
  118.   B.Init('EXTEND.DAT', @ErrHandler, nil, SizeOf(RecBuf));
  119.   B.AddKeySegment( 1, 16, bExtended + bDuplicates, bLString, 0, 0);
  120.   B.AddKeySegment(17, 16, bExtended + bDuplicates, bLString, 0, 0);
  121.   B.AddKeySegment(33,  4, bExtended + bDuplicates, bDate, 0, 0);
  122.   B.Create(bNormal, SizeOf(RecBuf), 1024, 0, bNormal);
  123.   B.Open(bNormal, '');
  124.  
  125.  
  126.   (* INSERT MULTIPLE RECORDS USING INSERT EXTENDED *)
  127.   Assign(F, 'XDEMO.TXT');
  128.   Reset(F);
  129.   x := 0;
  130.   FillChar(WriteBuff, SizeOf(WriteBuff), 0);
  131.  
  132.   While (not EOF(F)) do
  133.   begin
  134.     Inc(x);
  135.     Readln(F, S);
  136.     i := 1;
  137.     Name := '';
  138.  
  139.     While (S[i] <> ',') do
  140.     begin
  141.       Name[i] := S[i];
  142.       Inc(i);
  143.     end;
  144.  
  145.     Name[0] := Char(i-1);
  146.     Trim(Name);
  147.     Writeln(Name);
  148.  
  149.     WriteBuff.Data[x].Len := SizeOf(WriteBuff.Data[1]) - 2;
  150.     WriteBuff.Data[x].FirstName := Copy(Name, 1, Pos(' ', Name) - 1);
  151.     WriteBuff.Data[x].LastName  := Copy(Name, Pos(' ', Name) + 1, Length(Name));
  152.     Inc(i, 2);
  153.     Val(Copy(S, i, 4),   WriteBuff.Data[x].Date.Year, Err);
  154.     Val(Copy(S, i+4, 2), WriteBuff.Data[x].Date.Month, Err);
  155.     Val(Copy(S, i+6, 2), WriteBuff.Data[x].Date.Day, Err);
  156.   end;
  157.  
  158.   Close(F);
  159.  
  160.   writeln('USING EXTENDED INSERT TO ADD ', x, ' RECORDS ... PLEASE WAIT');
  161.  
  162.   WriteBuff.Count := x;
  163.   B.XInit(@WriteBuff, SizeOf(WriteBuff));
  164.   x := B.XInsert;
  165.  
  166.   writeln(x, ' RECORDS WERE ADDED!');
  167.   writeln;
  168.   writeln('Press any key ....');
  169.   writeln;
  170.   ReadKey;
  171.  
  172.  
  173.   (* READ A SINGLE RECORD *)
  174.   B.XInit(@ReadBuff, SizeOf(ReadBuff));
  175.   { number of records to reject }
  176.   B.SetRejectCount(100);
  177.   { number of records to read }
  178.   B.SetExtractCount(1);
  179.   { field size and offset (this reads the whole record) }
  180.   B.AddFieldToExtract(SizeOf(Buff), 0);
  181.   { add a single filtering condition }
  182.   S := 'C';
  183.   B.AddFilterCondition(bLstring,
  184.                        16, 0,
  185.                        bXGetGreat OR bXNoCaseCompare,
  186.                        bXDone,
  187.                        S);
  188.  
  189.   { need to read a record first, to establish positioning }
  190.   B.Get(bGetFirst, bNoLock);
  191.   B.XGet(bXGetNext);
  192.  
  193.   { get all the fields returned by Btrieve for the record }
  194.   if B.ExtractNextRec(Buff, False) then
  195.     writeln(Buff.FirstName, ' ', Buff.LastName, '  ',
  196.             Buff.Date.Month, '/', Buff.Date.Day, '/', Buff.Date.Year);
  197.  
  198.   writeln;
  199.  
  200.  
  201.   (* READ MULTIPLE RECORDS *)
  202.   B.SetExtractCount(4);
  203.   B.Get(bGetFirst, bNoLock);
  204.   B.XGet(bXGetNext);
  205.  
  206.   While B.ExtractNextRec(Buff, False) do
  207.     writeln(Buff.FirstName, ' ', Buff.LastName, '  ',
  208.             Buff.Date.Month, '/', Buff.Date.Day, '/', Buff.Date.Year);
  209.  
  210.   writeln;
  211.   writeln('Press any key ....');
  212.   writeln;
  213.   ReadKey;
  214.  
  215.  
  216.   (* READ MULTIPLE RECORDS USING FIELD COMPARE *)
  217.   B.XReset;
  218.   B.SetRejectCount(100);
  219.   B.SetExtractCount(10);
  220.   B.AddFieldToExtract(SizeOf(Buff), 0);
  221.   { compare last name to first name }
  222.   Offset := 16;
  223.   B.AddFilterCondition(bLstring,
  224.                        16, 0,
  225.                        bXGetEqual OR bXFieldCompare,
  226.                        bXDone,
  227.                        Offset);
  228.  
  229.   B.Get(bGetFirst, bNoLock);
  230.   B.XGet(bXGetNext);
  231.  
  232.   While B.ExtractNextRec(Buff, False) do
  233.     writeln(Buff.FirstName, ' ', Buff.LastName, '  ',
  234.             Buff.Date.Month, '/', Buff.Date.Day, '/', Buff.Date.Year);
  235.  
  236.   writeln;
  237.   writeln('Press any key ....');
  238.   writeln;
  239.   ReadKey;
  240.  
  241.  
  242.   (* READ MULTIPLE RECORDS EXTRACTING ONE FIELD ONLY *)
  243.   B.XReset;
  244.   B.SetRejectCount(100);
  245.   B.SetExtractCount(15);
  246.   { extract the date field only }
  247.   B.AddFieldToExtract(SizeOf(BDateRec), 32);
  248.  
  249.   dTemp.Day   := 13;
  250.   dTemp.Month := 5;
  251.   dTemp.Year  := 1952;
  252.   B.AddFilterCondition(bDate,
  253.                        SizeOf(BDateRec), 32,
  254.                        bXGetGreatEqual,
  255.                        bXLogicAND,
  256.                        dTemp);
  257.  
  258.   dTemp.Day   := 1;
  259.   dTemp.Month := 1;
  260.   dTemp.Year  := 1960;
  261.   B.AddFilterCondition(bDate,
  262.                        SizeOf(BDateRec), 32,
  263.                        bXGetLessEqual,
  264.                        bXLogicOR,
  265.                        dTemp);
  266.  
  267.   dTemp.Day   := 1;
  268.   dTemp.Month := 1;
  269.   dTemp.Year  := 1980;
  270.   B.AddFilterCondition(bDate,
  271.                        SizeOf(BDateRec), 32,
  272.                        bXGetGreat,
  273.                        bXDone,
  274.                        dTemp);
  275.  
  276.   B.Get(bGetLast, bNoLock);
  277.   B.XGet(bXGetPrev);
  278.  
  279.   { get the data fields only }
  280.   While B.ExtractNextRec(dTemp, True) do
  281.     writeln(dTemp.Month, '/', dTemp.Day, '/', dTemp.Year);
  282.  
  283.   writeln;
  284.  
  285.  
  286.   { Change the key path (to filter path) and records are returned in a
  287.    different order. This also returns one less record. The last record in
  288.    the path meets the criteria, but is skipped over now.
  289.   }
  290.   B.SetKeyPath(2);
  291.   B.Get(bGetLast, bNoLock);
  292.   B.XGet(bXGetPrev);
  293.  
  294.   While B.ExtractNextRec(dTemp, True) do
  295.     writeln(dTemp.Month, '/', dTemp.Day, '/', dTemp.Year);
  296.  
  297.   writeln;
  298.   writeln('Press any key ....');
  299.   writeln;
  300.   ReadKey;
  301.  
  302.  
  303.   (* READ MULTIPLE RECORDS USE STEP NEXT EXTENDED *)
  304.   { This returns one less record. The physical first record inserted into
  305.     the file meets the criteria, but is skipped over.
  306.   }
  307.   B.Get(bStepFirst, bNoLock);
  308.   B.XGet(bXStepNext);
  309.  
  310.   While B.ExtractNextRec(dTemp, True) do
  311.     writeln(dTemp.Month, '/', dTemp.Day, '/', dTemp.Year);
  312.  
  313.   writeln;
  314.  
  315.   { cleanup and free memory }
  316.   B.XDone;
  317.  
  318.  
  319.   B.Close;
  320. end.
  321.  
  322.