红袍老师的循环暂停，CUP开销大，占用率达到30%-55%。5分钟后FT报：无法处理的故障，Foxtable 停止运行。有没有更好的法子？原代码如下：

Dim Sum As Integer
Dim i As Integer
For i = 1 To 100
     
 Do Until vars("开关") = False

      \'Application.DoEvents

 Loop
     Sum = Sum + i
   
Next
MessageBox.Show("循环结束：" & Sum)

 这个是肯定的，没有人会这样写代码。

 你要在另一个地方改变变量成 vars("开关") = False 才行啊，不然一直死机啊

看看多线程 http://www.foxtable.com/bbs/query.asp?keyword=%B6%E0%CF%DF%B3%CC&boardid=0&sType=7&stable=Dv_bbs1

按红袍老师的指点，写了个例子，存在下面的问题：

1、如何结束后台进程。

2、任务完成后CPU利用率反而升高。

例子：

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:多线程.foxdb

代码：

--窗口按钮事件：

Dim drs As List(Of DataRow)

drs = DataTables("TempTable").Select("[Failure] <= 2 and [success] <= 1 ")

If drs.Count > 0

MessageBox.Show(drs.Count)

Else

    Return

End If

Vars("Thread_ftp") = New System.Threading.Thread(AddressOf NextFor)

LisTemp = new List(Of Object)

For Each dr1 As DataRow In  drs      \'

    Dim pName As Object = dr1("FullPath") & "|" & "医疗质量\\" & FileSys.GetName( dr1("FullPath"))

    LisTemp.add(pName)

Next

Vars("Thread_ftp").Start()

自定义函数

Update

Do While True

    If LisTemp.Count > 0 Then

        Dim ns() As String = LisTemp(0).split("|")

        Dim ftp As new FTPClient

        ftp.Host = ""

        ftp.Account = ""

        ftp.Password = ""

        ftp.Port = 21

        If ftp.Connect

            If FileSys.FileExists(ns(0)) = True

                Dim Val As String

                Val = Rand.NextString(12)

                val = FileSys.GetParentPath(ns(0)) & "\\temp\\" & val

                FileSys.CopyFile(ns(0),val)

                DataTables("TempTable").ReplaceFor("success",2,"FullPath = \'" & ns(0) & "\'")

                If ftp.Upload(val,ns(1),True) = True

                    DataTables("TempTable").ReplaceFor("success",3,"FullPath = \'" & ns(0) & "\'")  \'3为成功,1为失败,0为等待,2为正在上传

                Else

                    DataTables("TempTable").ReplaceFor("success",1,"FullPath = \'" & ns(0) & "\'")

                End If

            Else

                DataTables("TempTable").ReplaceFor("success",1,"FullPath = \'" & ns(0) & "\'")

            End If

        End If

        LisTemp.RemoveAt(0)

    End If

Loop

全局代码

Default

Public LisTemp As new List(Of Object)

NextFor

Public Sub NextFor

Functions.Execute("Update")

End Sub

看看