精华区文章阅读

发信人: joy ( 雨送黄昏花易落), 信区: Database
标  题: 使用VB建立对DBF文件的交互式条件查询
发信站: 紫丁香 (Sun Jul 26 09:19:10 1998), 转信

   本文采用VB提供的SQL(Structured Query Language)工具编制交
互式查询程序作简单的讨论,并提供了采用VB3.0 Professional版调
试通过的VB示例程序。
    用户在运行此示例程序时,可以任意选择希望显示的字段,利用窗
体中的条件控制(如Co mboBox、逻辑运算按钮等)进行逻辑条件设置,
查询满足检索条件的DBF文件记录(本程序提供的例子采用Fox 2.0文
件,可以很容易地改为 dBASE IV 格式),并在窗体中列表显示。本程
序经过简单改进扩充,可以建立全汉字显示的数据库检索界面。
    一、VB打开DBF文件
    VB提供了有关数据库操作的对象如Database、Table、Dynaset、
Snapshot等,利用Data base的OpenDatabase,OpenTable,CreateDynas
et等方法可以打开多种类型的数据库文件。
    其方法是:
    Dim MyDatabase as Database,MyDyna as Dynaset,MyTable as
Table
    Dim SQLtext as string
    Set MyDatabase = OpenDatabase("C:\Mypath",False,True,"Fo
xPro 2.5;")
    Set MyTable=MyDatabase.OpenTable("CURRENT")
    SQLtext="Select * from DBFTEST where YEARNO=1990"
    Set MyDyna = MyDatabase.CreateDynaset(SQLtext,[Option])
   二、利用VB列表框和复选框显示DBF文件的字段
    Database、Table、Dynaset、Snapshot都具有Fields对象组,每
个Fields由多个Field组成,每个Field都具有Name、Value等属性,因
此可以将每个字段名及其字段值列入相应的列表框或组合框中。
    其方法是:
    For i=0 to MyTable.Fields.Count-1
      List2(Combo1).AddItem MyTable.Fields(i)
    Next i

    三、SQL SELECT...FROM...WHERE 语句的交互式应用
    VB的DynaSet对象,在进行数据检索时可以在CreateDynaset语句
中嵌入SQL语句字符串, 得到数据库符合检索条件的有关记录。
    其方法是:
    Dim MyDatabase as Database,MyDyna as Dynaset
    Dim SQLtext as string
    Set MyDatabase = OpenDatabase("C:\Mypath",False,True,"Fo
xPro 2.5;")
    SQLtext="Select * from DBFTEST where YEARNO=1990"
    Set MyDyna = MyDatabase.CreateDynaset(SQLtext,[Option])
    四、利用Grid控制显示检索结果
    VB的Grid对象可以显示字符串,把每条记录显示在同一行的对应
列中即可(具体方法已有报道,在此不再赘述)。
    其方法是:
  Grid1.Col=i
    Grid1.Row=j
    Grid1.Text=Format$(MyDyna.Fields(FieldName).Value)
    五、示例程序:
    1,窗体设计:
    窗体如图:
图1
    2,控制对象及其属性:
表1
    3,示例所使用的数据库 (CURRENT.DBF)
表2
    4,示例程序
    示例程序中,用户先在选择字段的多选列表框中选择所希望选择
的字段或按ALL按钮选择所有字段,然后在条件字段ComboBox中选择条
件字段,再按各种逻辑条件按钮,再在字段值Co mboBox中选择字段值,
形成检索逻辑条件,按显示数据按钮,则窗体下拉,显示表格,列出数据
库文件中符合条件的字段记录值。
    程序清单如下:
    文件名:querytst.txt
    FORM1.frm
    '通用变量声明:
    Option Explicit
    '记录SQL语句,分为两部分:SELECT...From...和WHERE...部分
Dim SQL As String, SQLSelect As String, SQLWhere As String
    Dim TableName As String, DBFPath As String
    Dim DbNum As Integer, FldNum As Integer
    Dim FldDs As Table
    Dim FldSelected() As String, IndexSel() As Integer
    Dim TempDb As Database, TempTb As Table
        Sub Combo1_Click ()
    Dim i As Integer, j As Integer
    '确定数据库文件名
     Select Case List2.ListIndex
    Case 0
      TableName = "CURRENT1"
    Case -1
      MsgBox "未选择数据库文件名", 16, "错误信息"
      Exit Sub
    End Select
    '打开数据库
    Set TempDb = OpenDatabase(DBFPath, False, True, "FoxPro
2.0;")
    Set TempTb = TempDb.OpenTable(TableName)
    SQLWhere = SQLWhere + Combo1.Text + " "
    '显示条件字段的记录值
    Combo2.Clear
While Not TempTb.EOF
      Combo2.AddItem TempTb(Combo1.Text).Value
      TempTb.MoveNext
    Wend
    TempTb.Close
    TempDb.Close
    End Sub
        Sub Combo2_Click ()
    '把记录值加入SQL语句中
    Set TempDb = OpenDatabase(DBFPath, True, True, "FoxPro 2
.0;")
    Set TempTb = TempDb.OpenTable(TableName)
        If TempTb.Fields(Combo1.Text).Type < 8 Then
      SQLWhere = SQLWhere + " " + Format$(Combo2.Text) + " "
    Else
      SQLWhere = SQLWhere & "'" & Combo2.Text & "'"
    End If
    TempTb.Close
    TempDb.Close
    Text1.Text = SQLWhere
    End Sub
        Sub Command1_Click ()
    'SQL < 条件
      SQLWhere = SQLWhere + " < "
    End Sub
        Sub Command10_Click ()
    'SQL - 运算
    SQLWhere = SQLWhere + "-"
    End Sub
        Sub Command11_Click ()
    'SQL * 运算
    SQLWhere = SQLWhere + "*"
    End Sub
        Sub Command12_Click ()
    'SQL / 运算
    SQLWhere = SQLWhere + "/"
    End Sub
        Sub Command13_Click ()
    '显示检索结果
    Dim RecNum As Integer, i As Integer, j As Integer
    Dim Astr As String, AnyValue
    Dim Ds As Dynaset
    Select Case List2.ListIndex
    Case 0
      TableName = "CURRENT1"
    Case -1
      MsgBox "未选择数据库文件名", 16, "错误信息"
      Exit Sub
    End Select
    '确定检索字段
        FldNum = 0
    For i = 0 To List1.ListCount - 1
      If List1.Selected(i) Then
    FldNum = FldNum + 1
      End If
    Next i
    ReDim FldSelected(FldNum)
    ReDim IndexSel(FldNum)
    j = 0
    For i = 0 To List1.ListCount - 1
      If List1.Selected(i) Then
    FldSelected(j) = List1.List(i)
    IndexSel(j) = i
    j = j + 1
      End If
    Next i
    If FldNum < 1 Then
   If SQLSelect = "" Then
    MsgBox "没有选择显示字段。", 16, "错误信息"
    Exit Sub
      End If
    Else
      If SQLSelect = "Select * From " & TableName & " " Then
      Else
    '形成SQL前一部分
    SQLSelect = "Select "
    For j = 0 To FldNum - 2
      SQLSelect = SQLSelect + FldSelected(j) + ", "
    Next j
    SQLSelect = SQLSelect + FldSelected(FldNum - 1) + " "
    SQLSelect = SQLSelect & "From " & TableName & " "
      End If
    End If
        '形成SQL语句
    If SQLWhere = "" Then
      SQL = SQLSelect
    Else
      SQL = SQLSelect + "Where " + SQLWhere
    End If
  Text1.Text = SQL
    '打开数据库文件
    Set TempDb = OpenDatabase(DBFPath, True, False, "FoxPro
2.0;")
    使用VB建立对DBF文件的
        交互式条件查询
    Set Ds = TempDb.CreateDynaset(SQL, 4)
    If Ds.RecordCount < 1 Then
      MsgBox "无符合条件的记录。", 16, "错误信息"
      Ds.Close
      TempDb.Close
      SQL = ""
      SQLSelect = ""
      SQLWhere = ""
      Exit Sub
    End If
        '显示已选择的字段,并调整显示宽度
    Grid1.Rows = 2
    Grid1.Cols = Ds.Fields.Count + 1
    Grid1.ColWidth(0) = TextWidth("记录#88888") * 1.2
    For i = 0 To Ds.Fields.Count - 1
      Grid1.Row = 0
      Grid1.Col = i + 1
    Grid1.ColWidth(i + 1) = TextWidth(Ds.Fields(i).Name) * 1
.2
      Grid1.Text = Ds.Fields(i).Name
    Next i
        '显示检索结果
    Ds.MoveFirst
    Grid1.Row = 1
    i = 1
    Do While Not Ds.EOF
      Grid1.Col = 0
      Grid1.Text = "记录#" + Str$(i)
      For j = 0 To Ds.Fields.Count - 1
    Grid1.Col = j + 1
    Astr = Ds.Fields(j).Name
    AnyValue = Ds.Fields(j).Value
    Grid1.Text = Format$(AnyValue)
      Next j
      Ds.MoveNext
      Grid1.Rows = Grid1.Rows + 1
      Grid1.Row = Grid1.Row + 1
      i = i + 1
    Loop
    Grid1.Rows = Grid1.Rows - 1
Form1.Height = 4815
    Ds.Close
    TempDb.Close
    End Sub
        Sub Command14_Click ()
    '清除
    Form1.Height = 3135
    SQL = ""
    SQLSelect = ""
    SQLWhere = ""
    Text1.Text = ""
    End Sub
    Sub Command15_Click ()
    SQLSelect = "Select * From " & TableName & " "
    End Sub
        Sub Command2_Click ()
    '条件 >
    SQLWhere = SQLWhere + " > "
    End Sub
        Sub Command3_Click ()
       '条件 =
    SQLWhere = SQLWhere + " = "
   End Sub
        Sub Command3D1_Click ()
    '结束
    End
    End Sub
        Sub Command4_Click ()
    SQLWhere = " Not " + SQLWhere + " = "
    End Sub
        Sub Command5_Click ()
    ' 控制 (
    SQLWhere = SQLWhere + "("
    End Sub
        Sub Command6_Click ()
    '控制 )
    SQLWhere = SQLWhere + ")"
    End Sub
        Sub Command7_Click ()
    '运算与
    SQLWhere = SQLWhere + " And "
    End Sub
        Sub Command8_Click ()
    '运算或
SQLWhere = SQLWhere + " OR "
    End Sub
        Sub Command9_Click ()
    '运算 +
    SQLWhere = SQLWhere + "+"
    End Sub
        Sub Form_Load()
    Dim IndexTable As Table,IndexDb As Database
    Dim FieldsNum As Integer,i As Integer'建立数据接口选项
    SteDataAccessOption 1,"C:\Windows\vb.ini"
    SQL=""
    SQL Where=""
    '清除SQL语句显示...
    Text1.Text=""
    '列出数据库文件
    List2.AddItem "社会经济"
    List2.Selected(0) = True
    TableName = "CURRENT"
    DBFPath = "C:\MYDBF\"
    Set TempDb = OpenDatabase(DBFPath, True, True, "FoxPro 2
.0;")
    Set TempTb = TempDb.OpenTable(TableName)
    '列出字段
FieldsNum = TempTb.Fields.Count
    For i = 0 To FieldsNum - 1
      List1.AddItem TempTb.Fields(i).Name
      Combo1.AddItem TempTb.Fields(i).Name
    Next i
    TempTb.Close
    TempDb.Close
    End Sub

--
※ 来源:．紫丁香 bbs.hit.edu.cn．[FROM: 202.118.229.129]

Database 版 (精华区)