module1.bas

遗传算法背包问题的论文电子图书。不错

Attribute VB_Name = "Module1"
Option Explicit
Public username As String
Public ole_db As String
Public cn As ADODB.Connection
Public cmd As ADODB.Command
Public rs As ADODB.Recordset
Public loginsucceeded As Boolean
Public Sub link()
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.ConnectionString = " Provider=MSDASQL.1;Persist Security Info=False;User ID=administator;Extended Properties=DSN=graduate;APP=Visual Basic;WSID=DOU-00EF3663BF0;DATABASE=graduate;Trusted_Connection=Yes;Initial Catalog=graduate"
cn.Open
rs.ActiveConnection = cn
rs.Open "use graduate"
End Sub
'Public Function testtxt(txt As String) As Boolean
'  If Trim(txt) = "" Then
'     testtxt = True
'  Else
'     testtxt = False
'  End If
'End Function
Public Function ExecuteSql(ByVal SQL As String, MsgString As String) As ADODB.Recordset
    '传递参数:SQL传递查询语句，msgstring传递查询信息
    '自身以一个数据集对象的形式返回
    Dim con As ADODB.Connection
    '定义连接
    Dim rs As ADODB.Recordset
    '定义字符数组来存放SQL关键字
    Dim sTokens() As String
    '异常处理
    On Error GoTo ExecuteSql_Error
    '用split函数产生一个包括各个子串的数组
    sTokens = Split(SQL, " ")
    '创建连接
    Set con = New ADODB.Connection
    '选择打开连接的引擎
    con.ConnectionString = " Provider=MSDASQL.1;Persist Security Info=False;User ID=administator;Extended Properties=DSN=graduate;APP=Visual Basic;WSID=DOU-00EF3663BF0;DATABASE=graduate;Trusted_Connection=Yes;Initial Catalog=graduate"
    '判断字符串中是否含有指定内容
    con.ConnectionTimeout = 30
    con.Open
    If InStr("insert,delete,update", LCase$(sTokens(0))) Then
        '执行查询语句
        con.Execute SQL
        '返回查询信息
        MsgString = sTokens(0) & "query successful"
    Else
        '创建查询对象
        Set rs = New ADODB.Recordset
        '返回查询结果
        rs.CursorLocation = adUseClient
        rs.Open Trim$(SQL), con, adOpenKeyset, adLockOptimistic
        'rs.movelast ' get recordcount
        '返回记录集对象
        Set ExecuteSql = rs ' 将记录集传递给
        MsgString = "查询到" & rs.RecordCount & "条记录"
End If
ExecuteSql_exit:
    'rs及con对象的close在调用函数的程序中关闭
    '清空数据集对象
      Set rs = Nothing
    '中断连接
      Set con = Nothing
      Exit Function
'错误类型判断
ExecuteSql_Error:
      MsgString = "查询错误:" & Err.Description
      MsgBox MsgString, vbOKOnly + vbExclamation, "警告"
      Resume ExecuteSql_exit
End Function