VERSION 5.00
Begin VB.Form frmQuerys 
   Caption         =   "查詢(適合熟悉SQL語句的用戶)"
   ClientHeight    =   4185
   ClientLeft      =   1650
   ClientTop       =   1545
   ClientWidth     =   5100
   Icon            =   "frmQuerys.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   4185
   ScaleWidth      =   5100
   Tag             =   "Querys"
   Begin VB.ListBox lstQueryDefs 
      Height          =   1140
      Left            =   96
      TabIndex        =   0
      Top             =   274
      Width           =   3392
   End
   Begin VB.TextBox txtSQLStatement 
      BackColor       =   &H00FFFFFF&
      Height          =   2159
      Left            =   96
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Top             =   1921
      Width           =   4931
   End
   Begin VB.CommandButton cmdRemoveQuery 
      Caption         =   "刪除(&R)"
      Height          =   370
      Left            =   3572
      TabIndex        =   3
      Tag             =   "&Remove"
      Top             =   1277
      Width           =   1443
   End
   Begin VB.CommandButton cmdSaveQueryDef 
      Caption         =   "保存(&S)"
      Height          =   370
      Left            =   3572
      TabIndex        =   2
      Tag             =   "&Save"
      Top             =   775
      Width           =   1443
   End
   Begin VB.CommandButton cmdExecuteSQL 
      Caption         =   "執(zhí)行(&E)"
      Enabled         =   0   'False
      Height          =   370
      Left            =   3572
      TabIndex        =   1
      Tag             =   "&Execute"
      Top             =   274
      Width           =   1443
   End
   Begin VB.Label lblSQL 
      Caption         =   "SQL 語句:"
      Height          =   251
      Index           =   1
      Left            =   132
      TabIndex        =   6
      Tag             =   "SQL Statement:"
      Top             =   1682
      Width           =   2189
   End
   Begin VB.Label lblSQL 
      Caption         =   "保存的查詢:"
      Height          =   251
      Index           =   0
      Left            =   108
      TabIndex        =   5
      Tag             =   "Saved Querys:"
      Top             =   24
      Width           =   2189
   End
End
Attribute VB_Name = "frmQuerys"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'====================================================================
'本模板需要在應(yīng)用程序中存在下列代碼（或等價的代碼），
' 以及對 DAO 3.50 和 DataGrid 模板的引用。
'
'Global gsDatabase As String
'Global gsRecordsource As String
'
'Sub Main()
'  gsDatabase = "c:\vb5\biblio.mdb"
'  frmQuerys.Show
'End Sub
'====================================================================


Dim mdbDatabase As Database

