frmmain.frm

数据语句生成工具,方便输入数据库语句。用了才知道方便啊。

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMain 
   Caption         =   "Form1"
   ClientHeight    =   6210
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7905
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6210
   ScaleWidth      =   7905
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "VB语句"
      Height          =   5895
      Left            =   1920
      TabIndex        =   3
      Top             =   120
      Width           =   5895
      Begin VB.TextBox txtVB 
         Height          =   5535
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   4
         Top             =   240
         Width           =   5655
      End
   End
   Begin VB.ListBox lstField 
      Height          =   4920
      Left            =   120
      TabIndex        =   2
      Top             =   1080
      Width           =   1695
   End
   Begin VB.ComboBox cmbTable 
      Height          =   300
      Left            =   120
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   720
      Width           =   1695
   End
   Begin MSComDlg.CommonDialog cdOpen 
      Left            =   0
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DialogTitle     =   "打开MDB文件"
      Filter          =   "数据库文件|*.mdb"
   End
   Begin VB.CommandButton cmdOpen 
      Caption         =   "打开数据库文件(&O)"
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1695
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim fld As Field

Private Sub cmbTable_Click()
  Call getFields(cmbTable.Text)
End Sub

Private Sub cmdOpen_Click()
  cdOpen.Action = 1
  'Label1.Caption = cdOpen.FileName
  If cdOpen.FileName <> "" Then
    mdbPath = cdOpen.FileName
    Set conn = New ADODB.Connection
    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbPath & ";Persist Security Info=False"
    conn.Open
    
    Call getTableNames
  End If
End Sub

Private Sub Form_Load()
  Me.Caption = App.EXEName
  'For i = 1 To 200
  '  Text1.Text = Text1.Text & Chr(i) & "-" & i & Chr(13) & Chr(32)
  'Next i
End Sub

Function getTableNames()
  Set cat = New ADOX.Catalog
  Set cat.ActiveConnection = conn
  cmbTable.Clear
  For Each tbl In cat.Tables
  If Left(tbl.Name, 4) <> "MSys" Then
  cmbTable.AddItem tbl.Name
  End If
  Next
End Function

Function getFields(tableName)
  lstField.Clear
  'txtVB.Text = ""
  sql = "select * from " & tableName
  Set rs = New ADODB.Recordset
  rs.Open sql, conn, 1, 1
  txtvb1 = "'VB写入语句(完整)" & Chr(13) & Chr(10) & "rs.addnew " & Chr(13) & Chr(10)
  txtvb2 = "'VB写入语句(部分)" & Chr(13) & Chr(10) & "rs.addnew " & Chr(13) & Chr(10)
  txtvb3 = "'VB读取语句(完整)" & Chr(13) & Chr(10) & "do until rs.eof " & Chr(13) & Chr(10)
  txtvb4 = "'VB读取语句(部分)" & Chr(13) & Chr(10) & "do until rs.eof " & Chr(13) & Chr(10)
  For Each fld In rs.Fields
    lstField.AddItem fld.Name
    txtvb1 = txtvb1 & "rs(" & Chr(34) & fld.Name & Chr(34) & ")=" & fld.Name & Chr(13) & Chr(10)
    txtvb2 = txtvb2 & "rs(" & Chr(34) & fld.Name & Chr(34) & ")=" & Chr(13) & Chr(10)
    txtvb3 = txtvb3 & fld.Name & "=" & "rs(" & Chr(34) & fld.Name & Chr(34) & ")" & Chr(13) & Chr(10)
    txtvb4 = txtvb4 & "=" & "rs(" & Chr(34) & fld.Name & Chr(34) & ")" & Chr(13) & Chr(10)
  Next fld
  txtvb1 = txtvb1 & "rs.update" & Chr(13) & Chr(10) & "rs.close" & Chr(13) & Chr(10) & "set rs=nothing" & Chr(13) & Chr(10)
  txtvb2 = txtvb2 & "rs.update" & Chr(13) & Chr(10) & "rs.close" & Chr(13) & Chr(10) & "set rs=nothing" & Chr(13) & Chr(10)
  txtvb3 = txtvb3 & "rs.movenext " & Chr(13) & Chr(10) & "loop" & Chr(13) & Chr(10)
  txtvb4 = txtvb4 & "rs.movenext " & Chr(13) & Chr(10) & "loop" & Chr(13) & Chr(10)
  txtVB.Text = txtvb1 & Chr(13) & Chr(10) & txtvb2 & Chr(13) & Chr(10) & txtvb3 & Chr(13) & Chr(10) & txtvb4
'  Set rs = New ADODB.Recordset
'  rs.Open sql, conn, 1, 1
'  txtVB.Text = txtVB.Text & Chr(13) & Chr(10) & "'VB写入语句(部分)" & Chr(13) & Chr(10)
'  For Each fld In rs.Fields
'    lstField.AddItem fld.Name
'    txtVB.Text = txtVB.Text & "rs(" & Chr(34) & fld.Name & ")=" & Chr(13) & Chr(10)
'  Next fld
End Function

Private Sub Form_Unload(Cancel As Integer)
  Set conn = Nothing
  Set cat = Nothing
  Set tbl = Nothing
  Set rs = Nothing
  Set fld = Nothing
End Sub