frmscorequery.frm

远程访问sql server 的源码

Public Property Set rsFrmQuery(ByVal vData As ADODB.Recordset)
    Set mrsFrmQuery = vData
End Property

Public Property Get rsFrmQuery() As ADODB.Recordset
    Set rsFrmQuery = mrsFrmQuery
End Property

Public Property Get strFrmSql() As String
    strFrmSql = mstrFrmSql
End Property
Public Property Let strFrmSql(ByVal strData As String)
    mstrFrmSql = strData
End Property

Public Function GetCommand(strSql As String, conn As ADODB.Connection) As ADODB.Command
'功    能：获取ADO命令对象
'参    数：
'          输入： strSQL        String     用于查询SQL数据库的SQL语句
'          输出： GetCommand    Command    返回的命令对象
    Dim cmdTemp As ADODB.Command
    Set cmdTemp = New ADODB.Command
    Dim cnnTemp As ADODB.Connection
    
    Set cnnTemp = conn
    
    cmdTemp.ActiveConnection = cnnTemp
    cmdTemp.CommandText = strSql
    cmdTemp.CommandType = adCmdText
    
    Set GetCommand = cmdTemp
    
End Function

Private Sub cboFields_Click()
    '用来存放字段名的字符串变量
    Dim strFldName As String
    '获取记录集的SQL语句
    Dim strCommSql As String
    '临时的记录集对象
    Dim rsTempScore As ADODB.Recordset
    
    strFldName = Trim$(cboFields.Text)
    
    '取得记录集中数据源的字符串，并以组合框中内容来替换
    '注意，distinct关键字表示不允许出现重复记录
    '这里的目的是为“值”组合框设置初始值列表做准备工作
    strCommSql = Replace(rsFrmSource.Source, "*", "distinct " & strFldName)
    Set commFrmQuery = GetCommand(strCommSql, cnnFrmQuery)
    Set rsTempScore = commFrmQuery.Execute
    
    '如果得到的记录集非空
    If Not (rsTempScore.EOF And rsTempScore.BOF) Then
        rsTempScore.MoveFirst
        cboResult.Clear
        cboOperate.Clear
        
        '在这一步，将根据选定的字段名来动态的设置“操作符”组合框中将会出现的操作符
        With rsTempScore(strFldName)
            '字符型的字段，只需要下面三种比较操作符
            If .Type = adChar Then
                '写入操作符
                cboOperate.AddItem "="
                cboOperate.AddItem "<>"
                cboOperate.AddItem "like"
            '如果是数值类型，那么比较操作符种类如下列示
            ElseIf .Type = adInteger Or .Type = adDouble Then
                '写入操作符
                cboOperate.AddItem "="
                cboOperate.AddItem ">"
                cboOperate.AddItem ">="
                cboOperate.AddItem "<"
                cboOperate.AddItem "<="
                cboOperate.AddItem "<>"
            '日期事件型的数据类型，也有自己的比较操作符
            ElseIf .Type = adDate Or .Type = adDBDate Or .Type = adDBTime Or .Type = adDBTimeStamp Then
                '写入操作符
                cboOperate.AddItem "="
                cboOperate.AddItem ">"
                cboOperate.AddItem ">="
                cboOperate.AddItem "<"
                cboOperate.AddItem "<="
                cboOperate.AddItem "<>"
            End If
        End With
        
        '这一段代码是为“值”组合框设置列表项
        '将目前数据库中所有可能的值加入列表项
        Do While Not rsTempScore.EOF
            cboResult.AddItem Trim$(rsTempScore(strFldName))
            rsTempScore.MoveNext
        Loop
    End If
    
    '释放资源
    rsTempScore.Close
    Set rsTempScore = Nothing
End Sub

Private Sub chkConditions_Click()
    '组合框主要用来控制是否复合查询
    '如果是复合查询，那么就设置两个单选按钮可用，并设置初始状态为“And”
    If chkConditions.Value = vbChecked Then
        optOr.Enabled = True
        optAnd.Enabled = True
        optAnd = True
        optOr = False
    Else
        optAnd.Enabled = False
        optOr.Enabled = False
    End If
End Sub

