home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1996 August / VPR9608A.BIN / del20try / install / data.z / QBFFORM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-08  |  10KB  |  284 lines
  1. unit QBFForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, DB, DBTables, Buttons, ComCtrls, Tabnotbk;
  8.  
  9. type
  10.   TQueryForm = class(TForm)
  11.     BitBtn1: TBitBtn;
  12.     DataSource1: TDataSource;
  13.     Table1: TTable;
  14.     GroupBox1: TGroupBox;
  15.     CheckBox1: TCheckBox;
  16.     CheckBox2: TCheckBox;
  17.     PageControl1: TPageControl;
  18.     TabSheet1: TTabSheet;
  19.     Label5: TLabel;
  20.     Label1: TLabel;
  21.     Label2: TLabel;
  22.     Label3: TLabel;
  23.     Label4: TLabel;
  24.     ListBox1: TListBox;
  25.     ListBox2: TListBox;
  26.     ListBox3: TListBox;
  27.     Edit1: TEdit;
  28.     ComboBox1: TComboBox;
  29.     BitBtn2: TBitBtn;
  30.     TabSheet2: TTabSheet;
  31.     Memo1: TMemo;
  32.     procedure FormCreate(Sender: TObject);
  33.     procedure ListBox1Click(Sender: TObject);
  34.     procedure ListBox2Click(Sender: TObject);
  35.     procedure BitBtn2Click(Sender: TObject);
  36.   end;
  37.  
  38. var
  39.   QueryForm: TQueryForm;
  40.  
  41. implementation
  42.  
  43. {$R *.DFM}
  44.  
  45. uses RSLTFORM;
  46.  
  47. procedure TQueryForm.FormCreate(Sender: TObject);
  48. begin
  49.   Screen.Cursor := crHourglass;
  50.  
  51.   { Populate the alias list }
  52.  
  53.   with ListBox1 do
  54.   begin
  55.     Items.Clear;
  56.     Session.GetAliasNames(Items);
  57.   end;
  58.  
  59.   { Make sure there are aliases defined }
  60.  
  61.   Screen.Cursor := crDefault;
  62.   if ListBox1.Items.Count < 1 then
  63.     MessageDlg( 'There are no database aliases currently defined.  You ' +
  64.                 'need at least one alias to use this demonstration.',
  65.                  mtError, [mbOK], 0 );
  66.  
  67.   { Default the drop-down list to the first value in the list }
  68.   ComboBox1.ItemIndex := 0;
  69. end;
  70.  
  71. procedure TQueryForm.ListBox1Click(Sender: TObject);
  72. var
  73.   strValue: string;       { Holds the alias selected by the user }
  74.   bIsLocal: Boolean;      { Indicates whether or not an alias is local }
  75.   slParams: TStringList;  { Holds the parameters of the selected alias }
  76.   iCounter: Integer;      { An integer counter variable for loops}
  77. begin
  78.  
  79.   { Determine the alias name selected by the user }
  80.  
  81.   with ListBox1 do
  82.     strValue := Items.Strings[ItemIndex];
  83.  
  84.   { Get the names of the tables in the alias and put them in the
  85.     appropriate list box, making sure the user's choices are reflected
  86.     in the list. }
  87.  
  88.   ListBox2.Items.Clear;
  89.   Session.GetTableNames(strValue,          { alias to enumerate }
  90.                         '',                { pattern to match }
  91.                         CheckBox1.Checked, { show extensions flag }
  92.                         CheckBox2.Checked, { show system tables flag }
  93.                         ListBox2.Items);  { target for table list }
  94.  
  95.   { Make sure there are tables defined in the alias.  If not, show an
  96.     error; otherwise, clear the list box. }
  97.  
  98.   Screen.Cursor := crDefault;
  99.   if ListBox2.Items.Count < 1 then
  100.     MessageDlg('There are no tables in the alias you selected.  Please ' +
  101.                'choose another', mtError, [mbOK], 0 );
  102.  
  103.   ListBox3.Items.Clear;
  104. end;
  105.  
  106. procedure TQueryForm.ListBox2Click(Sender: TObject);
  107. begin
  108.   Screen.Cursor := crHourglass;
  109.   try
  110.     { First, disable the TTable object. }
  111.     if Table1.Active then
  112.       Table1.Close;
  113.  
  114.     { Open the selected table }
  115.  
  116.     with ListBox1 do
  117.       Table1.DatabaseName := Items.Strings[ItemIndex];
  118.  
  119.     with ListBox2 do
  120.       Table1.TableName := Items.Strings[ItemIndex];
  121.  
  122.     { Open the table and put a list of the field names in the Fields list box. }
  123.  
  124.     Table1.Open;
  125.     if Table1.Active then
  126.       Table1.GetFieldNames(ListBox3.Items);
  127.   finally
  128.     Screen.Cursor := crDefault;
  129.   end;
  130. end;
  131.  
  132. procedure TQueryForm.BitBtn2Click(Sender: TObject);
  133. var
  134.   strAlias,          { Alias name selected by the user }
  135.   strTable,          { Table name selected by the user }
  136.   strField,          { Field name selected by the user }
  137.   strValue,          { Field Value entered by the user }
  138.   strWhere,          { WHERE clause for the user's query }
  139.   strQuote,          { Holds quotes is the query field is text }
  140.   strQuery: string;  { String used to construct the query }
  141.   frmQuery: TResultForm; { The Results form }
  142. type
  143.  
  144.   { The following type is used with the Type drop-down
  145.     list.  The text values corresponding with each item is
  146.     described in comments, along with the relevant SQL operators. }
  147.  
  148.   etSQLOps = (soNoCondition,  { not field conditions: no WHERE clause }
  149.               soEqual,        { equals: =                             }
  150.               soNotEqual,     { is not equal to: <>                   }
  151.               soLessThan,     { is less than: <                       }
  152.               soLessEqual,    { is less than or equal to: <=          }
  153.               soMoreThan,     { is greater than: >                    }
  154.               soMoreEqual,    { is greater than or equal to: >=       }
  155.               soStartsWith,   { starts with: LIKE xx%                 }
  156.               soNoStartsWith, { doesn't start with: NOT LIKE xx%      }
  157.               soEndsWith,     { ends with: LIKE %xx                   }
  158.               soNoEndsWith,   { doesn't end with: NOT LIKE %xx        }
  159.               soContains,     { contains: LIKE %xx%                   }
  160.               soNoContains,   { doesn't contain: NOT LIKE %xx%        }
  161.               soBlank,        { is blank:                             }
  162.               soNotBlank,     { is not blank:                         }
  163.               soInside,       { contains only: IN ( xx, yy, zz )      }
  164.               soOutside);     { doesn't contain: NOT IN (xx, yy, zz)  }
  165. begin
  166.  
  167.   { Initialize the variables needed to run the query }
  168.  
  169.   with ListBox1 do
  170.     if ItemIndex = -1 then
  171.       raise Exception.Create('Can''t Run Query: No Alias Selected')
  172.     else
  173.       strAlias := Items.Strings[ItemIndex];
  174.  
  175.   with ListBox2 do
  176.     if ItemIndex = -1 then
  177.       raise Exception.Create('Can''t Run Query: No Table Selected')
  178.     else
  179.       strTable := Items.Strings[ItemIndex];
  180.  
  181.   with ListBox3 do
  182.     if ItemIndex = -1 then
  183.     begin
  184.       if ComboBox1.ItemIndex > Ord(soNocondition) then
  185.         raise Exception.Create('Can''t Run Query: No Field Selected')
  186.       else
  187.         strField := '';
  188.     end
  189.     else
  190.       strField := Items.Strings[ItemIndex];
  191.  
  192.   if (Edit1.Text = '') and
  193.     (ComboBox1.ItemIndex > Ord(soNoCondition)) and
  194.     (ComboBox1.ItemIndex < Ord(soBlank)) then
  195.     raise Exception.create('Can''t Run Query: No Search Value Entered')
  196.   else
  197.     strValue := Edit1.Text;
  198.  
  199.   { See if the field being search is a string field.  If so, then pad the
  200.     quote string with quotation marks; otherwise, set it to a null value. }
  201.  
  202.   if strField <> '' then
  203.     with Table1.FieldByName(strField) do
  204.       if (DataType = ftString) or (DataType = ftMemo) then
  205.         strQuote := '"' else
  206.         strQuote := '';
  207.  
  208.   { Construct the WHERE clause of the query based on the user's choice
  209.     in Type. }
  210.  
  211.   case etSQLOps(ComboBox1.ItemIndex) of
  212.     soNoCondition: strWhere := '';
  213.     soEqual: strWhere := strField + ' = ' + strQuote + strValue + strQuote;
  214.     soNotEqual: strWhere := strField + ' <> ' + strQuote + strValue + strQuote;
  215.     soLessThan: strWhere := strField + ' < ' + strQuote + strValue + strQuote;
  216.     soLessEqual: strWhere := strField + ' <= ' + strQuote + strValue + strQuote;
  217.     soMoreThan: strWhere := strField + ' > ' + strQuote + strValue + strQuote;
  218.     soMoreEqual: strWhere := strField + ' >= ' + strQuote + strValue + strQuote;
  219.     soStartsWith: strWhere := strField + ' LIKE ' + strQuote +
  220.                               strValue + '%' + strQuote;
  221.     soNoStartsWith: strWhere := strField + ' NOT LIKE ' + strQuote +
  222.                                 strValue + '%' + strQuote;
  223.     soEndsWith: strWhere := strField + ' LIKE ' + strQuote +
  224.                             '%' + strValue + strQuote;
  225.     soNoEndsWith: strWhere := strField + ' NOT LIKE ' +
  226.                               strQuote + '%' + strValue + strQuote;
  227.     soContains: strWhere := strField + ' LIKE ' +
  228.                             strQuote + '%' + strValue  + '%' + strQuote;
  229.     soNoContains: strWhere := strField + ' NOT LIKE ' +
  230.                               strQuote + '%' + strValue  + '%' + strQuote;
  231.     soBlank: strWhere := strField + ' IS NULL';
  232.     soNotBlank: strWhere := strField + ' IS NOT NULL';
  233.   end;
  234.  
  235.   if ComboBox1.ItemIndex = Ord(soNoCondition) then
  236.     strQuery := 'SELECT * FROM "' + strTable + '"'
  237.   else if Table1.FieldByName(strField).DataType = ftString then
  238.     strQuery := 'SELECT * FROM "' + strTable + '" t WHERE t.' + strWhere
  239.   else
  240.     strQuery := 'SELECT * FROM "' + strTable + '" t WHERE t.' + strWhere;
  241.  
  242.   { Create an instance of the browser form. }
  243.   frmQuery := TResultForm.Create(Application);
  244.  
  245.   { Use a resource protection block in case an exception is raised.  This
  246.     ensures that the memory allocated for the Results form is released. }
  247.   try
  248.     with frmQuery do
  249.     begin
  250.       Screen.Cursor := crHourglass;
  251.       if Query1.Active then Query1.Close;
  252.       Query1.DatabaseName := strAlias; { set the alias the query poitns to }
  253.       Query1.SQL.clear;                { empty existing SQL in the query }
  254.       Query1.SQL.Add(strQuery);        { add query string to query object }
  255.       Query1.Active := True;           { try to run the query }
  256.       Screen.Cursor := crDefault;
  257.  
  258.       if Query1.Active then
  259.       begin
  260.         { If the query didn't return any records, there's no point in
  261.           displaying the form.  In that event, raise an exception. }
  262.         if Query1.RecordCount < 1 then
  263.           raise Exception.create('No records matched your criteria.  ' +
  264.                                  'Please try again.' );
  265.  
  266.         { write a message to the browse form's status line }
  267.         if strField = '' then
  268.           Panel3.Caption := 'Now showing all records from ' + strTable + '...'
  269.         else
  270.           Panel3.Caption := 'Now showing ' + strTable + ' where ' +
  271.                              strField + ' contains values equal to ' +
  272.                              strValue + '...';
  273.  
  274.         { show the form }
  275.         ShowModal;
  276.       end;
  277.     end;
  278.   finally
  279.     frmQuery.Free;
  280.   end;
  281. end;
  282.  
  283. end.
  284.