通过学术会议、信件和网上下载(见http://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 结语
中国地质学会工程地质专业委员会建立“全国工程地质专家库系统”的目是便于相互了解、交流,以满足各单位部门了解专家专家信息的需求,充分发挥专家作用,更快推进工程地质学科和事业的创新发展。