4 工程地质专家库系统开发

4.1 数据库

（1）信息来源

通过学术会议、信件和网上下载（见//www.enggeo.org/xwdt-040106.htm）等途径分发“全国工程地质专家库专家登记表”，收集反馈回来的原始登记表，录入数据库中。

（2）创建数据库

在Microsoft Office Access软件中建立专家数据库。数据库中包括的字段有：姓名、性别、出生年月、工作单位、技术职称、工作职务、专家特长、工作领域、通信地址、邮政编码、联系电话、传真和电子邮箱等，基本涵盖了专家的基本信息、特长、工作领域和联系方式。

（3）数据录入

数据录入方式有两种方式： ① 在Access中录入； ② 数据维护方式，即在数据库管理员界面中输入数据。

所有专家的信息存储在一个数据表中，每位专家的信息在数据表中表现为一条记录。

4.2 系统功能的代码实现

采用Microsoft Visual Basic 6.0作为开发工具，运用其集成开发环境和快速应用程序开发技术，根据软件的功能模块分别创建程序界面和窗口（图1－图7）。开发过程中使用了ADO Data控件、DataGrid控件、DataEnviornment设计器、Data Report设计器等。

下面着重叙述高级查询的实现。在高级查询窗口中，用户填写的查询条件包括查询结果中显示的字段、where子句查询条件、字段排序子句，用字符串连接生成SQL查询语句。然后在专家数据表中查找符合查询条件的专家记录并在查询结果窗口中显示给用户。完成高级查询功能的程序片段如下：

Private Sub cmdQuery_Click()

    Dim strKey As String

    Dim strSQL As String, strsqlAll As String

    Dim strOrderSQL As String

    Dim strOrder As String

    Dim intLenKey As Integer

    Dim i As Integer, j As Integer

    '查询结果至少要显示一个字段

    If lstKey.SelCount = 0 Then

        MsgBox "查询结果中至少要显示一个字段!", vbMsgBoxSetForeground, "缺少字段"

        Exit Sub

    End If

   If txtCondition.Text = vbNullString Then

        MsgBox "请加入查询条件！", vbOKOnly + vbInformation, "提示"

        Exit Sub

    End If

    '查询结果中显示的字段

    strKey = vbNullString

    strkeys = vbNullString

    For i = 0 To lstKey.ListCount - 1

        If lstKey.Selected(i) = True Then

            strKey = strKey & lstKey.List(i) & ","

        End If

        strkeys = strkeys & lstKey.List(i) & ","

    Next

    strKey = Mid(strKey, 1, Len(strKey) - 1)

    strkeys = Mid(strkeys, 1, Len(strkeys) - 1)

    'where子句查询条件

    strWhere = vbNullString

    If Len(Trim(strQuerySQL)) > 0 Then

        strWhere = " where " & Trim(strQuerySQL)

    Else

        strWhere = vbNullString

    End If

    '字段排序字句

    If lstOrderKey.ListCount > 0 Then

        mstrOrderSQLs = ""

        intLenKey = 0

        For j = 0 To lstOrderKey.ListCount - 1

            strOrderSQL = lstOrderKey.List(j)

            If optOrder(0).Value = True Then

                intLenKey = InStr(1, strOrderSQL, "(升序)", vbTextCompare)

                strOrder = " ASC"

            Else

                intLenKey = InStr(1, strOrderSQL, "(降序)", vbTextCompare)

                strOrder = " DESC"

            End If

            If intLenKey > 0 Then

                strOrderSQL = Mid(strOrderSQL, 1, intLenKey - 1)

                If mstrOrderSQLs <> "" Then

                    mstrOrderSQLs = mstrOrderSQLs & ","

                End If

                mstrOrderSQLs = mstrOrderSQLs & strOrderSQL & strOrder

            End If

        Next j

        mstrOrderSQLs = " order by " & mstrOrderSQLs

    Else

        mstrOrderSQLs = ""

    End If

    '字符串连接生成SQL查询语句

    strSQL = "select " & strKey & " from " & " 专家库 " & strWhere & mstrOrderSQLs

    strsqlAll = "select " & strkeys & " from " & " 专家库 " & strWhere & mstrOrderSQLs

    adoconnection.Execute strSQL

    adoconnection.Execute strsqlAll

    If Err Then

        MsgBox Err.Number & vbCrLf & Err.Description & Err.Source, vbCritical, "SQL语句错误"

        Err.Clear

        Exit Sub

    End If

    Set recResult = New ADODB.Recordset

    Set recKeyword = New ADODB.Recordset

    frmQueryResult.strSQL = strSQL

    frmQueryResult.strSQL = strsqlAll

    recKeyword.Open strSQL, adoconnection, adOpenStatic, adLockOptimistic

    recResult.Open strsqlAll, adoconnection, adOpenDynamic, adLockOptimistic

    If recKeyword.RecordCount <= 0 Then

        MsgBox "没有您要查找的记录!", vbInformation + vbOKOnly, "找不到记录"

        Exit Sub

    End If

'查询结果显示    

frmQueryResult.Show vbModal

End Sub

5 结语

中国地质学会工程地质专业委员会建立“全国工程地质专家库系统”的目是便于相互了解、交流，以满足各单位部门了解专家专家信息的需求，充分发挥专家作用，更快推进工程地质学科和事业的创新发展。

上一页  [1] [2]