Private Sub Form_Load()
    Set mdbDatabase = OpenDatabase(App.Path + "\DATABASE\MARK.MDB", , False)
    RefreshQuerys
    Me.Left = GetSetting(App.Title, "Settings", "QueryLeft", 0)
    Me.Top = GetSetting(App.Title, "Settings", "QueryTop", 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "QueryLeft", Me.Left
        SaveSetting App.Title, "Settings", "QueryTop", Me.Top
    End If
    FRMKCDW_ID = True
End Sub



Private Sub cmdSaveQueryDef_Click()
    On Error GoTo SQDErr

    Dim sQueryName As String
    Dim sTmp As String
    Dim qdNew As QueryDef

    If lstQueryDefs.ListIndex >= 0 Then
        '選中一個查詢定義，用戶可能希望更新 SQL
        If MsgBox("更新 '" & lstQueryDefs.Text & "' 嗎？", vbYesNo + vbQuestion) = vbYes Then
            '存儲 SQL 窗口中的 SQL 于當前選中的查詢定義中
            mdbDatabase.QueryDefs(lstQueryDefs.Text).SQL = Me.txtSQLStatement.Text
            Exit Sub
        End If
    End If
    
    '也許當前無選中的查詢定義或用戶不想更新，
    '要提示一個新名稱
    sQueryName = InputBox("輸入新查詢名稱：")
    If Len(sQueryName) = 0 Then Exit Sub
    
    '添加新查詢定義
    Set qdNew = mdbDatabase.CreateQueryDef(sQueryName)
    '提示是否傳遞查詢定義
    If MsgBox("這是一個 SQL 傳遞查詢定義嗎？", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
        sTmp = InputBox("輸入 Connect 屬性的值：")
        If Len(sTmp) > 0 Then
            qdNew.Connect = sTmp
            If MsgBox("查詢行是否正在返回？", vbYesNo + vbQuestion) = vbNo Then
                qdNew.ReturnsRecords = False
            End If
        End If
    End If
    qdNew.SQL = txtSQLStatement.Text
    
    mdbDatabase.QueryDefs.Refresh
    RefreshQuerys

    Exit Sub

SQDErr:
    MsgBox ERR.Description
End Sub

Private Sub lstQueryDefs_Click()
    txtSQLStatement.Text = mdbDatabase.QueryDefs(lstQueryDefs.Text).SQL
End Sub

Private Sub lstQueryDefs_DblClick()
    cmdExecuteSQL_Click
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 rsTmp As Recordset
    Dim dbTmp As Database
    Dim qdfTmp As QueryDef
    Dim bSavedQDF As Boolean
    Dim sSQL As String
    
    If Len(txtSQLStatement.Text) = 0 Then Exit Sub
    
    Set dbTmp = OpenDatabase(App.Path + "\DATABASE\MARK.MDB", , False)
    
    If lstQueryDefs.ListIndex >= 0 Then
        sSQL = dbTmp.QueryDefs(lstQueryDefs.Text).SQL
        If sSQL = txtSQLStatement.Text Then
            Set qdfTmp = dbTmp.QueryDefs(lstQueryDefs.Text)
            bSavedQDF = True
            If Not SetQryParams(qdfTmp) Then Exit Sub
        Else
            '僅創(chuàng)建一個臨時查詢定義
            Set qdfTmp = dbTmp.CreateQueryDef(vbNullString, txtSQLStatement.Text)
        End If
    Else
        '僅創(chuàng)建一個臨時查詢定義
        Set qdfTmp = dbTmp.CreateQueryDef(vbNullString, txtSQLStatement.Text)
    End If

    'Screen.MousePointer = vbHourglass
    If UCase(Mid(txtSQLStatement, 1, 6)) = "SELECT" And InStr(UCase(txtSQLStatement.Text), " INTO ") = 0 Then
        On Error GoTo SQLErr
MakeDynaset:
        Dim f As New frmDataGrid
        Set rsTmp = qdfTmp.OpenRecordset()
        Set f.Data1.Recordset = rsTmp
        If bSavedQDF Then
            f.Caption = qdfTmp.Name
        Else
            f.Caption = Left(txtSQLStatement.Text, 32) & "..."
        End If
        
        f.Show 1
    Else
        On Error GoTo SQLErr
        qdfTmp.Execute
    End If

    Screen.MousePointer = vbDefault
    Exit Sub

SQLErr:
    If ERR = 3065 Or ERR = 3078 Then '行正在返回或名稱未找到，所以試圖創(chuàng)建記錄集
        Resume MakeDynaset
    End If
    MsgBox ERR.Description

SQLEnd:

End Sub

Private Sub Form_Resize()
    On Error Resume Next

    If WindowState <> 1 Then
        If Me.Width < 5220 Then Me.Width = 5220
        If Me.Height < 2784 Then Me.Height = 2784
        
        txtSQLStatement.Width = Me.Width - 320
        txtSQLStatement.Height = Me.Height - 2424
    End If
End Sub

Sub RefreshQuerys()
    Dim qdf As QueryDef
    
    lstQueryDefs.Clear
    
    For Each qdf In mdbDatabase.QueryDefs
        lstQueryDefs.AddItem qdf.Name
    Next
    
End Sub

Private Function SetQryParams(rqdf As QueryDef) As Boolean
    On Error GoTo SPErr
    
    Dim prm As Parameter
    Dim sTmp As String
    Dim i As Integer
    
    For Each prm In rqdf.Parameters
        '從用戶那里得到值
        sTmp = InputBox("為參數(shù) '" & prm.Name & "' 輸入值：")
        If Len(sTmp) = 0 Then
            '如果用戶一個參數(shù)也沒有輸入，則退出
            SetQryParams = False
            Exit Function
        End If
        '存儲該值
        prm.Value = CVar(sTmp)
    Next
    
    SetQryParams = True
    Exit Function
        
SPErr:
    MsgBox ERR.Description
End Function