Winsock1_DataArrival 中使用doevents出現Out of stack space錯誤-有解無憂

搞了好久都搞不定Winsock的問題，請大神幫忙：使用Winsock控制元件接收刷卡資料，每秒記錄數大概在5到8條，然后存入到SQL SERVER資料表中，為防止界面卡死，中間使用doevents，但是運行一段時間后在doevents這一行出現“錯誤號：28 錯誤描述：Out of stack space 錯誤源：Rfid 錯誤行號：2061”錯誤，實在搞不懂doevents還會出這個錯？部分代碼:

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error GoTo lblErr:

.....

2060                Me.Text5.Text = strCardNo '卡號

2061                DoEvents

2062                Me.txtAll.Text = strls

...

lblExit:
    Exit Sub
lblErr:


    If Err.Number = 28 Then 'Out of stack space 可能程序的回圈呼叫是造成的堆疊溢位
905    Open App.Path & "\log.txt" For Append As FreeNum
906    Print #FreeNum, "發生錯誤時間：" & Now() & " 錯誤號：" & Err.Number & " 錯誤描述：" & Err.Description & " 錯誤源：" & Err.Source & " 錯誤行號：" & Erl
907    Close FreeNum
910        If cn.State = 1 Then cn.Close
911        cn.Open strconn
        Exit Sub
    End If

uj5u.com熱心網友回復：

DataArrival 是“有資料送達”的時候才觸發。
這個時候應該取走緩沖區中的資料，并做相關的處理。

在這個事件程序中，用不著 DoEvents 吧！

uj5u.com熱心網友回復：

不用DoEvents ，這個界面運行半個小時就無回應了，我這個是要求一年中除了春節那幾天假期之外，其它時間是24小時無休的

uj5u.com熱心網友回復：

用一個FIFO緩沖區……

uj5u.com熱心網友回復：

還帶著行號的代碼，這代碼有點年頭了吧，或者說寫這個代碼的人有點年頭了吧

uj5u.com熱心網友回復：

Winsock1_DataArrival 的完整代碼或者這個doevents前后各20行代碼發出來看看。
估計是有一個回圈在這里吧。基本上你這玩意就是回圈搞死的。猜你是在dataarrival以后回圈等待后續資料了。不加doevents就在里面傻等。加了doevents資料一來就形成嵌套呼叫堆疊兩下半就爆了

uj5u.com熱心網友回復：

僅供參考：

Private Sub tcpRTB_DataArrival(ByVal bytesTotal As Long)

Dim i As Long

Dim p As Long

Dim qn As Long

Dim s As Long

Dim e As Long

Dim Total_Length As Long

Dim iBuf() As Byte

Dim lnx As String

Const STX = 2

Const ETX = 3

Dim L As Long

Dim XORSUM As Long

Dim BYTESUM As Long

Dim strMsgToProcess As String

Dim bt As Long

    On Error Resume Next

    If INtcpRTB_DataArrival Then

        INtcpRTB_DataArrival_TotalBytes = bytesTotal

        if bytesTotal<128 Then

            LogDebug "ReEnter tcpRTB_DataArrival bytesTotal=" + CStr(bytesTotal)

            Exit Sub

        Else

            LogErrMsg "ReEnter tcpRTB_DataArrival bytesTotal=" + CStr(bytesTotal) + ">=128"

        End If

    End If

    bt = bytesTotal

    INtcpRTB_DataArrival = True

REDATA:

'   收當前流

    ReDim iBuf(bt - 1)

    tcpRTB.GetData iBuf

'   log每個收到的位元組

    i = 0

    lnx = "RTB-->BYTE:" + Right("0000000" + Hex(i), 8) + "-"

    For i = 0 To bt - 1

        lnx = lnx + " " + Right("0" + Hex(iBuf(i)), 2)

        If i Mod 16 = 15 Then

            LogRX lnx

            lnx = "RTB-->BYTE:" + Right("0000000" + Hex(i + 1), 8) + "-"

        End If

    Next

    i = bt - 1

    If i Mod 16 <> 15 Then

        LogRX lnx

    End If



'   將本次收到位元組放到接識訓沖區末尾

    For i = 0 To bt - 1

        iRTB(iRTBn + i) = iBuf(i)

    Next

    iRTBn = iRTBn + bt

