form1.frm

来自「VB源码,是初学者的福因.让你很快掌握VB编程」· FRM 代码 · 共 206 行

VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3675
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   6660
   LinkTopic       =   "Form1"
   ScaleHeight     =   3675
   ScaleWidth      =   6660
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton RunSQL 
      Caption         =   "执行SQL"
      Height          =   615
      Left            =   5640
      TabIndex        =   4
      Top             =   1080
      Width           =   735
   End
   Begin VB.ListBox List2 
      Height          =   780
      Left            =   3480
      TabIndex        =   3
      Top             =   120
      Width           =   2895
   End
   Begin VB.ListBox List1 
      DataSource      =   "Data1"
      Height          =   780
      ItemData        =   "Form1.frx":0000
      Left            =   600
      List            =   "Form1.frx":0002
      TabIndex        =   2
      Top             =   120
      Width           =   2175
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   600
      MultiLine       =   -1  'True
      TabIndex        =   1
      Text            =   "Form1.frx":0004
      Top             =   1200
      Width           =   4935
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   2880
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   2760
      Visible         =   0   'False
      Width           =   1935
   End
   Begin MSDBGrid.DBGrid DBGrid1 
      Bindings        =   "Form1.frx":000A
      Height          =   1695
      Left            =   600
      OleObjectBlob   =   "Form1.frx":001E
      TabIndex        =   0
      Top             =   1800
      Width           =   5775
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   120
      Top             =   2880
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label3 
      Caption         =   "结果显示"
      Height          =   975
      Left            =   240
      TabIndex        =   7
      Top             =   2040
      Width           =   255
   End
   Begin VB.Label Label2 
      Caption         =   "数据字段"
      Height          =   975
      Left            =   3120
      TabIndex        =   6
      Top             =   120
      Width           =   255
   End
   Begin VB.Label Label1 
      Caption         =   "数据库表"
      Height          =   975
      Left            =   240
      TabIndex        =   5
      Top             =   120
      Width           =   255
   End
   Begin VB.Menu mOpenDB 
      Caption         =   "打开数据库"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Sub ReplaceStr(S As String, FS As String, RS As String)
    Dim pos As Integer
    
    pos = InStr(S, FS)
    While pos > 0
        S = Left(S, pos - 1) & RS & Mid(S, pos + Len(FS))
        pos = InStr(S, FS)
    Wend
End Sub


Private Sub List1_Click()
    Dim i As Integer, k As Integer, S As String
    
    If List1.ListIndex >= 0 Then
        Text1.Text = List1.Text
        Data1.RecordSource = List1.Text
        Data1.Refresh
        List2.Clear
        For i = 0 To Data1.Recordset.Fields.Count - 1
            List2.AddItem Data1.Recordset.Fields(i).Name
        Next
    End If
End Sub

Private Sub List2_Click()
    If List1.ListIndex >= 0 Then
        Text1.SelText = List2.Text & ", "
    End If
End Sub

Private Sub mOpenDB_Click()
    Dim i As Integer
    On Error Resume Next
    With CommonDialog1
        .DialogTitle = "打开 .mdb 文件"
        .Filter = "(数据库)*.mdb|*.mdb"
        .CancelError = True
        .ShowOpen
        If Err.Number <> cdlCancel Then
        
            Data1.DatabaseName = .FileName
            Data1.Refresh
            
            List1.Clear
            For i = 0 To Data1.Database.TableDefs.Count - 1
                If Data1.Database.TableDefs(i).Attributes = 0 Then
                    List1.AddItem Data1.Database.TableDefs(i).Name
                End If
            Next
            If List1.ListCount > 0 Then List1.ListIndex = 0
        End If
    End With
End Sub

Private Sub RunSQL_Click()
    On Error GoTo ErrMsg
    Dim SQL As String, i As Integer
    
    SQL = Text1.Text
    ReplaceStr SQL, "%", "*"
    ReplaceStr SQL, "_", "?"
    
    If UCase(Left(SQL, 6)) <> "SELECT" Or (UCase(Left(SQL, 6)) = "SELECT" And InStr(1, SQL, "Into", vbTextCompare) > 0) Then
        Data1.Database.Execute SQL
        List1.Clear
        For i = 0 To Data1.Database.TableDefs.Count - 1
            If Data1.Database.TableDefs(i).Attributes = 0 Then
                List1.AddItem Data1.Database.TableDefs(i).Name
            End If
        Next
        If List1.ListCount > 0 Then List1.ListIndex = 0
    Else
        Data1.RecordSource = SQL
        Data1.Refresh
    End If
    Exit Sub
ErrMsg:
    If Err.Number = 3061 Then ' 需要设置数
        On Error Resume Next
        Dim qd As QueryDef, p As Integer
        
        Set qd = Data1.Database.CreateQueryDef("", SQL)
        For p = 0 To qd.Parameters.Count - 1
            qd.Parameters(p).Value = InputBox(qd.Parameters(p).Name & "?", "请输入参数值")
        Next
        Set Data1.Recordset = qd.OpenRecordset
    Else
        MsgBox Err.Description, vbInformation
    End If
End Sub