home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / SQL Query 20519632001.psc / frmMain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-12-15  |  36.2 KB  |  1,021 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
  4. Begin VB.Form frmMain 
  5.    Caption         =   "frmMain"
  6.    ClientHeight    =   8130
  7.    ClientLeft      =   5115
  8.    ClientTop       =   1860
  9.    ClientWidth     =   12225
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   0
  12.    ScaleWidth      =   0
  13.    Begin MSComDlg.CommonDialog cd 
  14.       Left            =   120
  15.       Top             =   7800
  16.       _ExtentX        =   847
  17.       _ExtentY        =   847
  18.       _Version        =   393216
  19.    End
  20.    Begin VB.CommandButton cmd 
  21.       Caption         =   "Print"
  22.       Height          =   375
  23.       Index           =   11
  24.       Left            =   1680
  25.       TabIndex        =   41
  26.       ToolTipText     =   "Print "
  27.       Top             =   7680
  28.       Width           =   855
  29.    End
  30.    Begin VB.CommandButton cmd 
  31.       Caption         =   "Assign"
  32.       Enabled         =   0   'False
  33.       Height          =   375
  34.       Index           =   10
  35.       Left            =   9360
  36.       TabIndex        =   37
  37.       ToolTipText     =   "Create Assign Statements for ALL Fields for selected Table"
  38.       Top             =   7680
  39.       Width           =   855
  40.    End
  41.    Begin VB.CommandButton cmd 
  42.       Caption         =   "Fields"
  43.       Enabled         =   0   'False
  44.       Height          =   375
  45.       Index           =   9
  46.       Left            =   10320
  47.       TabIndex        =   36
  48.       ToolTipText     =   "Show ALL Fields for selected Table"
  49.       Top             =   7680
  50.       Width           =   855
  51.    End
  52.    Begin VB.CommandButton cmd 
  53.       Caption         =   "Check"
  54.       Height          =   375
  55.       Index           =   8
  56.       Left            =   6480
  57.       TabIndex        =   35
  58.       ToolTipText     =   "Checks the Query and removes all rubish"
  59.       Top             =   7680
  60.       Width           =   855
  61.    End
  62.    Begin VB.CommandButton cmd 
  63.       Caption         =   "Paste"
  64.       Height          =   375
  65.       Index           =   7
  66.       Left            =   3600
  67.       TabIndex        =   34
  68.       ToolTipText     =   "Paste from Clipboard"
  69.       Top             =   7680
  70.       Width           =   855
  71.    End
  72.    Begin VB.CommandButton cmd 
  73.       Caption         =   "Help"
  74.       Height          =   375
  75.       Index           =   6
  76.       Left            =   720
  77.       TabIndex        =   33
  78.       ToolTipText     =   "Help"
  79.       Top             =   7680
  80.       Width           =   855
  81.    End
  82.    Begin VB.CommandButton cmd 
  83.       Caption         =   "Clean"
  84.       Height          =   375
  85.       Index           =   5
  86.       Left            =   2640
  87.       TabIndex        =   31
  88.       ToolTipText     =   "Cleans the Box"
  89.       Top             =   7680
  90.       Width           =   855
  91.    End
  92.    Begin VB.CommandButton cmd 
  93.       Caption         =   "Copy"
  94.       Height          =   375
  95.       Index           =   4
  96.       Left            =   4560
  97.       TabIndex        =   30
  98.       ToolTipText     =   "Copy to Clipboard"
  99.       Top             =   7680
  100.       Width           =   855
  101.    End
  102.    Begin VB.CommandButton cmd 
  103.       Caption         =   "Format"
  104.       Height          =   375
  105.       Index           =   3
  106.       Left            =   5520
  107.       TabIndex        =   29
  108.       ToolTipText     =   "Format SELECT Query"
  109.       Top             =   7680
  110.       Width           =   855
  111.    End
  112.    Begin VB.CommandButton cmd 
  113.       Caption         =   "Exit"
  114.       Height          =   375
  115.       Index           =   1
  116.       Left            =   11280
  117.       TabIndex        =   27
  118.       ToolTipText     =   "Exit the Application"
  119.       Top             =   7680
  120.       Width           =   855
  121.    End
  122.    Begin VB.CommandButton cmd 
  123.       Caption         =   "Connect"
  124.       Height          =   375
  125.       Index           =   2
  126.       Left            =   7440
  127.       TabIndex        =   23
  128.       ToolTipText     =   "Connect to Database"
  129.       Top             =   7680
  130.       Width           =   855
  131.    End
  132.    Begin VB.CommandButton cmd 
  133.       Caption         =   "Build SQL"
  134.       Enabled         =   0   'False
  135.       Height          =   375
  136.       Index           =   0
  137.       Left            =   8400
  138.       TabIndex        =   22
  139.       ToolTipText     =   "Build SQL Queries"
  140.       Top             =   7680
  141.       Width           =   855
  142.    End
  143.    Begin VB.Frame Frame2 
  144.       Caption         =   "Format"
  145.       Height          =   1380
  146.       Left            =   3000
  147.       TabIndex        =   7
  148.       Top             =   1200
  149.       Width           =   9135
  150.       Begin VB.CheckBox chkFormat 
  151.          Caption         =   "Check1"
  152.          Height          =   255
  153.          Index           =   5
  154.          Left            =   6360
  155.          TabIndex        =   43
  156.          ToolTipText     =   "Add Constant Prefix"
  157.          Top             =   960
  158.          Width           =   255
  159.       End
  160.       Begin VB.TextBox txtFormat 
  161.          Height          =   285
  162.          Index           =   5
  163.          Left            =   6600
  164.          TabIndex        =   42
  165.          Text            =   "txtFormat"
  166.          Top             =   960
  167.          Width           =   1455
  168.       End
  169.       Begin VB.TextBox txtFormat 
  170.          Height          =   285
  171.          Index           =   4
  172.          Left            =   2400
  173.          TabIndex        =   39
  174.          Text            =   "txtFormat"
  175.          Top             =   960
  176.          Width           =   2055
  177.       End
  178.       Begin VB.CheckBox chkFormat 
  179.          Caption         =   "Check1"
  180.          Height          =   255
  181.          Index           =   4
  182.          Left            =   2160
  183.          TabIndex        =   38
  184.          ToolTipText     =   "Use defined Recordset Name"
  185.          Top             =   960
  186.          Width           =   255
  187.       End
  188.       Begin VB.CheckBox chkType 
  189.          Caption         =   "Dim"
  190.          Height          =   255
  191.          Index           =   3
  192.          Left            =   8160
  193.          TabIndex        =   28
  194.          ToolTipText     =   "Include Dim Part"
  195.          Top             =   240
  196.          Value           =   1  'Checked
  197.          Width           =   855
  198.       End
  199.       Begin VB.CheckBox chkFormat 
  200.          Caption         =   "Check1"
  201.          Height          =   255
  202.          Index           =   3
  203.          Left            =   6360
  204.          TabIndex        =   26
  205.          ToolTipText     =   "Add Defined number of Spaces"
  206.          Top             =   600
  207.          Width           =   255
  208.       End
  209.       Begin VB.CheckBox chkType 
  210.          Caption         =   "Update"
  211.          Height          =   255
  212.          Index           =   2
  213.          Left            =   8160
  214.          TabIndex        =   21
  215.          ToolTipText     =   "Include Update Statement"
  216.          Top             =   960
  217.          Value           =   1  'Checked
  218.          Width           =   855
  219.       End
  220.       Begin VB.CheckBox chkType 
  221.          Caption         =   "Delete"
  222.          Height          =   255
  223.          Index           =   1
  224.          Left            =   8160
  225.          TabIndex        =   20
  226.          ToolTipText     =   "Include Delete Statement"
  227.          Top             =   720
  228.          Value           =   1  'Checked
  229.          Width           =   855
  230.       End
  231.       Begin VB.CheckBox chkType 
  232.          Caption         =   "Insert"
  233.          Height          =   255
  234.          Index           =   0
  235.          Left            =   8160
  236.          TabIndex        =   19
  237.          ToolTipText     =   "Include Insert Statement"
  238.          Top             =   480
  239.          Value           =   1  'Checked
  240.          Width           =   855
  241.       End
  242.       Begin VB.TextBox txtFormat 
  243.          Height          =   285
  244.          Index           =   3
  245.          Left            =   6600
  246.          TabIndex        =   18
  247.          Text            =   "txtFormat"
  248.          Top             =   600
  249.          Width           =   975
  250.       End
  251.       Begin VB.CheckBox chkFormat 
  252.          Caption         =   "Check1"
  253.          Height          =   255
  254.          Index           =   2
  255.          Left            =   6360
  256.          TabIndex        =   16
  257.          ToolTipText     =   "User Text Box Name"
  258.          Top             =   240
  259.          Width           =   255
  260.       End
  261.       Begin VB.CheckBox chkFormat 
  262.          Caption         =   "Check1"
  263.          Height          =   255
  264.          Index           =   1
  265.          Left            =   2160
  266.          TabIndex        =   15
  267.          ToolTipText     =   "Use defined SQL String Check Function"
  268.          Top             =   600
  269.          Width           =   255
  270.       End
  271.       Begin VB.CheckBox chkFormat 
  272.          Caption         =   "Check1"
  273.          Height          =   255
  274.          Index           =   0
  275.          Left            =   2160
  276.          TabIndex        =   14
  277.          ToolTipText     =   "Use String Variable Name"
  278.          Top             =   240
  279.          Width           =   255
  280.       End
  281.       Begin VB.TextBox txtFormat 
  282.          Height          =   285
  283.          Index           =   2
  284.          Left            =   6600
  285.          TabIndex        =   13
  286.          Text            =   "txtFormat"
  287.          Top             =   240
  288.          Width           =   1455
  289.       End
  290.       Begin VB.TextBox txtFormat 
  291.          Height          =   285
  292.          Index           =   1
  293.          Left            =   2400
  294.          TabIndex        =   11
  295.          Text            =   "txtFormat"
  296.          Top             =   600
  297.          Width           =   2055
  298.       End
  299.       Begin VB.TextBox txtFormat 
  300.          Height          =   285
  301.          Index           =   0
  302.          Left            =   2400
  303.          TabIndex        =   10
  304.          Text            =   "txtFormat"
  305.          Top             =   240
  306.          Width           =   2055
  307.       End
  308.       Begin VB.Label Label2 
  309.          Caption         =   "Constant Prefix :"
  310.          Height          =   255
  311.          Index           =   6
  312.          Left            =   4920
  313.          TabIndex        =   44
  314.          Top             =   960
  315.          Width           =   1695
  316.       End
  317.       Begin VB.Label Label2 
  318.          Caption         =   "Recordset Name :"
  319.          Height          =   255
  320.          Index           =   5
  321.          Left            =   120
  322.          TabIndex        =   40
  323.          Top             =   960
  324.          Width           =   2175
  325.       End
  326.       Begin VB.Label Label2 
  327.          Caption         =   "Number of Spaces :"
  328.          Height          =   255
  329.          Index           =   3
  330.          Left            =   4920
  331.          TabIndex        =   17
  332.          Top             =   600
  333.          Width           =   1455
  334.       End
  335.       Begin VB.Label Label2 
  336.          Caption         =   "Text Box Name :"
  337.          Height          =   255
  338.          Index           =   2
  339.          Left            =   4920
  340.          TabIndex        =   12
  341.          Top             =   240
  342.          Width           =   1335
  343.       End
  344.       Begin VB.Label Label2 
  345.          Caption         =   "SQL String Check Function :"
  346.          Height          =   255
  347.          Index           =   1
  348.          Left            =   120
  349.          TabIndex        =   9
  350.          Top             =   600
  351.          Width           =   2175
  352.       End
  353.       Begin VB.Label Label2 
  354.          Caption         =   "String Variable Name :"
  355.          Height          =   255
  356.          Index           =   0
  357.          Left            =   120
  358.          TabIndex        =   8
  359.          Top             =   240
  360.          Width           =   1695
  361.       End
  362.    End
  363.    Begin VB.Frame Frame1 
  364.       Caption         =   "Database Settings"
  365.       Height          =   1095
  366.       Left            =   120
  367.       TabIndex        =   2
  368.       Top             =   120
  369.       Width           =   12015
  370.       Begin VB.CheckBox chkContinue 
  371.          Caption         =   "Use Continuation"
  372.          Height          =   255
  373.          Left            =   8760
  374.          TabIndex        =   46
  375.          Top             =   360
  376.          Width           =   1575
  377.       End
  378.       Begin VB.CheckBox chkPartial 
  379.          Caption         =   "Partial Format"
  380.          Height          =   255
  381.          Left            =   10560
  382.          TabIndex        =   45
  383.          Top             =   360
  384.          Width           =   1335
  385.       End
  386.       Begin VB.CommandButton cmdCall 
  387.          Caption         =   "..."
  388.          Height          =   300
  389.          Left            =   11520
  390.          TabIndex        =   32
  391.          ToolTipText     =   "Build Connect Statement"
  392.          Top             =   720
  393.          Width           =   375
  394.       End
  395.       Begin VB.TextBox txtDBName 
  396.          Height          =   285
  397.          Left            =   6960
  398.          TabIndex        =   25
  399.          Text            =   "txtDBName"
  400.          Top             =   360
  401.          Width           =   1335
  402.       End
  403.       Begin VB.TextBox txtDB 
  404.          Height          =   285
  405.          Left            =   1560
  406.          TabIndex        =   6
  407.          Text            =   "txtDB"
  408.          Top             =   720
  409.          Width           =   9975
  410.       End
  411.       Begin VB.ComboBox cboDB 
  412.          Height          =   315
  413.          Left            =   1560
  414.          TabIndex        =   4
  415.          Text            =   "cboDB"
  416.          Top             =   360
  417.          Width           =   3495
  418.       End
  419.       Begin VB.Label Label2 
  420.          Caption         =   "DB Variable Name :"
  421.          Height          =   255
  422.          Index           =   4
  423.          Left            =   5400
  424.          TabIndex        =   24
  425.          Top             =   360
  426.          Width           =   1455
  427.       End
  428.       Begin VB.Label Label1 
  429.          Caption         =   "Connection String :"
  430.          Height          =   255
  431.          Index           =   1
  432.          Left            =   120
  433.          TabIndex        =   5
  434.          Top             =   720
  435.          Width           =   1455
  436.       End
  437.       Begin VB.Label Label1 
  438.          Caption         =   "Database Name :"
  439.          Height          =   255
  440.          Index           =   0
  441.          Left            =   120
  442.          TabIndex        =   3
  443.          Top             =   360
  444.          Width           =   1335
  445.       End
  446.    End
  447.    Begin RichTextLib.RichTextBox rtb 
  448.       Height          =   4965
  449.       Left            =   3000
  450.       TabIndex        =   1
  451.       Top             =   2640
  452.       Width           =   9135
  453.       _ExtentX        =   16113
  454.       _ExtentY        =   8758
  455.       _Version        =   393217
  456.       ScrollBars      =   3
  457.       TextRTF         =   $"frmMain.frx":0000
  458.    End
  459.    Begin VB.ListBox lstTables 
  460.       Height          =   6300
  461.       Left            =   120
  462.       TabIndex        =   0
  463.       Top             =   1320
  464.       Width           =   2775
  465.    End
  466. Attribute VB_Name = "frmMain"
  467. Attribute VB_GlobalNameSpace = False
  468. Attribute VB_Creatable = False
  469. Attribute VB_PredeclaredId = True
  470. Attribute VB_Exposed = False
  471. Option Explicit
  472. Private msTableName As String
  473. Private Const miC_INSERT As Integer = 0
  474. Private Const miC_DELETE As Integer = 1
  475. Private Const miC_UPDATE As Integer = 2
  476. Private Const miC_DIM As Integer = 3
  477. Private Const miT_STRING_VAR    As Integer = 0
  478. Private Const miT_SQL_CHECK     As Integer = 1
  479. Private Const miT_TEXT_BOX      As Integer = 2
  480. Private Const miT_SPACES        As Integer = 3
  481. Private Const miT_RECORDSET     As Integer = 4
  482. Private Const miT_PREFIX        As Integer = 5
  483. Private msDBName(15) As String
  484. Private msDBConnect(15) As String
  485. Private miDBNameNum As Integer
  486. Private Sub cboDB_Click()
  487. If gbErrorHandSwitch Then On Error GoTo ErrHandler
  488.     Dim i As Integer
  489.     For i = 0 To 15
  490.         If cboDB = msDBName(i) Then
  491.             miDBNameNum = i
  492.             txtDB = msDBConnect(i)
  493.             Call SaveSetting("SQLS", "Settings", "DBNum", i)
  494.             cmd(2) = True
  495.             Exit Sub
  496.         End If
  497.     Next i
  498. ErrExit:      Exit Sub
  499. ErrHandler:   Call ErrorHandler(Name, 0, "cboDB_Click")
  500. End Sub
  501. Private Sub cmd_Click(Index As Integer)
  502. If gbErrorHandSwitch Then On Error GoTo ErrHandler
  503.     Dim i As Integer
  504.     Dim rstTables As ADODB.Recordset
  505.     Dim rstCols As ADODB.Recordset
  506.     Dim sSql As String, sData As String, sDecl As String
  507.     Dim sLeft As String, s As String
  508.     Dim sView As String, sFunc1(3) As String, sFunc2(3) As String
  509.     Dim iDType As Integer
  510.     Const iB_BUILD = 0
  511.     Const iB_EXIT = 1
  512.     Const iB_CONNECT = 2
  513.     Const iB_FORMAT = 3
  514.     Const iB_COPY = 4
  515.     Const iB_CLEAN = 5
  516.     Const iB_HELP = 6
  517.     Const iB_PASTE = 7
  518.     Const iB_CHECK = 8
  519.     Const iB_FIELDS = 9
  520.     Const iB_ASSIGN = 10
  521.     Const iB_PRINT = 11
  522.     Const i_TEXT = 0
  523.     Const i_DATE = 1
  524.     Const i_NUMERIC = 2
  525.     Const i_ELSE = 3
  526.     Select Case Index
  527.     Case iB_CLEAN:      rtb.Text = ""
  528.     Case iB_HELP:       frmHelp.Show
  529.     Case iB_PRINT
  530.         cd.Flags = cdlPDReturnDC + cdlPDNoPageNums
  531.         If rtb.SelLength = 0 Then
  532.            cd.Flags = cd.Flags + cdlPDAllPages
  533.         Else
  534.            cd.Flags = cd.Flags + cdlPDSelection
  535.         End If
  536.         cd.ShowPrinter
  537.         rtb.SelPrint cd.hDC
  538.         
  539.     Case iB_ASSIGN
  540.         MousePointer = vbHourglass
  541.         
  542.         
  543.         If msTableName = "" Then
  544.             MsgBox "Please select Table and try again."
  545.             MousePointer = vbDefault
  546.             Exit Sub
  547.         End If
  548.         
  549.         rtb.Text = ""
  550.         sView = ""
  551.         Set rstCols = gdbSQLQ.OpenSchema(adSchemaColumns)
  552.         
  553.         sSql = "' == " & UCase(msTableName) & " == " & vbCrLf & vbCrLf
  554.         sSql = sSql & "sSql = ""select * from " & UCase(msTableName) & "  where """ & vbCrLf
  555.         sSql = sSql & "Set R_S_T = SQLOpenrecordsetADO(" & txtDBName & ",sSql)" & vbCrLf & vbCrLf
  556.         
  557.         Do Until rstCols.EOF
  558.             If rstCols.Fields(2) = msTableName Then
  559.                 sSql = sSql & "T_X_T(m_i_T_" & UCase(rstCols.Fields(3)) & ")  = R_S_T!" & rstCols.Fields(3) & vbCrLf
  560.             End If
  561.             rstCols.MoveNext
  562.         Loop
  563.         sView = sSql
  564.         
  565.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "sSql = ", Space(Val(txtFormat(miT_SPACES))) & " sSql = ")
  566.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "T_X_T", Space(Val(txtFormat(miT_SPACES))) & " T_X_T")
  567.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "Set R_S_T = ", Space(Val(txtFormat(miT_SPACES))) & " Set R_S_T = ")
  568.         If chkFormat(miT_TEXT_BOX) Then sView = Replace(sView, "T_X_T", txtFormat(miT_TEXT_BOX))
  569.         If chkFormat(miT_RECORDSET) Then sView = Replace(sView, "R_S_T", txtFormat(miT_RECORDSET))
  570.         If chkFormat(miT_PREFIX) Then sView = Replace(sView, "m_i_T_", txtFormat(miT_PREFIX))
  571.         If chkFormat(miT_STRING_VAR) Then sView = Replace(sView, "sSql", txtFormat(miT_STRING_VAR))
  572.         
  573.         rtb.Text = sView
  574.         
  575.     Case iB_FIELDS
  576.         MousePointer = vbHourglass
  577.         
  578.         
  579.         If msTableName = "" Then
  580.             MsgBox "Please select Table and try again."
  581.             MousePointer = vbDefault
  582.             Exit Sub
  583.         End If
  584.         
  585.         rtb.Text = ""
  586.         sView = ""
  587.         Set rstCols = gdbSQLQ.OpenSchema(adSchemaColumns)
  588.         
  589.         sSql = " == " & UCase(msTableName) & " == " & vbCrLf & vbCrLf
  590.         
  591.         Do Until rstCols.EOF
  592.             If rstCols.Fields(2) = msTableName Then
  593.                 sSql = sSql & rstCols.Fields(3) & vbCrLf
  594.             End If
  595.             rstCols.MoveNext
  596.         Loop
  597.         
  598.         sView = sSql
  599.         
  600.         rtb.Text = sSql
  601.     Case iB_EXIT:
  602.         Unload Me
  603.         End
  604.         
  605.     Case iB_COPY:
  606.         With rtb
  607.             .SetFocus
  608.             .SelStart = 0
  609.             .SelLength = Len(.Text)
  610.             Clipboard.SetText (.SelText)
  611.         End With
  612.     Case iB_PASTE:
  613.         rtb.Text = Clipboard.GetText
  614.         
  615.     Case iB_CHECK:
  616.         sView = rtb.Text
  617.         
  618.         If InStr(LCase(sView), "select ") = 0 Then
  619.             MsgBox "It's not Select Query. Put the right one in and try again."
  620.             Exit Sub
  621.         End If
  622.         
  623.         sView = Replace(sView, Chr(13), "")
  624.         sView = Replace(sView, Chr(10), "")
  625.         sView = Replace(sView, "dbo.", "")
  626.         sView = Replace(sView, "from ", " FROM ")
  627.         sView = Replace(sView, "From ", " FROM ")
  628.         sView = Replace(sView, "FROM ", " FROM ")
  629.         
  630.         rtb.Text = sView
  631.         Clipboard.SetText sView
  632.     Case iB_FORMAT:
  633.         sView = rtb.Text
  634.         
  635.         If InStr(LCase(sView), "select ") = 0 Then
  636.             MsgBox "It's not Select Query. Put the right one in and try again."
  637.             Exit Sub
  638.         End If
  639.         
  640.         sView = Replace(sView, Chr(13), "")
  641.         sView = Replace(sView, Chr(10), "")
  642.         sView = Replace(sView, "dbo.", "")
  643.         sView = Replace(sView, "sSql = sSql & ", "")
  644.         sView = Replace(sView, "sSql = ", "")
  645.         If chkFormat(miT_STRING_VAR) Then sView = Replace(sView, txtFormat(miT_STRING_VAR) & " = " & txtFormat(miT_STRING_VAR) & " & ", "")
  646.         If chkFormat(miT_STRING_VAR) Then sView = Replace(sView, txtFormat(miT_STRING_VAR) & " = ", "")
  647.         
  648.         sView = SQLFormat(sView)
  649.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "sSql = ", Space(Val(txtFormat(miT_SPACES))) & "sSql = ")
  650.         If chkContinue <> 0 And chkFormat(miT_SPACES) Then sView = Replace(sView, "& """, Space(Val(txtFormat(miT_SPACES))) & "& """)
  651.         sSql = ""
  652.         sSql = sSql & sView
  653.         
  654.         If chkFormat(miT_STRING_VAR) Then sView = Replace(sView, "sSql", txtFormat(miT_STRING_VAR))
  655.         
  656.         rtb.Text = sView
  657.         Clipboard.SetText sView
  658.         
  659.     Case iB_BUILD
  660.         MousePointer = vbHourglass
  661.         
  662.         
  663.         If msTableName = "" Then
  664.             MsgBox "Please select Table and try again."
  665.             MousePointer = vbDefault
  666.             Exit Sub
  667.         End If
  668.         
  669.         rtb.Text = ""
  670.         sView = ""
  671.         Set rstCols = gdbSQLQ.OpenSchema(adSchemaColumns)
  672.         i = 0
  673.         
  674.         sFunc2(i_TEXT) = ")"
  675.         sFunc2(i_DATE) = ")"
  676.         sFunc2(i_NUMERIC) = ")"
  677.         sFunc2(i_ELSE) = ""
  678.         
  679.         If miT_SQL_CHECK Then
  680.             sFunc1(i_TEXT) = txtFormat(miT_SQL_CHECK) & "("
  681.         Else
  682.             sFunc1(i_TEXT) = "SQLCheck("
  683.         End If
  684.         sFunc1(i_DATE) = "AMDateTime("
  685.         sFunc1(i_NUMERIC) = "Val("
  686.         sFunc1(i_ELSE) = ""
  687.         
  688.         ' Creates Insert
  689.             sDecl = ""
  690.             sData = ""
  691.             sSql = vbCrLf
  692.             sSql = sSql & "' INSERT STATEMENT"
  693.             sSql = sSql & vbCrLf
  694.             sSql = sSql & "sSql = ""insert into " & msTableName & " (""" & vbCrLf
  695.             
  696.             Do Until rstCols.EOF
  697.                 If rstCols.Fields(2) = msTableName Then
  698.                     sDecl = sDecl & "Private const m_i_T_" & UCase(rstCols.Fields(3)) & " = " & CStr(i) & vbCrLf
  699.                     sSql = sSql & "sSql = sSql & """ & rstCols.Fields(3) & ",""" & vbCrLf
  700.                     iDType = DBDataType(rstCols.Fields(11))
  701.                     sData = sData & "sSql = sSql & " & sFunc1(iDType) & "T_X_T(m_i_T_" & UCase(rstCols.Fields(3)) & ")" & sFunc2(iDType) & " & "",""" & vbCrLf
  702.                     i = i + 1
  703.                 End If
  704.                                                             
  705.                 rstCols.MoveNext
  706.             Loop
  707.             i = InStrRev(sSql, ",", Len(sSql))
  708.             If i > 0 Then
  709.                 sSql = Mid(sSql, 1, i - 1) & """" & vbCrLf
  710.                 sSql = sSql & "sSql = sSql  & "") values(""" & vbCrLf
  711.             End If
  712.             If Trim(sData) <> "" Then
  713.                 i = InStrRev(sData, ",", Len(sData))
  714.                 If i > 0 Then
  715.                     sData = Mid(sData, 1, i - 1) & """" & vbCrLf
  716.                     sData = sData & "sSql = sSql  & "")""" & vbCrLf
  717.                 End If
  718.             End If
  719.             
  720.             sData = sData & vbCrLf
  721.             
  722.             sData = sData & "Call SQLExecute(gdb,sSql)" & vbCrLf
  723.             
  724.             If chkType(miC_DIM) Then sView = sView & sDecl & vbCrLf & vbCrLf
  725.             If chkType(miC_INSERT) Then sView = sView & sSql & sData
  726.             
  727.             rstCols.MoveFirst
  728.         '==================================
  729.         
  730.         ' Include Delete Statement
  731.             sDecl = ""
  732.             sData = ""
  733.             sSql = vbCrLf
  734.             sSql = sSql & "' DELETE STATEMENT"
  735.             sSql = sSql & vbCrLf
  736.             
  737.             sSql = sSql & "sSql = ""delete from " & msTableName & " where """ & vbCrLf
  738.             sSql = sSql & vbCrLf
  739.             sSql = sSql & "Call SQLExecute(gdb,sSql)" & vbCrLf
  740.             
  741.             If chkType(miC_DELETE) Then sView = sView & sSql
  742.         '==================================
  743.         
  744.         ' Include Update Statement
  745.             sSql = vbCrLf
  746.             sSql = sSql & "' UPDATE STATEMENT"
  747.             sSql = sSql & vbCrLf
  748.             
  749.             
  750.             sSql = sSql & "sSql = ""update " & msTableName & " set """ & vbCrLf
  751.             
  752.             Do Until rstCols.EOF
  753.                 If rstCols.Fields(2) = msTableName Then
  754.                     iDType = DBDataType(rstCols.Fields(11))
  755.                     sSql = sSql & "sSql = sSql & """ & rstCols.Fields(3) & " = " & """ & " & sFunc1(iDType) & "T_X_T(m_i_T_" & UCase(rstCols.Fields(3)) & ")" & sFunc2(iDType) & " & "",""" & vbCrLf
  756.                     i = i + 1
  757.                 End If
  758.                                                             
  759.                 rstCols.MoveNext
  760.             Loop
  761.             i = InStrRev(sSql, ",", Len(sSql))
  762.             If i > 0 Then
  763.                 sSql = Mid(sSql, 1, i - 1) & """" & vbCrLf
  764.                 sSql = sSql & "sSql = sSql  & "" where """ & vbCrLf
  765.                 sSql = sSql & vbCrLf
  766.                 sSql = sSql & "Call SQLExecute(gdb,sSql)" & vbCrLf
  767.             End If
  768.             
  769.             If chkType(miC_UPDATE) Then sView = sView & sSql
  770.         '==================================
  771.         
  772.         rstCols.Close
  773.         
  774.         ' Format
  775.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "' DELETE", Space(Val(txtFormat(miT_SPACES))) & "' DELETE")
  776.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "' INSERT", Space(Val(txtFormat(miT_SPACES))) & "' INSERT")
  777.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "' UPDATE", Space(Val(txtFormat(miT_SPACES))) & "' UPDATE")
  778.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "Call ", Space(Val(txtFormat(miT_SPACES))) & "Call ")
  779.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "Private const ", Space(Val(txtFormat(miT_SPACES))) & "Private const ")
  780.         If chkFormat(miT_SPACES) Then sView = Replace(sView, "sSql = ", Space(Val(txtFormat(miT_SPACES))) & "sSql = ")
  781.         
  782.         sView = Replace(sView, "Call SQLExecute(gdb", "Call SQLExecute(" & txtDBName)
  783.         If chkFormat(miT_STRING_VAR) Then sView = Replace(sView, "sSql", txtFormat(miT_STRING_VAR))
  784.         If chkFormat(miT_SQL_CHECK) Then sView = Replace(sView, "sSql", txtFormat(miT_STRING_VAR))
  785.         If chkFormat(miT_TEXT_BOX) Then sView = Replace(sView, "T_X_T", txtFormat(miT_TEXT_BOX))
  786.         If chkFormat(miT_PREFIX) Then sView = Replace(sView, "m_i_T_", txtFormat(miT_PREFIX))
  787.         
  788.         ' Copy to Clipboard
  789.         Clipboard.SetText sView
  790.         
  791.         ' Display
  792.         rtb.Text = sView
  793.         
  794.         MousePointer = vbDefault
  795.     Case iB_CONNECT
  796.         If txtDB = "" Then
  797.             MsgBox "Please create and save Connection String"
  798.             Exit Sub
  799.         Else
  800.             gsDBConnection = txtDB
  801.         End If
  802.         
  803.         i = 0
  804. NewOpen:
  805.         If gdbSQLQ.State <> adStateOpen Then
  806.            gdbSQLQ.CommandTimeout = 60
  807.            gdbSQLQ.Open gsDBConnection
  808.         Else
  809.             gdbSQLQ.Close
  810.             i = i + 1
  811.             If i > 2 Then
  812.                 MsgBox "Can not connect to Database"
  813.                 Exit Sub
  814.             Else
  815.                 GoTo NewOpen
  816.             End If
  817.             
  818.         End If
  819.         lstTables.Clear
  820.         
  821.         Set rstTables = gdbSQLQ.OpenSchema(adSchemaTables)
  822.         Do Until rstTables.EOF
  823.             If rstTables.Fields(3) = "TABLE" Then
  824.                 lstTables.AddItem rstTables.Fields(2)
  825.             End If
  826.             i = i + 1
  827.             rstTables.MoveNext
  828.         Loop
  829.         
  830.         rstTables.Close
  831.         cmd(iB_BUILD).Enabled = True
  832.         cmd(iB_ASSIGN).Enabled = True
  833.         cmd(iB_FIELDS).Enabled = True
  834.         
  835.     End Select
  836.     MousePointer = vbDefault
  837. ErrExit:      Exit Sub
  838. ErrHandler:   Call ErrorHandler(Name, 0, "cmd_Click")
  839. End Sub
  840. Private Sub cmdCall_Click()
  841.     frmDBConnection.Show
  842. End Sub
  843. Private Sub Edit_Click()
  844. End Sub
  845. Private Sub Exit_Click()
  846. End Sub
  847. Private Sub Form_Load()
  848. If gbErrorHandSwitch Then On Error GoTo ErrHandler
  849.     Dim i As Integer
  850.     LoadFormSettings Me
  851.     Caption = "QUERY BUILDER " & SystemVersion
  852.     miDBNameNum = GetSetting("SQLS", "Settings", "DBNum", 0)
  853.     cboDB.Clear
  854.     For i = 0 To 15
  855.         msDBName(i) = GetSetting("SQLS", "Settings", "DBName_" & CStr(i), "")
  856.         msDBConnect(i) = GetSetting("SQLS", "Settings", "DBConnect_" & CStr(i), "")
  857.         cboDB.AddItem msDBName(i), i
  858.         If i = miDBNameNum Then
  859.             cboDB = msDBName(i)
  860.             txtDB = msDBConnect(i)
  861.         End If
  862.     Next i
  863.     For i = 0 To miDBNameNum - 1
  864.         msDBName(i) = GetSetting("SQLS", "Settings", "DBName_" & CStr(i), "")
  865.         cboDB.AddItem msDBName(i), i
  866.     Next i
  867. '    txtDB = GetSetting("SQLS", "Settings", "ConnectionString", "Provider=SQLOLEDB.1;Password=tripled;Persist Security Info=True;User ID=sa;Initial Catalog=IMS_BENGALLA;Data Source=W2KIMSTEST")
  868.     txtDBName = GetSetting("SQLS", "Settings", "DBName", "gdb")
  869.     txtFormat(miT_STRING_VAR) = GetSetting("SQLS", "Settings", "sSql", "sSql")
  870.     txtFormat(miT_SQL_CHECK) = GetSetting("SQLS", "Settings", "SQLCheck", "SQLCheck")
  871.     txtFormat(miT_TEXT_BOX) = GetSetting("SQLS", "Settings", "txtBOX", "txtBOX")
  872.     txtFormat(miT_SPACES) = GetSetting("SQLS", "Settings", "Spaces", "4")
  873.     txtFormat(miT_RECORDSET) = GetSetting("SQLS", "Settings", "Recordset", "rst")
  874.     txtFormat(miT_PREFIX) = GetSetting("SQLS", "Settings", "Prefix", "miT_")
  875.     chkFormat(miT_STRING_VAR).Value = 1
  876.     chkFormat(miT_SQL_CHECK).Value = 1
  877.     chkFormat(miT_TEXT_BOX).Value = 1
  878.     chkFormat(miT_SPACES).Value = 1
  879.     chkFormat(miT_RECORDSET).Value = 1
  880.     chkFormat(miT_PREFIX).Value = 1
  881.     chkType(miC_INSERT).Value = 1
  882.     chkType(miC_DELETE).Value = 1
  883.     chkType(miC_UPDATE).Value = 1
  884.     chkType(miC_DIM).Value = 1
  885.     rtb.Text = ""
  886. ErrExit:      Exit Sub
  887. ErrHandler:   Call ErrorHandler(Name, 0, "Form_Load")
  888. End Sub
  889. Private Sub Form_Unload(Cancel As Integer)
  890. If gbErrorHandSwitch Then On Error GoTo ErrHandler
  891.     SaveFormSettings Me
  892.     SaveSetup
  893.     UnloadAllForms
  894.     End
  895. ErrExit:      Exit Sub
  896. ErrHandler:   Call ErrorHandler(Name, 0, "Form_Unload")
  897. End Sub
  898. Private Sub SaveSetup()
  899. If gbErrorHandSwitch Then On Error GoTo ErrHandler
  900.     Dim i As Integer, iEmpty As Integer
  901.     Call SaveSetting("SQLS", "Settings", "ConncetionString", txtDB)
  902.     Call SaveSetting("SQLS", "Settings", "DBName", txtDBName)
  903.     Call SaveSetting("SQLS", "Settings", "sSql", txtFormat(miT_STRING_VAR))
  904.     Call SaveSetting("SQLS", "Settings", "SQLCheck", txtFormat(miT_SQL_CHECK))
  905.     Call SaveSetting("SQLS", "Settings", "txtBOX", txtFormat(miT_TEXT_BOX))
  906.     Call SaveSetting("SQLS", "Settings", "Spaces", txtFormat(miT_SPACES))
  907.     Call SaveSetting("SQLS", "Settings", "Recordset", txtFormat(miT_RECORDSET))
  908.     Call SaveSetting("SQLS", "Settings", "Prefix", txtFormat(miT_PREFIX))
  909.     iEmpty = -1
  910.     For i = 0 To 15
  911.         If cboDB = msDBName(i) Then
  912.             miDBNameNum = i
  913.             Call SaveSetting("SQLS", "Settings", "DBNum", i)
  914.             Exit Sub
  915.         End If
  916.         If msDBName(i) = "" And iEmpty = -1 Then iEmpty = i
  917.     Next i
  918.         
  919.     For i = 15 To 1 Step -1
  920.         msDBName(i) = msDBName(i - 1)
  921.         msDBConnect(i) = msDBConnect(i - 1)
  922.         Call SaveSetting("SQLS", "Settings", "DBName_" & CStr(i), msDBName(i))
  923.         Call SaveSetting("SQLS", "Settings", "DBConnect_" & CStr(i), msDBConnect(i))
  924.     Next i
  925.     i = 0
  926.     msDBName(i) = cboDB
  927.     msDBConnect(i) = txtDB
  928.     Call SaveSetting("SQLS", "Settings", "DBName_" & CStr(i), msDBName(i))
  929.     Call SaveSetting("SQLS", "Settings", "DBConnect_" & CStr(i), msDBConnect(i))
  930.     Call SaveSetting("SQLS", "Settings", "DBNum", i)
  931. ErrExit:      Exit Sub
  932. ErrHandler:   Call ErrorHandler(Name, 0, "SaveSetup")
  933. End Sub
  934. Private Sub lstTables_Click()
  935. If gbErrorHandSwitch Then On Error GoTo ErrHandler
  936.     msTableName = lstTables.Text
  937. ErrExit:      Exit Sub
  938. ErrHandler:   Call ErrorHandler(Name, 0, "lstTables_Click")
  939. End Sub
  940. Private Function SQLFormat(sSql As String) As String
  941. If gbErrorHandSwitch Then On Error GoTo ErrHandler
  942.     Dim s As String, i As Integer
  943.     Dim iStart As Integer, iEnd As Integer
  944.     s = sSql
  945.     s = Replace(s, " _" & vbCrLf, "")
  946.     s = Replace(s, "_ ", "")
  947.     s = Replace(s, vbCrLf, "")
  948.     s = Replace(s, "& """, "")
  949.     s = Replace(s, """ &", "")
  950.     s = Replace(s, "_ &", "")
  951.     s = Replace(s, """", "")
  952.     s = Replace(s, "Select ", " SELECT ")
  953.     s = Replace(s, "select ", " SELECT ")
  954.     s = Replace(s, Chr(32), " ")
  955.     s = Replace(s, " On ", " ON ")
  956.     s = Replace(s, " on ", " ON ")
  957.     s = Replace(s, " Inner ", " INNER ")
  958.     s = Replace(s, " inner ", " INNER ")
  959.     s = Replace(s, " Join", " JOIN ")
  960.     s = Replace(s, " join", " JOIN ")
  961.     s = Replace(s, " left ", " LEFT ")
  962.     s = Replace(s, " left ", " LEFT ")
  963.     s = Replace(s, " Outer ", " OUTER ")
  964.     s = Replace(s, " outer ", " OUTER ")
  965.     s = Replace(s, " Right ", " RIGHT ")
  966.     s = Replace(s, " right ", " RIGHT ")
  967.     s = Replace(s, " Union ", " UNION ")
  968.     s = Replace(s, " union ", " UNION ")
  969.     s = Replace(s, " From ", " FROM ")
  970.     s = Replace(s, " from ", " FROM ")
  971.     s = Replace(s, " Where ", " WHERE ")
  972.     s = Replace(s, " where ", " WHERE ")
  973.     s = Replace(s, " Order ", " ORDER ")
  974.     s = Replace(s, " order ", " ORDER ")
  975.     s = Replace(s, " Group ", " GROUP ")
  976.     s = Replace(s, " group ", " GROUP ")
  977.     s = Replace(s, " By ", " BY ")
  978.     s = Replace(s, " by ", " BY ")
  979.     s = Replace(s, " Or ", " OR ")
  980.     s = Replace(s, " or ", " OR ")
  981.     s = Replace(s, " And ", " AND ")
  982.     s = Replace(s, " and ", " AND ")
  983.     For i = 1 To 20
  984.         s = Replace(s, Space(2), Space(1))
  985.     Next
  986.     If chkPartial = 0 Then
  987.         s = Replace(s, "SELECT ", vbCrLf & " SELECT ")
  988.         s = Replace(s, Chr(32), " ")
  989.         s = Replace(s, " ON ", vbCrLf & " ON ")
  990.     '    s = Replace(s, "on ", vbCrLf & "ON ")
  991.         s = Replace(s, " INNER ", vbCrLf & " INNER ")
  992. '        s = Replace(s, " JOIN ", vbCrLf & " JOIN ")
  993.         s = Replace(s, " LEFT ", vbCrLf & " LEFT ")
  994. '        s = Replace(s, " OUTER ", vbCrLf & " OUTER ")
  995.         s = Replace(s, " RIGHT ", vbCrLf & " RIGHT ")
  996.         s = Replace(s, " UNION  ", vbCrLf & " UNION ")
  997.         s = Replace(s, " FROM ", vbCrLf & " FROM ")
  998.         s = Replace(s, " WHERE ", vbCrLf & " WHERE ")
  999.         s = Replace(s, " ORDER ", vbCrLf & " ORDER ")
  1000.         s = Replace(s, " GROUP ", vbCrLf & " GROUP ")
  1001.         s = Replace(s, " BY ", vbCrLf & " BY ")
  1002.         s = Replace(s, " OR ", vbCrLf & " OR ")
  1003.         s = Replace(s, " AND ", vbCrLf & " AND ")
  1004.         s = Replace(s, ",", "," & vbCrLf & Space(8))
  1005.         s = Replace(s, vbCrLf, """" & vbCrLf & "sSql = sSql & """)
  1006.         
  1007.         For i = 1 To 10
  1008.             s = Replace(s, Space(9), Space(8))
  1009.         Next
  1010.         s = Replace(s, "sSql = sSql & "" SELECT", "sSql = ""SELECT")
  1011.         s = Right(s, Len(s) - 3)
  1012.     End If
  1013.     If chkContinue <> 0 Then
  1014.         s = Replace(s, vbCrLf, " _" & vbCrLf)
  1015.         s = Replace(s, "sSql = sSql & ", " & ")
  1016.     End If
  1017.     SQLFormat = s
  1018. ErrExit:      Exit Function
  1019. ErrHandler:   Call ErrorHandler(Name, 0, "SQLFormat")
  1020. End Function
  1021.