'   從接識訓沖區中逐個解包

    qn = iRTBn '剩余要解包位元組數

    p = 0 '本次解包的首位元組

    Do

        '0   1    2   3  4   5   6  |7   ...

        'STX-DATA-ETX-XORSUM-BYTESUM|STX-DATA-ETX-XORSUM-BYTESUM|...

        If qn >= 7 Then

            For i = 0 To qn - 1

                 If STX = iRTB(p + i) Then Exit For

            Next

            If i >= qn Then

                For i = 0 To qn - 1

                    iRTB(i) = iRTB(p + i)

                Next

                iRTBn = qn

                Exit Do '找不到STX

            End If

            s = i

            For i = s To qn - 1

                 If ETX = iRTB(p + i) Then Exit For

            Next

            If i >= qn Then

                For i = 0 To qn - 1

                    iRTB(i) = iRTB(p + i)

                Next

                iRTBn = qn

                Exit Do '找不到ETX

            End If

            e = i

            If e - p + 4 >= qn Then

                For i = 0 To qn - 1

                    iRTB(i) = iRTB(p + i)

                Next

                iRTBn = qn

                Exit Do 'ETX之后不足4個位元組

            Endif

            Total_Length = e - s + 5

            L = e - s - 1

            XORSUM = STX

            BYTESUM = STX

            strMsgToProcess = ""

            For i = 1 To L

                XORSUM = XORSUM Xor iRTB(p + s + i)

                BYTESUM = BYTESUM + iRTB(p + s + i)

                strMsgToProcess = strMsgToProcess + ChrW(iRTB(p + s + i))

            Next

            XORSUM = XORSUM Xor ETX

            BYTESUM = BYTESUM + ETX

            If iRTB(p + e + 1) = Asc(Hex((XORSUM Mod 256) \ 16)) And iRTB(p + e + 2) = Asc(Hex(XORSUM Mod 16)) And iRTB(p + e + 3) = Asc(Hex((BYTESUM Mod 256) \ 16)) And iRTB(p + e + 4) = Asc(Hex(BYTESUM Mod 16)) Then

                LogRX "rtb-->" + strMsgToProcess

                RTBput strMsgToProcess

                TimerRTB.Enabled=True

            Else

                LogRX "rtb-->CKSUM error!"

            End If

        NEXTMSG:

            p = p + Total_Length

            qn = qn - Total_Length

            If qn <= 0 Then

                iRTBn = 0

                Exit Do

            End If

        Else

            If p > 0 Then

                If qn > 0 Then

                    For i = 0 To qn - 1

                        iRTB(i) = iRTB(p + i)

                    Next

                End If

                iRTBn = qn

            End If

            Exit Do

        End If

    Loop

    If INtcpRTB_DataArrival_TotalBytes > 0 Then

        bt = INtcpRTB_DataArrival_TotalBytes

        INtcpRTB_DataArrival_TotalBytes = 0

        LogDebug "REDATA bt=" + CStr(bt)

        GoTo REDATA

    End If

    INtcpRTB_DataArrival = False

End Sub

uj5u.com熱心網友回復：

趙四居然能貼出VB代碼，真是難得啊。

uj5u.com熱心網友回復：



代碼行數|代碼檔案

       59|C:\NEW\電話會議\ZzCASClient_source\frmChat.frm

     3188|C:\NEW\電話會議\ZzCASClient_source\frmConfInfo.frm

      222|C:\NEW\電話會議\ZzCASClient_source\frmCreateConf.frm

      230|C:\NEW\電話會議\ZzCASClient_source\frmCreateParty.frm

       75|C:\NEW\電話會議\ZzCASClient_source\frmErasureLock.frm

      109|C:\NEW\電話會議\ZzCASClient_source\frmLineCommand.frm

       90|C:\NEW\電話會議\ZzCASClient_source\frmLog.frm

      904|C:\NEW\電話會議\ZzCASClient_source\frmPartyInfo.frm

      398|C:\NEW\電話會議\ZzCASClient_source\frmQA.frm

     1297|C:\NEW\電話會議\ZzCASClient_source\frmSubConferencing.frm

      548|C:\NEW\電話會議\ZzCASClient_source\frmVoting.frm

      204|C:\NEW\電話會議\ZzCASClient_source\frmWebOpInfo.frm

     9683|C:\NEW\電話會議\ZzCASClient_source\ProgramForm.frm

       49|C:\NEW\電話會議\ZzCASClient_source\clsACCSession.cls

      124|C:\NEW\電話會議\ZzCASClient_source\clsACVSession.cls

       45|C:\NEW\電話會議\ZzCASClient_source\clsBVSession.cls

       44|C:\NEW\電話會議\ZzCASClient_source\clsCNO.cls

       26|C:\NEW\電話會議\ZzCASClient_source\clsLSSession.cls

       27|C:\NEW\電話會議\ZzCASClient_source\clsOVSession.cls

       83|C:\NEW\電話會議\ZzCASClient_source\clsPort.cls

       86|C:\NEW\電話會議\ZzCASClient_source\frmAbout.frm

uj5u.com熱心網友回復：

我學Basic是95年，第一次接觸VB是99年

uj5u.com熱心網友回復：

參考 8 樓 zhao4zhong1 的回復:

Quote: 參考 7 樓 Chen8013 的回復:

趙四居然能貼出VB代碼，真是難得啊。

我寫經典VB6代碼的時候，你可能還沒出生。我猜。
參考:www.xajh.com QQ群：106786637

　胡說八道……

uj5u.com熱心網友回復：

C:\www\MUD.VBP

Type=Exe

Form=MUD.frm

Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\WINDOWS\system32\stdole2.tlb#OLE Automation

