home *** CD-ROM | disk | FTP | other *** search
/ C Programming Starter Kit 2.0 / SamsPublishing-CProgrammingStarterKit-v2.0-Win31.iso / bde / sdkfilt.pak / FILTER.PAS next >
Encoding:
Pascal/Delphi Source File  |  1997-07-24  |  8.0 KB  |  216 lines
  1. {$A+,B-,D+,F-,G+,I+,K+,L+,N+,P+,Q+,R+,S+,T-,V+,W-,X+,Y+}
  2. {$M 25600,4096}
  3.  
  4. { Description:
  5.     This unit holds all the filter code.  It can be changed
  6.     to work with any table.  Expression types can also be changed.
  7. }
  8. unit Filter;
  9.  
  10. interface
  11.  
  12. uses WinProcs, WinTypes, DbiErrs, DbiTypes, DbiProcs, SysUtils, DB;
  13.  
  14. const
  15.   szField1: PChar = 'Species No';   { Name of the field for the third
  16.                                       node of the tree }
  17.  
  18. type
  19.   tValues = array[1..2] of Double;  { structure to pass filter values }
  20.  
  21.   { Exceptions for dbi calls }
  22.   EFilterError = class(EDatabaseError);
  23.   EFilterInvalidHndl = class(EFilterError);
  24.   EFilterLocked = class(EFilterError);
  25.   EFilterTblLockLimit = class(EFilterError);
  26.   EFilterNoSuchFilter = class(EFilterError);
  27.   EFilterNA = class(EFilterError);
  28.  
  29. var
  30.   hFilter: hDBIFilter;       { Filter handle }
  31.  
  32. function AddFilter(Values: tValues; hTable: hDBICur): DBIResult;
  33. function RemoveFilter(hTbl: hDbiCur; hFltr: hDBIFilter): DBIResult;
  34.  
  35. implementation
  36.  
  37. { METHOD:  Chk
  38.   PURPOSE: dbi error handling routine.
  39. }
  40. function Chk(rslt: DbiResult): DbiResult;
  41. var
  42.   FErr: Array [0..dbiMaxMsgLen] of Char;
  43.   FErrStr: String[dbiMaxMsgLen];
  44.   FErrInfo: dbiErrInfo;
  45.  
  46. begin
  47.   if rslt <> dbiErr_None then
  48.   begin
  49.     { Look on the eror stack to see if there is any detailed information
  50.       about the error that has just occurred }
  51.     DbiGetErrorInfo(False, FErrInfo);
  52.     { If so construct an error string }
  53.     if FErrInfo.iError = rslt then
  54.     begin
  55.       FErrStr := Format('%s  ', [FErrInfo.szErrCode]);
  56.       { Add the string only if the string on the stack is not blank }
  57.       if StrComp(FErrInfo.szContext[1], '') = 0 then
  58.         FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[1]]);
  59.       if StrComp(FErrInfo.szContext[2], '') = 0 then
  60.         FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[2]]);
  61.       if StrComp(FErrInfo.szContext[3], '') = 0 then
  62.         FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[3]]);
  63.       if StrComp(FErrInfo.szContext[4], '') = 0 then
  64.         FErrStr := Format('%s  %s', [FErrStr, FErrInfo.szContext[4]]);
  65.     end
  66.     else
  67.     begin
  68.       { Get the generic error message if there is no error information
  69.         on the stack }
  70.       DbiGetErrorString(rslt, FErr);
  71.       FErrStr := StrPas(FErr);
  72.     end;
  73.     FErrStr := Format('Filter Error: %d.  %s', [rslt, FErrStr]);
  74.     MessageBeep(mb_IconHand);
  75.     { Raise the appropriate exception }
  76.     case rslt of
  77.       dbiErr_InvalidHndl:
  78.         raise EFilterInvalidHndl.Create(FErrStr);
  79.       dbiErr_Locked:
  80.         raise EFilterLocked.Create(FErrStr);
  81.       dbiErr_TblLockLimit:
  82.         raise EFilterTblLockLimit.Create(FErrStr);
  83.       dbiErr_NoSuchFilter:
  84.         raise EFilterNoSuchFilter.Create(FErrStr);
  85.       dbiErr_NA:
  86.         raise EFilterNA.Create(FErrStr);
  87.     else
  88.       { If an unknown error occured, rais a generic exception }
  89.       raise EFilterError.Create(FErrStr);
  90.     end;
  91.   end;
  92. end;
  93.  
  94. { METHOD:  AddFilter
  95.   PURPOSE: Create and activate the filter on the Biolife.DB table.
  96. }
  97. function AddFilter(Values: tValues; hTable: hDBICur): DBIResult;
  98. var
  99.   pcanExp: pBYTE;             { Structure containing filter info }
  100.   uSizeNodes: Word;           { Size of the nodes in the tree }
  101.   uSizeCanExpr: Word;         { Size of the header information }
  102.   uSizeLiterals: Word;        { Size of the literals }
  103.   uTotalSize: Word;           { Total size of the filter expression }
  104.   canExp: CANExpr;            { Contains the header information }
  105.   Nodes: array[0..29] of word;{ Filter expression }
  106.  
  107. begin
  108.   { Create the filter expression }
  109.   { Offset 0 }
  110.   Nodes[0] := Word(nodeBINARY);  { nodeBINARY = 2 }
  111.   Nodes[1] := Word(canAND);      { canGT = 5}
  112.   Nodes[2] := 8;                 { offset = 8 }
  113.   Nodes[3] := 34;                { canBinary.iOperand2
  114.                                    Offsets in the Nodes array }
  115.   { Offset 8 }
  116.   Nodes[4] := Word(nodeBINARY);  { nodeBINARY = 2}
  117.   Nodes[5] := Word(canGE);       { canGT = 5}
  118.   Nodes[6] := 16;                { offset = 8}
  119.   Nodes[7] := 24;                { canBinary.iOperand2
  120.                                    Offsets in the Nodes array }
  121.   { Offset 16 }
  122.   Nodes[8] := Word(nodeFIELD);   { canFIELD = 4}
  123.   Nodes[9] := Word(canFIELD2);   { canFIELD2 = 13 }
  124.   Nodes[10]:= 1;                 { canField.iFieldNum }
  125.   Nodes[11]:= 0;                 { canField.iNameOffset: szField1 is the
  126.                                    literal at offset 0 }
  127.   { Offset 24 }
  128.   Nodes[12]:= Word(nodeCONST);   { nodeCONST = 5 }
  129.   Nodes[13]:= Word(canCONST2);   { canCONST2 = 14 }
  130.   Nodes[14]:= fldFLOAT;          { canConst.iType }
  131.   Nodes[15]:= 8;                 { canConst.iSize }
  132.   Nodes[16]:= length(StrPas(szField1)) + 1;
  133.                                  { canConst.iOffset: lConst is the
  134.                                    literal at offset strlen(szField1) + 1 }
  135.   { Offset 34 }
  136.   Nodes[17]:= Word(nodeBINARY);
  137.   Nodes[18]:= Word(canLE);
  138.   Nodes[19]:= 42;
  139.   Nodes[20]:= 50;
  140.  
  141.   { Offset 42 }
  142.   Nodes[21]:= Word(nodeFIELD);   { canFIELD = 4}
  143.   Nodes[22]:= Word(canFIELD2);   { canFIELD2 = 13 }
  144.   Nodes[23]:= 1;                 { canField.iFieldNum }
  145.   Nodes[24]:= 0;                 { canField.iNameOffset: szField1 is the
  146.                                    literal at offset 0 }
  147.   { Offset 50 }
  148.   Nodes[25]:= Word(nodeCONST);   { nodeCONST = 5 }
  149.   Nodes[26]:= Word(canCONST2);   { canCONST2 = 14 }
  150.   Nodes[27]:= fldFLOAT;          { canConst.iType }
  151.   Nodes[28]:= 8;                 { canConst.iSize }
  152.  
  153.   Nodes[29]:= (length(StrPas(szField1)) + 1) + sizeof(Values[1]);
  154.                                  { canConst.iOffset: lConst is the
  155.                                    literal at offset strlen(szField1) + 1
  156.                                    + sizeof(lConst1)}
  157.  
  158.   { Determine the values of certain constants Size of the nodes }
  159.   uSizeNodes      := sizeof(Nodes);
  160.   { Size of the literals }
  161.   uSizeLiterals  := strlen(szField1) + 1 + sizeof(Values[1]) +
  162.                     sizeof(Values[2]);
  163.   { Size of the header information }
  164.   uSizeCanExpr    := sizeof(CANExpr);
  165.   { Total size of the filter }
  166.   uTotalSize      := uSizeCanExpr + uSizeNodes + uSizeLiterals;
  167.   { Initialize the header information }
  168.   canExp.iVer := 1;                     { Version is 1 }
  169.   canExp.iTotalSize := uTotalSize;      { Set the Total Size of the filter }
  170.   canExp.iNodes := 7;                   { number of nodes }
  171.   canExp.iNodeStart := uSizeCanExpr;    { The offset in the buffer
  172.                                           where the expression nodes start }
  173.   { The offset in the buffer where the literals start }
  174.   canExp.iLiteralStart := uSizeCanExpr + uSizeNodes;
  175.   { Allocate space for the filter expression. }
  176.   GetMem(pcanExp, uTotalSize * sizeof(BYTE));
  177.   if not Assigned(pcanExp) then
  178.     MessageBox(0, 'Could not allocate memory.', 'Windows error', mb_Ok);
  179.  
  180.   { Initialize the filter expression. }
  181.   Move(canExp, pcanExp^, uSizeCanExpr);
  182.   Inc(pcanExp, uSizeCanExpr);
  183.  
  184.   Move(Nodes, pcanExp^, uSizeNodes);
  185.   Inc(pcanExp, uSizeNodes);
  186.  
  187.   Move(szField1^, pcanExp^, strlen(szField1)+1); { first literal }
  188.   Inc(pcanExp, strlen(szField1)+1);
  189.   Move(Values[1], pcanExp^, sizeof(Values[1]));  { second literal }
  190.   Inc(pcanExp, sizeof(Values[1]));
  191.   Move(Values[2], pcanExp^, sizeof(Values[2]));  { second literal }
  192.  
  193.   Dec(pCanExp, uSizeCanExpr + uSizeNodes + strlen(szField1) + 1 +
  194.                sizeof(Values[1]));
  195.  
  196.   FreeMem(pcanExp, uTotalSize * sizeof(BYTE));
  197.   { Add the filter }
  198.   Chk(DbiAddFilter(hTable, 0, 0, FALSE, pCANExpr(pcanExp),
  199.                    nil, hFilter));
  200.   { Activate the filter }
  201.   Chk(DbiActivateFilter(hTable, hFilter));
  202. end;
  203.  
  204. { METHOD:  RemoveFilter
  205.   PURPOSE: Deactivate and remove the filter on the Biolife.DB table.
  206. }
  207. function RemoveFilter(hTbl: hDbiCur; hFltr: hDBIFilter): DBIResult;
  208. begin
  209.   { Deactivate the filter }
  210.   Chk(DbiDeactivateFilter(hTbl, hFltr));
  211.   { Drop the filter }
  212.   Chk(DbiDropFilter(hTbl, hFltr));
  213. end;
  214.  
  215. end.
  216.