home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / query / mquery / mquery.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-05-24  |  26.3 KB  |  895 lines

  1. VERSION 2.00
  2. Begin Form fQuery 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "Query Builder"
  7.    ClientHeight    =   5730
  8.    ClientLeft      =   1425
  9.    ClientTop       =   2145
  10.    ClientWidth     =   9195
  11.    ClipControls    =   0   'False
  12.    ControlBox      =   0   'False
  13.    Height          =   6195
  14.    Icon            =   MQUERY.FRX:0000
  15.    KeyPreview      =   -1  'True
  16.    Left            =   1335
  17.    LinkTopic       =   "Form1"
  18.    MaxButton       =   0   'False
  19.    MinButton       =   0   'False
  20.    ScaleHeight     =   5709.895
  21.    ScaleMode       =   0  'User
  22.    ScaleWidth      =   9625.69
  23.    Top             =   1770
  24.    Width           =   9375
  25.    Begin SSPanel PnlHelp 
  26.       Alignment       =   1  'Left Justify - MIDDLE
  27.       AutoSize        =   1  'AutoSize Panel Width To Caption
  28.       BackColor       =   &H0000FFFF&
  29.       BevelOuter      =   0  'None
  30.       BorderWidth     =   1
  31.       Height          =   315
  32.       Left            =   3705
  33.       TabIndex        =   32
  34.       Top             =   1320
  35.       Visible         =   0   'False
  36.       Width           =   1965
  37.    End
  38.    Begin ListBox cColOrder 
  39.       BackColor       =   &H00C0C0C0&
  40.       Height          =   420
  41.       Left            =   6000
  42.       TabIndex        =   31
  43.       Top             =   1590
  44.       Width           =   3075
  45.    End
  46.    Begin CommandButton RunSaveQryButton 
  47.       Caption         =   "&Load Query"
  48.       Height          =   375
  49.       Left            =   4440
  50.       TabIndex        =   0
  51.       Top             =   4815
  52.       Width           =   1290
  53.    End
  54.    Begin CommandButton ExecSqlButton 
  55.       Caption         =   "&ExecSQL"
  56.       Height          =   375
  57.       Left            =   5835
  58.       TabIndex        =   1
  59.       Top             =   4815
  60.       Width           =   960
  61.    End
  62.    Begin SSPanel Panel3D1 
  63.       Align           =   2  'Align Bottom
  64.       Alignment       =   1  'Left Justify - MIDDLE
  65.       BevelInner      =   1  'Inset
  66.       FontBold        =   -1  'True
  67.       FontItalic      =   0   'False
  68.       FontName        =   "Arial"
  69.       FontSize        =   9.75
  70.       FontStrikethru  =   0   'False
  71.       FontUnderline   =   0   'False
  72.       Height          =   435
  73.       Left            =   0
  74.       TabIndex        =   29
  75.       Top             =   5295
  76.       Width           =   9195
  77.    End
  78.    Begin Frame Frame1 
  79.       BackColor       =   &H00C0C0C0&
  80.       Caption         =   "Display"
  81.       Height          =   495
  82.       Left            =   120
  83.       TabIndex        =   28
  84.       Top             =   4740
  85.       Width           =   3075
  86.       Begin OptionButton Option1 
  87.          BackColor       =   &H00C0C0C0&
  88.          Caption         =   "Grid"
  89.          Height          =   195
  90.          Index           =   0
  91.          Left            =   2100
  92.          TabIndex        =   19
  93.          Top             =   180
  94.          Value           =   -1  'True
  95.          Width           =   915
  96.       End
  97.       Begin OptionButton Option1 
  98.          BackColor       =   &H00C0C0C0&
  99.          Caption         =   "Record"
  100.          Height          =   195
  101.          Index           =   1
  102.          Left            =   840
  103.          TabIndex        =   18
  104.          Top             =   180
  105.          Width           =   975
  106.       End
  107.    End
  108.    Begin PictureBox ExpressionBox 
  109.       BackColor       =   &H00C0C0C0&
  110.       Height          =   1095
  111.       Left            =   120
  112.       ScaleHeight     =   1065
  113.       ScaleWidth      =   9705
  114.       TabIndex        =   24
  115.       Tag             =   "OL"
  116.       Top             =   240
  117.       Width           =   9735
  118.       Begin CommandButton GetValuesButton 
  119.          Caption         =   "List Possible &Values"
  120.          Height          =   252
  121.          Left            =   5955
  122.          TabIndex        =   17
  123.          Top             =   720
  124.          Width           =   2292
  125.       End
  126.       Begin ComboBox cValue 
  127.          BackColor       =   &H00C0C0C0&
  128.          Height          =   300
  129.          Left            =   5580
  130.          Sorted          =   -1  'True
  131.          TabIndex        =   14
  132.          Text            =   "cValue"
  133.          Top             =   375
  134.          Width           =   3330
  135.       End
  136.       Begin ComboBox cOperator 
  137.          BackColor       =   &H00C0C0C0&
  138.          Height          =   300
  139.          Left            =   4320
  140.          Style           =   2  'Dropdown List
  141.          TabIndex        =   13
  142.          Top             =   360
  143.          Width           =   1095
  144.       End
  145.       Begin ComboBox cField 
  146.          BackColor       =   &H00C0C0C0&
  147.          Height          =   300
  148.          Left            =   120
  149.          Style           =   2  'Dropdown List
  150.          TabIndex        =   12
  151.          Top             =   360
  152.          Width           =   4095
  153.       End
  154.       Begin CommandButton ORButton 
  155.          Caption         =   "&Or into Criteria"
  156.          Height          =   252
  157.          Left            =   2040
  158.          TabIndex        =   16
  159.          Top             =   720
  160.          Width           =   1812
  161.       End
  162.       Begin CommandButton ANDButton 
  163.          Caption         =   "&And into Criteria"
  164.          Height          =   252
  165.          Left            =   120
  166.          TabIndex        =   15
  167.          Tag             =   "Are you paying attention!!!!"
  168.          Top             =   720
  169.          Width           =   1812
  170.       End
  171.       Begin Label OperatorLabel 
  172.          BackColor       =   &H00C0C0C0&
  173.          Caption         =   "Operator:"
  174.          Height          =   195
  175.          Left            =   4320
  176.          TabIndex        =   27
  177.          Top             =   120
  178.          Width           =   975
  179.       End
  180.       Begin Label ValueLabel 
  181.          BackColor       =   &H00C0C0C0&
  182.          Caption         =   "Value:"
  183.          Height          =   195
  184.          Left            =   5520
  185.          TabIndex        =   26
  186.          Top             =   120
  187.          Width           =   1455
  188.       End
  189.       Begin Label FieldNameLabel 
  190.          BackColor       =   &H00C0C0C0&
  191.          Caption         =   "Field Name:"
  192.          Height          =   192
  193.          Left            =   120
  194.          TabIndex        =   25
  195.          Top             =   120
  196.          Width           =   1332
  197.       End
  198.    End
  199.    Begin CommandButton JoinButton 
  200.       Caption         =   "Set Table &Joins"
  201.       Height          =   255
  202.       Left            =   6240
  203.       TabIndex        =   10
  204.       Top             =   2670
  205.       Width           =   2535
  206.    End
  207.    Begin ListBox cJoinFields 
  208.       BackColor       =   &H00C0C0C0&
  209.       Height          =   420
  210.       Left            =   6000
  211.       TabIndex        =   11
  212.       Tag             =   "OL"
  213.       Top             =   2970
  214.       Width           =   3135
  215.    End
  216.    Begin ComboBox cOrderByField 
  217.       BackColor       =   &H00C0C0C0&
  218.       Height          =   300
  219.       Left            =   6000
  220.       Style           =   2  'Dropdown List
  221.       TabIndex        =   9
  222.       Tag             =   "OL"
  223.       Top             =   2310
  224.       Width           =   3135
  225.    End
  226.    Begin ListBox cTableList 
  227.       BackColor       =   &H00C0C0C0&
  228.       Height          =   1590
  229.       Left            =   120
  230.       MultiSelect     =   1  'Simple
  231.       TabIndex        =   6
  232.       Tag             =   "OL"
  233.       Top             =   1680
  234.       Width           =   2175
  235.    End
  236.    Begin ListBox cShowFields 
  237.       BackColor       =   &H00C0C0C0&
  238.       Height          =   1590
  239.       Left            =   2415
  240.       MultiSelect     =   1  'Simple
  241.       TabIndex        =   7
  242.       Tag             =   "OL"
  243.       Top             =   1650
  244.       Width           =   3510
  245.    End
  246.    Begin CommandButton CloseButton 
  247.       Cancel          =   -1  'True
  248.       Caption         =   "&Exit"
  249.       Height          =   375
  250.       Left            =   8070
  251.       TabIndex        =   3
  252.       Top             =   4815
  253.       Width           =   915
  254.    End
  255.    Begin CommandButton RunQueryButton 
  256.       Caption         =   "&Run Query"
  257.       Height          =   375
  258.       Left            =   3300
  259.       TabIndex        =   4
  260.       Top             =   4815
  261.       Width           =   1035
  262.    End
  263.    Begin CommandButton ClearButton 
  264.       Caption         =   "R&eset"
  265.       Height          =   375
  266.       Left            =   6900
  267.       TabIndex        =   2
  268.       Top             =   4815
  269.       Width           =   1095
  270.    End
  271.    Begin TextBox cCriteria 
  272.       BackColor       =   &H00C0C0C0&
  273.       Height          =   1215
  274.       Left            =   45
  275.       MultiLine       =   -1  'True
  276.       ScrollBars      =   2  'Vertical
  277.       TabIndex        =   5
  278.       Tag             =   "OL"
  279.       Top             =   3480
  280.       Width           =   9105
  281.    End
  282.    Begin Label lFilter 
  283.       AutoSize        =   -1  'True
  284.       BackColor       =   &H00C0C0C0&
  285.       Caption         =   "Select Filter"
  286.       Height          =   195
  287.       Left            =   120
  288.       TabIndex        =   30
  289.       Top             =   0
  290.       Width           =   1035
  291.    End
  292.    Begin Label OrberByFieldLabel 
  293.       BackColor       =   &H00C0C0C0&
  294.       Caption         =   "Order By Field:"
  295.       Height          =   195
  296.       Left            =   6000
  297.       TabIndex        =   8
  298.       Top             =   2070
  299.       Width           =   2055
  300.    End
  301.    Begin Label ColOrderLabel 
  302.       BackColor       =   &H00C0C0C0&
  303.       Caption         =   "Column Order:"
  304.       Height          =   195
  305.       Left            =   6000
  306.       TabIndex        =   23
  307.       Top             =   1380
  308.       Width           =   2055
  309.    End
  310.    Begin Label TableListLabel 
  311.       BackColor       =   &H00C0C0C0&
  312.       Caption         =   "Select Tables:"
  313.       Height          =   195
  314.       Left            =   120
  315.       TabIndex        =   22
  316.       Top             =   1440
  317.       Width           =   1455
  318.    End
  319.    Begin Label ShowFieldsLabel 
  320.       BackColor       =   &H00C0C0C0&
  321.       Caption         =   "Select Fields to Show:"
  322.       Height          =   195
  323.       Left            =   2400
  324.       TabIndex        =   21
  325.       Top             =   1440
  326.       Width           =   2055
  327.    End
  328.    Begin Label CriteriaLabel 
  329.       BackColor       =   &H00C0C0C0&
  330.       Caption         =   "Criteria:"
  331.       Height          =   180
  332.       Left            =   120
  333.       TabIndex        =   20
  334.       Top             =   3270
  335.       Width           =   1335
  336.    End
  337. Sub ANDButton_Click ()
  338.   ShowHelp ANDButton, 0, 0
  339.   Dim f As field
  340.   Dim ns As Integer
  341.   Dim nsflds As String
  342.   Dim nt As Integer
  343.   Dim ntflds As String
  344.   If cField = "" Then Exit Sub
  345.     If UCase(Left(cField, 4)) = "DBO." Then
  346.     nsflds = Mid(cField, 5, Len(cField))
  347.     Else
  348.     nsflds = cField
  349.     End If
  350.   Set f = gCurrentDB.TableDefs(stSTF((nsflds), 0)).Fields(stSTF((nsflds), 1))
  351.  If cCriteria <> "" Then
  352.     cCriteria = cCriteria + Chr(13) + Chr(10) + "And "
  353.   End If
  354.   If f.Type = FT_STRING Or f.Type = FT_MEMO Then
  355.      ns = InStr(1, cField, ".")
  356.      nsflds = Mid(cField, ns + 1, Len(cField))
  357.      ntflds = Left(cField, ns - 1)
  358.         nt = InStr(1, ntflds, " ")
  359.         If nt > 0 Then
  360.         ntflds = "[" + ntflds + "]"
  361.         nsflds = ntflds + "." + "[" + nsflds + "]"
  362.         Else
  363.         nsflds = "[" + nsflds + "]"
  364.         nsflds = Left(cField, ns) + nsflds
  365.         End If
  366.       nt = InStr(1, cValue, "'")
  367.       If nt > 0 Then
  368.       ntflds = Chr(34) + cValue + Chr(34)
  369.      cCriteria = cCriteria + "((" + nsflds + " " + cOperator + " " + ntflds + "))"
  370.      Else
  371.     cCriteria = cCriteria + nsflds + " " + cOperator + " '" + cValue + "'"
  372.      End If
  373.   Else
  374.      'If f.Type = FT_DATETIME Then
  375.          ns = InStr(1, cField, ".")
  376.          nsflds = Mid(cField, ns + 1, Len(cField))
  377.          ntflds = Left(cField, ns - 1)
  378.          nt = InStr(1, ntflds, " ")
  379.         If nt > 0 Then
  380.         ntflds = "[" + ntflds + "]"
  381.         nsflds = ntflds + "." + "[" + nsflds + "]"
  382.         Else
  383.         nsflds = "[" + nsflds + "]"
  384.         nsflds = Left(cField, ns) + nsflds
  385.         End If
  386.         If f.Type = FT_DATETIME Then
  387.         cValue = "#" + cValue + "#"
  388.         End If
  389.     'End If
  390.     cCriteria = cCriteria + nsflds + " " + cOperator + " " + cValue
  391.   End If
  392.   cField.SetFocus
  393. End Sub
  394. Sub ANDButton_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
  395.     ShowHelp ANDButton, x, y
  396. End Sub
  397. Sub cCriteria_GotFocus ()
  398. ExecSqlButton.Enabled = True
  399. RunSaveQryButton.Enabled = False
  400. End Sub
  401. Sub cField_Click ()
  402.   cValue.Clear
  403. End Sub
  404. Sub ClearButton_Click ()
  405. resetdefault
  406. End Sub
  407. Sub CloseButton_Click ()
  408. End Sub
  409. Sub cShowFields_Click ()
  410. If cShowfields.ListCount = 0 Then
  411. CriteriaLabel.Caption = "SQL Statement"
  412. Exit Sub
  413. End If
  414. ' which item was clicked on
  415. ' is it already in the colorder box if so remove it
  416. For j% = 0 To cColOrder.ListCount - 1
  417. If cColOrder.List(j%) = cShowfields.List(cShowfields.ListIndex) Then
  418. cColOrder.RemoveItem (j%)
  419. removed% = True
  420. Exit For
  421. End If
  422. Next j%
  423. If Not removed% Then ' must be an add not a remove
  424. addit$ = cShowfields.List(cShowfields.ListIndex)
  425. cColOrder.AddItem addit$
  426. removed% = False
  427. End If
  428. CriteriaLabel.Caption = "Criteria:"
  429. For h% = 0 To cShowfields.ListCount - 1
  430. If cShowfields.Selected(h%) Then
  431.     RunQueryButton.Enabled = True
  432.     ExecSqlButton.Enabled = False
  433.    If RunSaveQryButton.Caption = "&Load Query" Then
  434.     RunSaveQryButton.Enabled = False
  435.    End If
  436. Exit Sub
  437. End If
  438. RunQueryButton.Enabled = False
  439. ExecSqlButton.Enabled = True
  440. End Sub
  441. Sub cTableList_Click ()
  442.     On Error GoTo errtrap
  443.     If deselect > 0 Then
  444.     deselect = 0
  445.     Exit Sub
  446.     End If
  447.   Dim I As Integer, ii As Integer
  448.   Dim t As TableDef
  449.   Dim q As QueryDef
  450.   Dim st As String
  451.   Dim trap As Integer
  452.   cCriteria.Text = ""
  453.   cField.Clear
  454.   cShowfields.Clear
  455.   cColOrder.Clear
  456.   cOrderByField.Clear
  457.   cValue.Clear
  458.   If RunQueryButton.Enabled = True Then
  459.       RunSaveQryButton.Enabled = True
  460.       RunQueryButton.Enabled = False
  461.       ExecSqlButton.Enabled = True
  462.       CriteriaLabel.Caption = "SQL Statement"
  463.   End If
  464.   gStoredFlag = False
  465.   cOrderByField.AddItem "(none)"
  466.   For ii = 0 To cTableList.ListCount - 1
  467.     If cTableList.Selected(ii) Then
  468.     'RunQueryButton.Enabled = True
  469.       Set t = gCurrentDB.TableDefs(cTableList.List(ii))
  470.       For I = 0 To t.Fields.Count - 1
  471.     st = cTableList.List(ii) + "." + t.Fields(I).Name
  472.         If UCase(Left(st, 4)) = "DBO." Then
  473.         st = Mid(st, 5, Len(st))
  474.         End If
  475.     cField.AddItem st
  476.     cShowfields.AddItem st
  477.     'cColOrder.AddItem st
  478.     cOrderByField.AddItem st
  479.       Next
  480.     End If
  481.   Next
  482.   If cField.List(0) <> "" Then
  483.     cField.ListIndex = 0
  484.     'cColOrder.ListIndex = 0
  485.     cOrderByField.ListIndex = 0
  486.   End If
  487. exitit:
  488. Exit Sub
  489. errtrap:
  490.   trap = MsgBox("Cannot use this file", 0, "Query")
  491.   Resume exitit
  492. End Sub
  493. Sub ExecSqlButton_Click ()
  494. ExecSql
  495. If Not gfFROMSQL And Not gStoredFlag Then
  496.  MsgBox "No SQL Statement to Execute!", 48
  497.  NoCritflag = False
  498. End If
  499. End Sub
  500. Sub Form_Load ()
  501.    fQuery.Left = (screen.Width - fQuery.Width) / 2
  502.    fQuery.Top = (screen.Height - fQuery.Height) / 2
  503.    On Local Error GoTo FLErr
  504.    Dim ds As DynaSet
  505.    Dim I As Integer
  506.    Dim t As TableDef
  507.    Dim q As QueryDef
  508.    'Clear listbox
  509.    cCriteria = ""
  510.    'Fill the Operator combo
  511.    cOperator.AddItem "="
  512.    cOperator.AddItem "<>"
  513.    cOperator.AddItem ">"
  514.    cOperator.AddItem ">="
  515.    cOperator.AddItem "<"
  516.    cOperator.AddItem "<="
  517.    cOperator.AddItem "Like"
  518.    cOperator.ListIndex = 0
  519.    cTableList.ListIndex = 0
  520.    CriteriaLabel.Caption = "SQL Statement"
  521.    RunSaveQryButton.Caption = "&Load Query"
  522.    RunQueryButton.Enabled = False
  523.    cValue = ""
  524.   GoTo FLEnd
  525. FLErr:
  526.   ShowError
  527.   Resume FLEnd
  528. FLEnd:
  529. Me.Show
  530. End Sub
  531. Sub Form_Paint ()
  532.   Outlines Me
  533.   PicOutlines ExpressionBox, cField
  534.   PicOutlines ExpressionBox, cOperator
  535.   PicOutlines ExpressionBox, cValue
  536. End Sub
  537. Sub Form_Resize ()
  538.   On Error Resume Next
  539.   If WindowState <> 1 Then
  540.     Height = 6050
  541.     'Width = 7224
  542.     Width = 9315'250
  543.   End If
  544. End Sub
  545. Sub GetValuesButton_Click ()
  546.   Dim ds As DynaSet
  547.   Dim dsString As String
  548.   Dim ns As Integer
  549.   Dim fldn As String
  550.   Dim nv As String
  551.   cValue.Clear
  552.     ' search for sql .dbo and strip
  553.     If UCase(Left(cField, 4)) = "DBO." Then
  554.     fldn = Mid(cField, 5, Len(cField))
  555.     ns = InStr(1, fldn, ".")
  556.     nv = Left(fldn, ns - 1)
  557.     fldn = "[" + Mid(fldn, ns + 1, Len(fldn)) + "]"
  558.     fldn = nv + "." + fldn
  559.     dsString = "select Distinct " + fldn + " from "
  560.     Else
  561.     ns = InStr(1, cField, ".")
  562.     fldn = Mid(cField, ns + 1, Len(cField))
  563.     nv = Left(cField, ns - 1)
  564.     nt% = InStr(1, nv, " ")
  565.     If nt% > 0 Then
  566.      fldn = "[" + nv + "]" + "." + "[" + fldn + "]"
  567.     Else
  568.     fldn = Left(cField, ns) + "[" + fldn + "]"
  569.     End If
  570.     dsString = "select Distinct " + fldn + " from "
  571.     End If
  572.   On Error GoTo GVErr
  573.   MsgBar "Getting Possible Values", True
  574.   SetHourGlass Me
  575.   Set ds = gCurrentDB.CreateDynaset(dsString + stSTF((fldn), 0))
  576.   Do While ds.EOF = False
  577.     If Trim(ds(0)) <> "" Then
  578.       cValue.AddItem ds(0).Value
  579.     End If
  580.     ds.MoveNext
  581.   Loop
  582.   ds.Close
  583.   cValue = cValue.List(0)
  584.   cValue.SetFocus
  585.   GoTo GVEnd
  586. GVErr:
  587.   cValue = ""
  588.   Resume GVEnd
  589. GVEnd:
  590.   ResetMouse Me
  591.   MsgBar "", False
  592. End Sub
  593. Sub JoinButton_Click ()
  594.   Dim I As Integer
  595.   Dim c As Integer
  596.   For I = 0 To cTableList.ListCount - 1
  597.     If cTableList.Selected(I) = True Then
  598.       c = c + 1
  599.     End If
  600.   Next
  601.   If c < 2 Then
  602.     Beep
  603.     MsgBox "You Must Have at Least 2 Tables Selected!", 48
  604.   Else
  605.     MsgBar "Choose Joins", False
  606.     fJoin.Show MODAL
  607.     MsgBar "", False
  608.   End If
  609. End Sub
  610. Sub ORButton_Click ()
  611.   Dim f As field
  612.   Dim ns As Integer
  613.   Dim nsflds As String
  614.   Dim nt As Integer
  615.   Dim ntflds As String
  616.   If cField = "" Then Exit Sub
  617.     If UCase(Left(cField, 4)) = "DBO." Then
  618.     nsflds = Mid(cField, 5, Len(cField))
  619.     Else
  620.     nsflds = cField
  621.     End If
  622.   Set f = gCurrentDB.TableDefs(stSTF((cField), 0)).Fields(stSTF((cField), 1))
  623.   If cCriteria <> "" Then
  624.     cCriteria = cCriteria + Chr(13) + Chr(10) + " Or "
  625.   End If
  626.   If f.Type = FT_STRING Or f.Type = FT_MEMO Then
  627.      ns = InStr(1, cField, ".")
  628.      nsflds = Mid(cField, ns + 1, Len(cField))
  629.      ntflds = Left(cField, ns - 1)
  630.         nt = InStr(1, ntflds, " ")
  631.         If nt > 0 Then
  632.         ntflds = "[" + ntflds + "]"
  633.         nsflds = ntflds + "." + "[" + nsflds + "]"
  634.         Else
  635.         nsflds = "[" + nsflds + "]"
  636.         nsflds = Left(cField, ns) + nsflds
  637.         End If
  638.     cCriteria = cCriteria + nsflds + " " + cOperator + " '" + cValue + "'"
  639.   Else
  640.      If f.Type = FT_DATETIME Then
  641.          ns = InStr(1, cField, ".")
  642.          nsflds = Mid(cField, ns + 1, Len(cField))
  643.          ntflds = Left(cField, ns - 1)
  644.          nt = InStr(1, ntflds, " ")
  645.         If nt > 0 Then
  646.         ntflds = "[" + ntflds + "]"
  647.         nsflds = ntflds + "." + "[" + nsflds + "]"
  648.         Else
  649.         nsflds = "[" + nsflds + "]"
  650.         nsflds = Left(cField, ns) + nsflds
  651.         End If
  652.         cValue = "#" + cValue + "#"
  653.     End If
  654.     cCriteria = cCriteria + nsflds + " " + cOperator + " " + cValue
  655.   End If
  656.   cField.SetFocus
  657. End Sub
  658. Sub RunQueryButton_Click ()
  659.   On Error GoTo OKErr
  660.      Dim ds As DynaSet
  661.      Dim fs As String
  662.      Dim ts As String
  663.      Dim I As Integer
  664.      Dim ns As Integer
  665.      Dim nsflds As String
  666.      Dim nt As Integer
  667.      Dim ntflds As String
  668.      Dim listnu As Integer
  669.      Dim joins As String
  670.      joins = ""
  671.      listnu = 0
  672.     MsgBar "Building Query", True
  673.        For I% = 0 To cTableList.ListCount - 1
  674.     If cTableList.Selected(I%) Then
  675.     listnu = listnu + 1
  676.     End If
  677.       Next I
  678.         If listnu > 1 And cJoinFields.ListCount = 0 Then
  679.         MsgBox "You Must Have a Join for more than 1 Table Selected!", 48
  680.         Exit Sub
  681.         End If
  682.      'check for join condition
  683.      If cJoinFields.ListCount > 0 Then
  684.        For I = 0 To cJoinFields.ListCount - 1
  685.      joins = joins + cJoinFields.List(I) + ","
  686.        Next
  687.        'get rid of last ,
  688.        joins = " " + Left(joins, Len(joins) - 1)
  689.        End If
  690.      If cCriteria <> "" Then
  691.       StWhere$ = "AND " + LTrim(cCriteria)
  692.        'strip CRLFs
  693.        For I = 1 To Len(StWhere$)
  694.      If Mid(StWhere$, I, 1) = Chr$(13) Then
  695.        stTmp$ = stTmp$ + " "
  696.      ElseIf Mid(StWhere$, I, 1) = Chr$(10) Then
  697.        'do nothing
  698.      Else
  699.        stTmp$ = stTmp$ + Mid(StWhere$, I, 1)
  700.      End If
  701.        Next
  702.        StWhere$ = stTmp$
  703.        StWhere$ = RTrim(StWhere$)
  704.      
  705.        'Add parens to stWhere$
  706.     stTmpWhere$ = StWhere$
  707.       stTmp$ = stGetToken(stTmpWhere$, " ")
  708.       If fMatchParen% = False And UCase(stTmp$) = "AND" Then
  709.         stNewWhere$ = stNewWhere$ + stTmp$ + " ("
  710.         fMatchParen% = True
  711.       ElseIf fMatchParen% = True And UCase(stTmp$) = "AND" Then
  712.         stNewWhere$ = stNewWhere$ + ") " + stTmp$ + " ("
  713.         'fMatchParen% = False
  714.       Else
  715.         If UCase(stTmp$) = "OR" Or UCase(stTmp$) = "IN" Or UCase(stTmp$) = "LIKE" Then
  716.           stNewWhere$ = stNewWhere$ + " " + stTmp$ + " "
  717.         Else
  718.           stNewWhere$ = stNewWhere$ + stTmp$
  719.         End If
  720.       End If
  721.     Loop Until stTmpWhere$ = ""
  722.     StWhere$ = stNewWhere$ + ")"
  723.        'Build DynaSet string:
  724.        'Peel off leading AND/OR
  725.        If Mid(StWhere$, 2, 2) = "OR" Then
  726.      StWhere$ = Mid(StWhere$, 5, Len(StWhere$) - 5)
  727.        Else
  728.      stTmp$ = stGetToken(StWhere$, " ")
  729.        End If
  730.        If StWhere$ <> "" Then
  731.      StWhere$ = " Where " + StWhere$
  732.      Else
  733.      StWhere$ = " Where " + cCriteria
  734.        End If
  735.      End If
  736.      ' get rid of brackets
  737.      ' check for more brackets until nomore
  738.      Do
  739.      ns = InStr(1, StWhere$, "'[")
  740.      If ns <> 0 Then
  741.      nsflds = Mid(StWhere$, 1, ns)
  742.      nv$ = Mid$(StWhere$, ns + 2, Len(StWhere$))
  743.      nsflds = nsflds + nv$
  744.      ns = InStr(1, nsflds, "]'")
  745.      nv$ = Mid$(nsflds, ns + 1, Len(nsflds))
  746.      nv$ = Mid(nsflds, 1, ns - 1) + nv$
  747.      StWhere$ = nv$
  748.      End If
  749.      Loop Until ns = 0
  750.      'check for join condition
  751.      If joins <> "" Then
  752.      StWhere$ = "," + joins + " " + StWhere$
  753.      End If
  754.      'check
  755.      
  756.      'check for order by field
  757.      If cOrderByField <> "(none)" Then
  758.     '  check for dbo. in field
  759.     If UCase(Left(cOrderByField, 4)) = "DBO." Then
  760.         nsflds = Mid(cOrderByField, 5, Len(cOrderByField))
  761.         ns = InStr(1, nsflds, ".")
  762.         nsflds = "[" + Mid(nsflds, ns + 1, Len(nsflds)) + "]"
  763.         nv$ = Mid(cOrderByField, 5, ns) + nsflds
  764.         StWhere$ = StWhere$ + " Order By " + nv$
  765.     Else
  766.         ns = InStr(1, cOrderByField, ".")
  767.         nsflds = "[" + Mid(cOrderByField, ns + 1, Len(cOrderByField)) + "]"
  768.         nv$ = Left(cOrderByField, ns) + nsflds
  769.         StWhere$ = StWhere$ + " Order By " + nv$
  770.     End If
  771.      End If
  772.      'get show field names and strip out sql servers dbo. field preface
  773.      For I% = 0 To cColOrder.ListCount - 1
  774.        If UCase(Left(cColOrder.List(I%), 4)) = "DBO." Then
  775.              nsflds = Mid(cColOrder.List(I%), 5, Len(cColOrder.List(I%)))
  776.              ns = InStr(1, nsflds, ".")
  777.              nsflds = Mid(nsflds, ns + 1, Len(nsflds))
  778.              nsflds = "[" + nsflds + "]"
  779.              nsflds = Left(Mid(cColOrder.List(I%), 5, Len(cColOrder.List(I%))), ns) + nsflds
  780.              fs = fs + nsflds + ","
  781.         Else
  782.         
  783.              ns = InStr(1, cColOrder.List(I%), ".")
  784.              nsflds = Mid(cColOrder.List(I%), ns + 1, Len(cColOrder.List(I%)))
  785.              ntflds = Left(cColOrder.List(I%), ns - 1)
  786.              nt = InStr(1, ntflds, " ")
  787.              If nt > 0 Then
  788.             ntflds = "[" + ntflds + "]"
  789.             nsflds = ntflds + "." + "[" + nsflds + "]"
  790.              Else
  791.              nsflds = "[" + nsflds + "]"
  792.              nsflds = Left(cColOrder.List(I%), ns) + nsflds
  793.              End If
  794.              
  795.              fs = fs + nsflds + ","
  796.        End If
  797.        Next
  798.      If fs = "" Then
  799.        For I% = 0 To cTableList.ListCount - 1
  800.     If cTableList.Selected(I%) Then
  801.         If UCase(Left(cTableList.Selected(I%), 4)) = ".DBO" Then
  802.         fs = fs + Mid(cTableList.Selected(I%), 5, Len(cTableList.Selected(I%)))
  803.          Else
  804.         fs = fs + cTableList.List(I%) + ".*,"
  805.         End If
  806.      End If
  807.        Next
  808.        If fs = "" Then
  809.      fs = "*"
  810.        Else
  811.      fs = Mid(fs, 1, Len(fs) - 1)     'take off the last ","
  812.        End If
  813.      Else
  814.        fs = Mid(fs, 1, Len(fs) - 1)
  815.      End If
  816.      'get table names
  817.      For I% = 0 To cTableList.ListCount - 1
  818.        If cTableList.Selected(I%) Then
  819.         If UCase(Left(cTableList.List(I%), 4)) = "DBO." Then
  820.         ts = ts + Mid(cTableList.List(I%), 5, Len(cTableList.List(I%))) + ","
  821.          Else
  822.         ts = ts + cTableList.List(I%) + ","
  823.         End If
  824.        End If
  825.      Next
  826.      ts = Mid(ts, 1, Len(ts) - 1)
  827.      nt = InStr(1, ts, " ")
  828.      If nt > 0 Then
  829.      ts = "[" + ts + "]"
  830.      End If
  831.      gstDynaString = "Select " + fs + " From " + ts + StWhere$
  832.      gfFROMSQL = False ' not a SQL statement
  833. If Option1(0) = False Then
  834.      Dim dsform1 As New fDynaset
  835.      dsform1.Show
  836.        Else
  837.      Dim dsform2 As New fGridFrm
  838.      dsform2.Show
  839.        End If
  840.      GoTo OKEnd
  841. OKErr:
  842.   If Err = 364 Then Resume OKEnd   'catch unloaded form
  843.   ShowError
  844.   Resume OKEnd
  845. OKEnd:
  846.   MsgBar "", False
  847. End Sub
  848. Sub RunSaveQryButton_Click ()
  849. fStoreQry.Show 1
  850. If gstDynaString <> "" Then
  851. cCriteria.Text = gstDynaString
  852. MsgBar "Stored Query is Loaded", False
  853. Me.Tag = gstDynaString
  854. gStoredFlag = True
  855. End If
  856. End Sub
  857. Function stGetToken (stLn$, stDelim$) As String
  858.     On Error GoTo GetTokenError
  859.     iOpenQuote% = InStr(1, stLn$, """")
  860.     iDelim% = InStr(1, stLn$, stDelim$)
  861.     iBracket% = InStr(1, stLn$, "[")
  862.     If (iOpenQuote% > 0) And (iOpenQuote% < iDelim%) Then
  863.      iCloseQuote% = InStr(iOpenQuote% + 1, stLn$, """")
  864.      iDelim% = InStr(iCloseQuote% + 1, stLn$, stDelim$)
  865.     End If
  866.     If (iDelim% <> 0) And (iDelim% < iBracket%) Then
  867.      stToken$ = LTrim$(RTrim$(Mid$(stLn$, 1, iDelim% - 1)))
  868.      stLn$ = Mid$(stLn$, iDelim% + 1)
  869.     Else
  870.      stToken$ = LTrim$(RTrim$(Mid$(stLn$, 1)))
  871.      stLn$ = ""
  872.     End If
  873.     If (Len(stToken$) > 0) Then
  874.      If (Mid$(stToken$, 1, 1) = """") Then
  875.           stToken$ = Mid$(stToken$, 2)
  876.      End If
  877.      If (Mid$(stToken$, Len(stToken$), 1) = """") Then
  878.           stToken$ = Mid$(stToken$, 1, Len(stToken$) - 1)
  879.      End If
  880.     End If
  881.     stGetToken = stToken$
  882. GetTokenExit:
  883.     Exit Function
  884. GetTokenError:
  885.     Resume GetTokenExit
  886. End Function
  887. 'function to split the table and the field from a tbl.fld pair
  888. Function stSTF (tf As String, part As Integer) As String
  889.   If part = 0 Then
  890.     stSTF = Mid(tf, 1, InStr(1, tf, ".") - 1)
  891.   Else
  892.     stSTF = Mid(tf, InStr(1, tf, ".") + 1, Len(tf))
  893.   End If
  894. End Function
  895.