Object={C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0; MCI32.OCX

Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX

Object={82351433-9094-11D1-A24B-00A0C932C7DF}#1.5#0; ANIGIF.OCX

Form=MFTP.frm

Object={48E59290-9880-11CF-9754-00AA00C00908}#1.0#0; MSINET.OCX

Object={EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0; shdocvw.dll

Form=MWEB.frm

Form=MMNU.frm

Module=Module1; mmdl.bas

IconForm="Form1"

Startup="Form1"

HelpFile=""

Title="WWW"

ExeName32="WWW.exe"

Command32=""

Name="MUD"

HelpContextID="0"

CompatibleMode="0"

MajorVer=6

MinorVer=7

RevisionVer=2

AutoIncrementVer=0

ServerSupportFiles=0

VersionCompanyName="樂斗士"

VersionFileDescription="互聯網游戲"

VersionProductName="《笑傲江湖-精忠報國》"

CompilationType=-1

OptimizationType=2

FavorPentiumPro(tm)=0

CodeViewDebugInfo=0

NoAliasing=0

BoundsCheck=0

OverflowCheck=0

FlPointCheck=0

FDIVCheck=0

UnroundedFP=0

StartMode=0

Unattended=0

Retained=0

ThreadPerObject=0

MaxNumberOfThreads=1



[MS Transaction Server]

AutoRefresh=1

uj5u.com熱心網友回復：

https://image.baidu.com/search/index?tn=baiduimage&ipn=r&ct=201326592&cl=2&lm=-1&st=-1&fm=index&fr=&hs=0&xthttps=111111&sf=1&fmq=&pv=&ic=0&nc=1&z=&se=1&showtab=0&fb=0&width=&height=&face=0&istype=2&ie=utf-8&word=%E7%AC%91%E5%82%B2%E6%B1%9F%E6%B9%96%E7%B2%BE%E5%BF%A0%E6%8A%A5%E5%9B%BD

uj5u.com熱心網友回復：

因為DoEvents是啟動另一個訊息回圈。你每接到個資料就啟動一個訊息回圈，out of stack是必然的。

正確的辦法是把socket放到作業執行緒里面去。

uj5u.com熱心網友回復：

樓上的是把VB6當成C++來玩啊。

uj5u.com熱心網友回復：

事件大量觸發，導致遞回太深，不然你給doevents前面加上on error resume next吧

uj5u.com熱心網友回復：

參考 16 樓 jiangsheng 的回復:

因為DoEvents是啟動另一個訊息回圈。你每接到個資料就啟動一個訊息回圈，out of stack是必然的。

正確的辦法是把socket放到作業執行緒里面去。

你會用EditBin.exe修改VB6生成的EXE檔案的默認堆疊大小嗎？

uj5u.com熱心網友回復：

有無限遞回的bug的時候跑來跟我說改堆疊大小……不懂別裝懂。

uj5u.com熱心網友回復：

為什么doevents會導致呼叫堆疊溢位，本質是因為doevents的實作的偽代碼是
while(GetMessage(&Msg,NULL,0,0))
{
TranslateMessage(&Msg);
DispatchMessage(&Msg);
}
而
DispatchMessage(&Msg);
內部呼叫了WndProc()
而WndProc呼叫了你觸發事件的處理函式（比如button1_click或者datarecived）
可以想象，當datarecived大量觸發，并且前者沒有執行完，你呼叫了doevents，它呼叫了新的datarecived
如果很多這樣的，堆疊自然就爆了。

蔣老大說的是對的，我只是展開來說一下。

uj5u.com熱心網友回復：

沒有VB，拿VB.net寫一個故意溢位的定時器事件，感受下

uj5u.com熱心網友回復：

添加一個訊息接識訓沖區，用執行緒死回圈遍歷才是正解。

uj5u.com熱心網友回復：

參考 23 樓 u010068569 的回復:

添加一個訊息接識訓沖區，用執行緒死回圈遍歷才是正解。

你懂不懂什么叫“事件通知”啊！

還“死回圈遍歷”！還自詡“正解”！！！

uj5u.com熱心網友回復：

參考 21 樓 caozhy 的回復:

為什么doevents會導致呼叫堆疊溢位，本質是因為doevents的實作的偽代碼是
while(GetMessage(&Msg,NULL,0,0))
{
TranslateMessage(&Msg);
DispatchMessage(&Msg);
}
而
DispatchMessage(&Msg);
內部呼叫了WndProc()
而WndProc呼叫了你觸發事件的處理函式（比如button1_click或者datarecived）
可以想象，當datarecived大量觸發，并且前者沒有執行完，你呼叫了doevents，它呼叫了新的datarecived
如果很多這樣的，堆疊自然就爆了。

蔣老大說的是對的，我只是展開來說一下。

正解

轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/45285.html

標籤：控件

上一篇：如何用vb獲取虎牙彈幕？

下一篇：錄制宏所得資料透視表一直報錯