home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue31 / survive / BldSQL.pas next >
Encoding:
Pascal/Delphi Source File  |  1997-11-19  |  7.8 KB  |  264 lines
  1. unit BldSQL;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes;
  7.  
  8. procedure BuildSQL1(aQuery, aIndexTable: string; aSQL: TStrings);
  9. { Allow single word search values and operators AND, OR, NOT, NEAR:
  10.      books
  11.      books AND author
  12.      books OR magazines
  13.      books NOT fiction
  14.      book NEAR reference
  15. }
  16.  
  17. procedure BuildSQL2(aQuery, aIndexTable: string; aSQL: TStrings);
  18. { Allow only a single multi-word search phrase delimited by quotes:
  19.      "edibility is good"
  20. }
  21.  
  22.  
  23. implementation
  24.  
  25. uses
  26.   SysUtils;
  27.  
  28. const
  29.   NearRange      = 3;
  30.  
  31. type
  32.   TQueryOperator = (opNONE, opAND, opOR, opNOT, opNEAR);
  33.  
  34. procedure MakeWordList(aText: string; aList: TStrings);
  35. var
  36.   P, T: PChar;
  37.   Word: string;
  38. begin
  39.   aList.Clear;
  40.   aText := aText + #32;
  41.   P := PChar(aText);
  42.   T := PChar(aText);
  43.   repeat
  44.     Inc(P);
  45.     if P^ = #32 then begin
  46.       SetString(Word, T, P - T);
  47.       T := P + 1;
  48.       aList.Add(Word);
  49.     end;
  50.   until P^ = #0;
  51. end;
  52.  
  53. procedure ParseQuery(aQuery: AnsiString;
  54.                  var aOperand1,
  55.                      aOperand2: AnsiString;
  56.                  var aOperator: TQueryOperator);
  57. type
  58.   TParseState = (psBegin, psExpectOperand, psExpectOperator);
  59. const
  60.   WhiteSpace = [#32, #8, #9, #13, #10];
  61. var
  62.   P: PChar;
  63.   State: TParseState;
  64.   InWhiteSpace: Boolean;
  65.   OperandIndex: Integer;
  66.   TempStr: AnsiString;
  67. begin
  68.   aOperand1 := '';
  69.   aOperand2 := '';
  70.   aOperator := opNONE;
  71.   State := psBegin;
  72.   InWhiteSpace := False;
  73.   OperandIndex := 1;
  74.   P := PChar(aQuery);
  75.   try
  76.     while (P^ <> #0) do begin
  77.       { Eat leading whitespace }
  78.       while P^ in WhiteSpace do begin
  79.         InWhiteSpace := True;
  80.         Inc(P);
  81.         if P^ = #0 then Exit;
  82.       end;
  83.  
  84.       { Change the parsing state upon encountering whitespace }
  85.       if InWhiteSpace or (State = psBegin) then begin
  86.         case State of
  87.           psBegin:
  88.             begin
  89.               State := psExpectOperand;
  90.               OperandIndex := 1;
  91.             end;
  92.           psExpectOperand:
  93.             State := psExpectOperator;
  94.           psExpectOperator:
  95.             begin
  96.               State := psExpectOperand;
  97.               OperandIndex := 2;
  98.             end;
  99.         end;
  100.         TempStr := '';
  101.         InWhiteSpace := False;
  102.       end;
  103.  
  104.       case State of
  105.         psExpectOperand:
  106.           begin
  107.             if P^ = '"' then begin  { we are in a literal }
  108.               Inc(P);
  109.               while P^ <> '"' do begin
  110.                 if P^ = #0 then
  111.                   raise Exception.Create('Literal not terminated');
  112.  
  113.                 if P^ in WhiteSpace then P^ := #32;
  114.                 if not ((P^ = #32) and ((P - 1)^ = #32)) then
  115.                   TempStr := TempStr + P^;
  116.                 Inc(P);
  117.               end;
  118.               Inc(P);
  119.             end
  120.             else begin
  121.               while not (P^ in WhiteSpace) do begin
  122.                 if P^ = #0 then Break;
  123.                 TempStr := TempStr + P^;
  124.                 Inc(P);
  125.               end;
  126.             end;
  127.  
  128.             case OperandIndex of
  129.               1: aOperand1 := TempStr;
  130.               2: aOperand2 := TempStr;
  131.             end;
  132.           end;
  133.         psExpectOperator:
  134.           begin
  135.             while not (P^ in WhiteSpace) do begin
  136.               if P^ = #0 then Break;
  137.               TempStr := TempStr + UpCase(P^);
  138.               Inc(P);
  139.             end;
  140.             if TempStr = 'AND' then
  141.               aOperator := opAND
  142.             else if TempStr = 'OR' then
  143.               aOperator := opOR
  144.             else if TempStr = 'NOT' then
  145.               aOperator := opNOT
  146.             else if TempStr = 'NEAR' then
  147.               aOperator := opNEAR
  148.             else
  149.               raise Exception.CreateFmt('Unknown Query Operator "%s"', [TempStr]);
  150.           end;
  151.       end;
  152.     end;
  153.   finally
  154.     aOperand1 := Uppercase(aOperand1);
  155.     aOperand2 := Uppercase(aOperand2);
  156.   end;
  157. end;
  158.  
  159. procedure BuildSQL1(aQuery, aIndexTable: AnsiString; aSQL: TStrings);
  160. var
  161.   Operand1, Operand2: AnsiString;
  162.   Operator: TQueryOperator;
  163.   NotWord: string;
  164. begin
  165.   ParseQuery(aQuery, Operand1, Operand2, Operator);
  166.   if (Pos(' ', Operand1) <> 0) or (Pos(' ', Operand2) <> 0) then
  167.     raise Exception.Create('Multi-word phrases not allowed here');
  168.  
  169.   with aSQL do begin
  170.     Clear;
  171.  
  172.     { This part is specific to the data table }
  173.     Add('SELECT Biolife."Species No", Common_Name, Biolife."Species Name" FROM Biolife');
  174.     Add('WHERE Biolife."Species No" IN ');
  175.  
  176.     case Operator of
  177.       opNONE:
  178.         begin
  179.           Add(Format('(SELECT DISTINCT RecordID FROM %s', [aIndexTable]));
  180.           Add(Format('WHERE Keyword = "%s")', [Operand1]));
  181.         end;
  182.       opOR:
  183.         begin
  184.           Add(Format('(SELECT DISTINCT RecordID FROM %s', [aIndexTable]));
  185.           Add(Format('WHERE Keyword = "%s"', [Operand1]));
  186.           Add(Format('OR Keyword = "%s")', [Operand2]));
  187.         end;
  188.       opAND, opNOT:
  189.         begin
  190.           if Operator = opNOT then NotWord := 'NOT' else NotWord := '';
  191.           Add(Format('(SELECT DISTINCT RecordID FROM %s A', [aIndexTable]));
  192.           Add(Format('   WHERE Keyword = "%s" AND %s EXISTS', [Operand1, NotWord]));
  193.           Add(Format('     (SELECT RecordID FROM %s B', [aIndexTable]));
  194.           Add(       '        WHERE A.RecordID = B.RecordID AND');
  195.           Add(Format('              B.Keyword = "%s"))', [Operand2]));
  196.         end;
  197.       opNEAR:
  198.         begin
  199.           if CompareText(aIndexTable, 'BIOLIFEIDX2') <> 0 then
  200.             raise Exception.Create('BiolifeIdx2 Required for NEAR');
  201.  
  202.           Add(Format('(SELECT DISTINCT RecordID FROM %s A', [aIndexTable]));
  203.           Add(Format('   WHERE Keyword = "%s" AND %s EXISTS', [Operand1, NotWord]));
  204.           Add(Format('     (SELECT RecordID FROM %s B', [aIndexTable]));
  205.           Add(       '        WHERE A.RecordID = B.RecordID AND');
  206.           Add(Format('              B.Keyword = "%s" AND', [Operand2]));
  207.           Add(Format('              A.WordOffset - B.WordOffset <= %d AND', [NearRange]));
  208.           Add(Format('              A.WordOffset - B.WordOffset >= %d))', [-NearRange]));
  209.         end;
  210.     end;
  211.   end;
  212. end;
  213.  
  214. procedure BuildSQL2(aQuery, aIndexTable: AnsiString; aSQL: TStrings);
  215. var
  216.   Operand1, Operand2: AnsiString;
  217.   Operator: TQueryOperator;
  218.   PhraseWords: TStringList;
  219.   Temp: string;
  220.   I: Integer;
  221. begin
  222.   ParseQuery(aQuery, Operand1, Operand2, Operator);
  223.   if Operator <> opNONE then
  224.     raise Exception.Create('Operators not allowed here');
  225.  
  226.   with aSQL do begin
  227.     Clear;
  228.  
  229.     { This part is specific to the data table }
  230.     Add('SELECT Biolife."Species No", Common_Name, Biolife."Species Name" FROM Biolife');
  231.     Add('WHERE Biolife."Species No" IN ');
  232.  
  233.     { Check for a single word value }
  234.     if Pos(' ', Operand1) = 0 then begin
  235.       Add(Format('(SELECT DISTINCT RecordID FROM %s', [aIndexTable]));
  236.       Add(Format(' WHERE Keyword = "%s")', [Operand1]));
  237.     end
  238.     else begin
  239.       PhraseWords := TStringList.Create;
  240.       try
  241.         MakeWordList(Operand1, PhraseWords);
  242.  
  243.         Add(Format('(SELECT RecordID FROM %s A', [aIndexTable]));
  244.         Add(Format('   WHERE A.Keyword = "%s" AND EXISTS(', [PhraseWords[0]]));
  245.         Add(Format('     SELECT RecordID FROM %s B', [aIndexTable]));
  246.         Add(       '       WHERE A.RecordID = B.RECORDID AND');
  247.         for I := 1 to PhraseWords.Count - 1 do begin
  248.           Temp := Format('(B.Keyword = "%s" AND B.WordOffset = A.WordOffset + %d)', [PhraseWords[I], I]);
  249.           if I = 1 then Temp := '(' + Temp;
  250.           if I < PhraseWords.Count - 1 then Temp := Temp + ' OR'
  251.           else Temp := Temp + ')';
  252.           Add(Temp);
  253.         end;
  254.         Add(       '       GROUP BY RecordID');
  255.         Add(Format('       HAVING COUNT(*) = %d))', [PhraseWords.Count - 1]));
  256.       finally
  257.         PhraseWords.Free;
  258.       end;
  259.     end;
  260.   end;
  261. end;
  262.  
  263. end.
  264.