Master 95 #1/MASTER95_1.iso/microsof/vbasic4/vb4-6.cab/sql.frm

Visual Basic Form | 1995-07-26 | 6.8 KB | 208 lines

VERSION 4.00
Begin VB.Form frmSQL
   Caption         =   "SQL Statement"
   ClientHeight    =   2880
   ClientLeft      =   3690
   ClientTop       =   1575
   ClientWidth     =   5250
   Height          =   3285
   HelpContextID   =   2016144
   Icon            =   "SQL.frx":0000
   Left            =   3630
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MDIChild        =   -1  'True
   ScaleHeight     =   2863.353
   ScaleMode       =   0  'User
   ScaleWidth      =   5268
   Top             =   1230
   Width           =   5370
   Begin VB.CommandButton cmdSaveQueryDef
      Caption         =   "&Save"
      Height          =   375
      Left            =   3480
      TabIndex        =   3
      Top             =   120
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.CommandButton cmdExecuteSQL
      Caption         =   "&Execute"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1575
   End
   Begin VB.CommandButton cmdClearSQL
      Caption         =   "&Clear"
      Height          =   375
      Left            =   1800
      TabIndex        =   2
      Top             =   120
      Width           =   1575
   End
   Begin VB.TextBox txtSQLStatement
      BackColor       =   &H00FFFFFF&
      Height          =   2175
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   600
      Width           =   5055
   End
Attribute VB_Name = "frmSQL"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdClearSQL_Click()
  txtSQLStatement.Text = gsNULL_STR
  txtSQLStatement.SetFocus
End Sub
Private Sub cmdSaveQueryDef_Click()
  On Error GoTo SQDErr
  Dim sQueryName As String
  Dim sTmp As String
  Dim qdNew As QueryDef
  If gbDBOpenFlag = False Then
    MsgBox "No Database Open", 48
    Exit Sub
  End If
  If frmTables.optQueryDefs.Value = True _
    And frmTables.lstQueryDefs.ListIndex >= 0 Then
    'a querydef is selected so user may want to update it's SQL
    If MsgBox("Update '" & frmTables.lstQueryDefs.Text & "'?", gnMSGBOX_TYPE) = gnMSGBOX_YES Then
      'store the SQL from the SQL Window in the currently
      'selected querydef
      gdbCurrentDB.QueryDefs(frmTables.lstQueryDefs.Text).SQL = Me.txtSQLStatement.Text
      Exit Sub
    End If
  End If
  'either there is no current querydef selected or the user
  'didn't want to update the current one so we need
  'to propmpt for a new name
  sQueryName = InputBox("Enter QueryDef Name:")
  If Len(sQueryName) = 0 Then Exit Sub
  'check for a dupe and exit if the user won't overwrite it
  If DupeTableName(sQueryName) = True Then
    Exit Sub
  End If
  'add the new querydef
  Set qdNew = gdbCurrentDB.CreateQueryDef(sQueryName)
  'prompt for passthrough querydef
  If MsgBox("Is this a SQLPassThrough QueryDef?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
    sTmp = InputBox("Enter Connect property value:")
    If Len(sTmp) > 0 Then
      qdNew.Connect = sTmp
      If MsgBox("Is the Query Row Returning?", vbYesNo + vbQuestion) = vbNo Then
        qdNew.ReturnsRecords = False
      End If
    End If
  End If
  qdNew.SQL = txtSQLStatement.Text
  gdbCurrentDB.QueryDefs.Refresh
  RefreshTables frmTables.lstTables, True
  Exit Sub
SQDErr:
  ShowError
  Exit Sub
End Sub
Private Sub txtSQLStatement_Change()
  If Len(txtSQLStatement.Text) > 0 Then
    cmdExecuteSQL.Enabled = True
  Else
    cmdExecuteSQL.Enabled = False
  End If
End Sub
Private Sub cmdExecuteSQL_Click()
  Dim Start1 As Long, Finish1 As Long
   If gbDBOpenFlag = False Then
     MsgBox "No Database Open", 48
     Exit Sub
   End If
   If Len(txtSQLStatement.Text) = 0 Then Exit Sub
   MsgBar "Executing SQL Statement", True
   SetHourglass
   If UCase(Mid(txtSQLStatement, 1, 6)) = "SELECT" And InStr(UCase(txtSQLStatement), " INTO ") = 0 Then
     On Error GoTo SQLErr
MakeDynaset:
     gbFromSQL = True
     'create a new recordset form
     gsDynaString = gsNULL_STR
     On Error GoTo SQLErr
     If frmMDI.optNoDataCtl.Value = True Then
       Dim recform1 As New frmDynaSnap
       recform1.Show
     ElseIf frmMDI.optDataCtl.Value = True Then
       Dim recform2 As New frmDataControl
       recform2.Show
     ElseIf frmMDI.optTable.Value = True Then
       Dim recform3 As New frmTableObj
       recform3.Show
     Else
       Dim recform4 As New frmDataGrid
       recform4.Show
     End If
   ElseIf Left(UCase(txtSQLStatement.Text), 9) = "TRANSFORM" Then
     GoTo MakeDynaset
   ElseIf UCase(txtSQLStatement.Text) = "LISTTABLES" Then
     GoTo MakeDynaset
   Else
     On Error GoTo SQLErr

     Start1 = OSTimeGetTime()
     If gsDataType = gsSQLDB Then
       gdbCurrentDB.Execute (txtSQLStatement.Text), dbSQLPassThrough
     Else
       gdbCurrentDB.Execute (txtSQLStatement.Text)
     End If
     Finish1 = OSTimeGetTime()

     If gdbCurrentDB.RecordsAffected > 0 Then
       If gbTransPending Then gbDBChanged = True
     End If

     If frmMDI.mnuPShowPerf.Checked Then
       MsgBox gdbCurrentDB.RecordsAffected & " row(s) Affected by SQL Statement in " & (Finish1 - Start1) / 1000 & " seconds!", 48
     Else
       MsgBox gdbCurrentDB.RecordsAffected & " row(s) Affected by SQL Statement.", 48
     End If
   End If
   Screen.MousePointer = vbDefault
   MsgBar gsNULL_STR, False
   Exit Sub
SQLErr:
   If Err = 3065 Or Err = 3078 Then 'row returning or name not found so try to create recordset
     Resume MakeDynaset
   End If
   ShowError
   Exit Sub
SQLEnd:
End Sub
Private Sub Form_Load()
  txtSQLStatement.Text = GetINIString("SQLStatement", gsNULL_STR, gsVISDATA4)
  Me.Height = Val(GetINIString("SQLWindowHeight", "3000", gsVISDATA4))
  Me.Width = Val(GetINIString("SQLWindowWidth", "5370", gsVISDATA4))
  Me.Top = Val(GetINIString("SQLWindowTop", "0", gsVISDATA4))
  Me.Left = Val(GetINIString("SQLWindowLeft", CStr(frmTables.Left + frmTables.Width), gsVISDATA4))
End Sub
Private Sub Form_Resize()
  On Error Resume Next
  If WindowState <> 1 Then
    txtSQLStatement.Width = Me.Width - 320
    txtSQLStatement.Height = Me.Height - 1150
  End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Me.WindowState = 1
  Cancel = True
End Sub
Private Sub txtSQLStatement_DragDrop(Source As Control, x As Single, Y As Single)
  If Source = frmTables.lstQueryDefs Then
    frmSQL.txtSQLStatement.Text = gdbCurrentDB.QueryDefs(frmTables.lstQueryDefs.Text).SQL
  End If
End Sub