Private Sub cmdAdd_Click()
    On Error GoTo err
    '定义存放字段名的字符串变量
    Dim strFldName As String
    '定义存放操作符的字符串
    Dim strOperate As String
    '定义存放“值”的字符串
    Dim strResult As String
    '定义最后存放查询语句的字符串
    Dim strText As String
    
    '为定义好的变量赋值，strText也要赋初始化的值
    strFldName = Trim$(cboFields.Text)
    strOperate = Trim$(cboOperate.Text)
    strResult = Trim$(cboResult.Text)
    strText = Trim$(txtQuery.Text)
    
    '查询条件的三个组成部分不能为空
    If strFldName = vbNullString Or strOperate = vbNullString Or strResult = vbNullString Then
        MsgBox "请完整输入查询条件！"
        cboFields.SetFocus
        Exit Sub
    End If
    
    '根据不同的字段变量的数据类型给SQL语句以不同的写法
    With rsFrmSource(strFldName)
        If .Type = adChar Then
            '字符串变量，单引号' '不能缺少.
            strFrmSql = strFldName & strOperate & "'" & strResult & "'"
        ElseIf .Type = adDouble Or .Type = adInteger Then
            '数值类型，不能有单引号
            strFrmSql = strFldName & strOperate & strResult
        ElseIf .Type = adDate Or .Type = adDBDate Or .Type = adDBTime Or .Type = adDBTimeStamp Then
            '如果是日期类型，在SQL Server中将按字符串比较格式
            strFrmSql = strFldName & strOperate & "'" & Trim$(strResult) & "'"   '"#" & strResult & "#'"
        End If
    End With
    
    '模糊查询有独特的写法，需要注意%的位置
    If cboOperate.Text = "like" Then
        strFrmSql = strFldName & " " & strOperate & " " & "'" & "%" & Trim$(strResult) & "%" & "'"
    End If
        
    '…………………………………………………………………………………………………
    '上述代码的编写中，需要注意SQL语句中间的空格
    '…………………………………………………………………………………………………
    
    '如果是复合查询方式，那么就可以对查询语句进行组合
    If chkConditions.Value = vbChecked Then
        '分And和Or两种方式进行查询条件的组合
        '在查询结果文本框里面有内容的时候，用And或Or链接新的查询条件
        If optAnd = True Then
            If strText <> vbNullString Then
                strFrmSql = "and" & " " & strFrmSql
            End If
        ElseIf optOr = True Then
            If strText <> vbNullString Then
                strFrmSql = "or" & " " & strFrmSql
            End If
        End If
    Else '如果没有选择复合查询，且已经有查询条件存在，则不能再输入内容到文本框！
        If strText <> vbNullString Then
            strFrmSql = vbNullString
        End If
    End If
    '最后，将文本框中的内容设置为当前文本框文本与新的查询条件链接而成的字符串
    txtQuery.Text = Trim$(strText + " " + strFrmSql)
    '将文本框内容最后赋值给将来用作查询语句的变量
    strFrmSql = Trim$(txtQuery.Text)
    Exit Sub
err:
    MsgBox err.Number & " " & err.Description
End Sub
'如果要取消查询，则需要释放所用已经在窗体中应用的资源
Private Sub cmdCancel_Click()
    '先关闭记录集，再关闭链接，否则会出现错误
    rsFrmSource.Close
    Set rsFrmSource = Nothing
    
    '在这里释放Command对象
    Set commFrmQuery = Nothing
    
    '关闭链接
    cnnFrmQuery.Close
    Set cnnFrmQuery = Nothing
    
    Unload Me
End Sub

Private Sub cmdClear_Click()
    txtQuery.Text = vbNullString
End Sub

Private Sub cmdModify_Click()
    txtQuery.Enabled = True
End Sub

Private Sub cmdOk_Click()
    Dim commSql As String
    
    On Error GoTo err
    
    '在这里释放Command对象
    If Not (commFrmQuery Is Nothing) Then
        Set commFrmQuery = Nothing
    End If
    
    '如果存在查询子句，那么就与源记录集中取得的字符串链接成完整的SQL语句8
    If txtQuery.Text <> vbNullString Then
        commSql = rsFrmSource.Source & " " & "where" & " "
        commSql = commSql & strFrmSql
    Else
    '如果没有查询子句，就返回数据库中的所有记录
        commSql = rsFrmSource.Source
    End If
    
    '调用类模块中的方法，返回一个记录集给表单的属性rsFrmQuery。
    Set rsFrmQuery = clsQuery.GetRecordSet(commSql, cnnFrmQuery)
   
    '此时，如果将链接关闭的话，那么查询得到的记录结也将不能正确的返回给用户
    '因此下面的两条语句需要注释掉
    'cnnFrmQuery.Close
    'Set cnnFrmQuery = Nothing
    Unload Me
err:
    If err.Number <> 0 Then
        MsgBox err.Number & "   " & err.Description
    End If
End Sub

Private Sub Form_Load()
    '移动窗体到屏幕中间
    Move (Screen.Width - Me.Width) / 2, _
        (Screen.Height - Me.Height) / 2
        
    
    '清空窗体上的三个组合框的项
    cboFields.Clear
    cboOperate.Clear
    cboResult.Clear
    
    Dim i As Integer
    '定义整型变量，用来存储传入表单的源数据集的字段数量
    Dim fldCount As Integer
    
    '写入字段名称项
    '开始初始化“字段名”组合框
    '利用一个循环，将传入表单的数据源的所有字段名都加入列表项中
    If Not (rsFrmSource.EOF And rsFrmSource.BOF) Then
        rsFrmSource.MoveFirst
        fldCount = rsFrmSource.Fields.Count
        '注意，字段中的索引从0开始
        For i = 0 To fldCount - 1
            cboFields.AddItem rsFrmSource.Fields(i).Name
        Next i
    End If
End Sub