使用ADO异步调用数据库,在返回RS过程还是会出现假死

[桃花岛黄岛主]

使用ADO异步调用数据库,在返回RS过程还是会出现假死
在执行完rs.Open sql, conn, 1, 1, adAsyncExecute
后会马上触发conn_ExecuteComplete事件,而且事件中使用RS的时候会产生假现象
SQL语句需要大概十分钟才能执行完

请问conn_ExecuteComplete事件不是SQL语句执行完成完才触发的吗,为什么会马上触发
在使用RS的时候产生假死现象呢

代码如下

Me.Label2.Caption = "正在执行SQL语句......"
DoEvents
rs.Open sql, conn, 1, 1, adAsyncExecute
End Sub


Private Sub conn_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)

   
   '生成EXCEL
   Me.Label2.Caption = "正在生成EXCEL文件......"
   DoEvents
   Set e_app = CreateObject("excel.application")
   e_app.Visible = False
   Set e_wkbk = e_app.workbooks.Open(App.Path & "\mb\aaaa.xls")
   Set e_sheet = e_wkbk.sheets(1)
   i = 3
   dt = Mid(Me.Text1.Text, 1, 4) & "年" & Mid(Me.Text1.Text, 5, 2) & "月"
   'Debug.Print rs.RecordCount
   While Not rs.EOF
        e_sheet.cells(i, 1) = dt
        e_sheet.cells(i, 4) = rs(1)
        e_sheet.cells(i, 5) = rs(1)
          i = i + 1
        rs.MoveNext
           DoEvents
   Wend
 e_sheet.cells(i, 1) = dt
   rs.Close
   Set pRecordset = Nothing
   
   e_wkbk.saveas "d:\1.xls"
   e_wkbk.Close
   e_app.quit
    conn.Close
    Set conn = Nothing
   MsgBox "测试成功"

End Sub

[桃花岛黄岛主]

Private Sub rs_FetchComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

现在改成RECORDSET事件,但是不能触发,

[孤独剑_LPZ]

加个完成标志试试

[桃花岛黄岛主]

楼上还请明示

[桃花岛黄岛主]

Dim WithEvents conn As ADODB.Connection
Dim WithEvents rs As ADODB.Recordset


Private Sub Command1_Click()
Set conn = CreateObject("adodb.connection")
strConnectFmt = "Driver={Microsoft ODBC for Oracle}; CONNECTSTRING=(DESCRIPTION=(ADDRESS=(PROTOCOL=tcp) (HOST=10.132.0.5) (PORT=1521))(CONNECT_DATA=(SID=DBETC2)));uid=dbmsta;pwd=xgssoft;"
conn.Open strConnectFmt

Set rs = New ADODB.Recordset

rs.Open "select * from dual", conn, , , adAsyncFetch

End Sub


Private Sub rs_FetchComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

MsgBox "aaaa"
End Sub


我把测试代码贴上来吧

[三断笛]

首先,关于adAsyncFetch和adAsyncExecute,只能使用在客户端游标,微软原话如下:

如果已经将 CursorLocation 属性设置为 adUseClient，就可以采用两种途径之一异步检索行。建议使用的方法是将 Options 设置为 adAsyncFetch。或者，可以使用在 Properties 集合中的“异步行集合处理”动态属性，但如果未将 Options 参数设置为 adAsyncFetch，则可能丢失相关的被检索事件。

因为只能用adUseClient,所以在执行Recordset的Open前,必须设置游标位置在客户端.
如果使用Connection的Execute方法打开游标,则必须在打开连接(connection.open)前,设置游标位置.
虽然文中说"可以采用两种途径之一",但实际上可以用"OR"同时使用两种异步检索.

在上面的前提下可以正常地异步执行和提取,以防止假死.

'添加一个Form和一个Command,引用ADO2.8,并添加一个Datagrid.
Dim WithEvents CONN As ADODB.Connection
Dim WithEvents RS As ADODB.Recordset

Private Sub Command1_Click()
    Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient         '如果是Open方法执行,且Connection未设置游标位置,则此句不可少
    RS.Open "Select * From Sysobjects", CONN, adOpenForwardOnly, adLockReadOnly, adAsyncExecute Or adAsyncFetch
    'Set RS = CONN.Execute("Select * from sysobjects", , adAsyncExecute Or adAsyncFetch)

    While RS.State = adStateExecuting
        DoEvents
        Debug.Print "正在执行"
    Wend
    Debug.Print "执行完毕1" '注意不要MsgBox,否则不会执行ExecuteComplete和FetchProgress和FetchComplete事件
    Set grid1.DataSource = RS
End Sub

Private Sub CONN_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
    Debug.Print "执行完毕2" '注意不要换成MsgBox,否则很可能不会执行FetchProgress和FetchComplete事件
End Sub

Private Sub CONN_WillExecute(Source As String, CursorType As ADODB.CursorTypeEnum, LockType As ADODB.LockTypeEnum, Options As Long, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
   Debug.Print Source
End Sub

Private Sub Form_Load()
    Set CONN = New ADODB.Connection         
    CONN.CursorLocation = adUseClient      '如果用Execute方法执行SQL,则此句不可少
    CONN.Open "Provider=SQLOLEDB.1;User ID=用户名;PWD=密码;Server=服务器地址;Initial Catalog=数据库名"
End Sub

Private Sub RS_FetchComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    MsgBox "读取完毕"
End Sub

Private Sub RS_FetchProgress(ByVal Progress As Long, ByVal MaxProgress As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Debug.Print Progress     '输出提取进度
End Sub

至于为什么调用Msgbox会不执行后面的事件,可能与线程有关.

[三断笛]

防止假死的语句就是在Open后面用While执行Doevents.

[worldy]

rs定义应该改成
dim withevents rs as adodb.recordset

[孤独剑_LPZ]

[Quote=引用 3 楼 wang123kui 的回复:]
楼上还请明示
[/Quote]
不用rs_FetchComplete
把执行sql语句的过程写成函数,成功返回0,
if i=0 then
'想执行的操作
end if

[-晴天]

连接问题吧?

[桃花岛黄岛主]

[Quote=引用 6 楼 asftrhgjhkjlkttttttt 的回复:]
引用 3 楼 wang123kui 的回复:
楼上还请明示

不用rs_FetchComplete
把执行sql语句的过程写成函数,成功返回0,
if i=0 then
'想执行的操作
end if
[/Quote]

汗,我用这个是为了防止UI界面的假死,这有什么用啊

[桃花岛黄岛主]

[Quote=引用 8 楼 xxyj6450 的回复:]
首先,关于adAsyncFetch和adAsyncExecute,只能使用在客户端游标,微软原话如下:


VB code

如果已经将 CursorLocation 属性设置为 adUseClient，就可以采用两种途径之一异步检索行。建议使用的方法是将 Options 设置为 adAsyncFetch。或者，可以使用在 Properties 集合中的“异步行集合处理”动态属性，但如果……
[/Quote]

你的代码完全符合的我要求,我有个问题,为什么在fetchcomplete事件里写完SQL执行完成后工作还是会出现假死呢