如何中止数据上传?
我所使用的是VB6.0,我说说易做图作的情况吧:
将运行程序后,在主界面中的下拉菜单中选择这个窗体打开,单机"上传数据"按钮,将数据上传,后来数据上传一半的时候,发现我现在有不想把数据上传了,就单机"退出"按钮,返回到了主界面,想再次打开这个窗体看看的时候,在下拉菜单中单机这个窗体,本来应该是出现窗体的,但是却什么也没有显示.只有将这个程序关闭后重新运行才可以再次打开这个页面.
所以我要上传的数据是以文本文档的形式存在的,
基本步骤是:
打开文本文档->将里面的数据上传到数据库->关闭文档->将文本文档移至备份文件夹->删除原路径下的文本文档
要怎样在数据上传一半的时候中止上传呢?求助!!! 因为你没有贴上传代码，只好猜。如果你的上传操作代码是循环结构的，在循环中加上：
'...
DoEvents
If blnStop Then
Close #1 '关闭文本文件，根据你的打开语句改文件号
'其他停止数据上传的善后操作
Exit Sub
End If
'...
blnStop 是一个窗体级的 Boolean 变量：
Dim blnStop As Boolean
在这个窗体的 Unload 事件中：
Private Sub Form_Unload()
blnStop = True
End Sub 上传数据
Private Sub cmdMoney_Click()
On Error Resume Next
Dim rs As ADODB.Recordset
Dim i As Long
Dim j As Long
Dim oFileObject As Object
Dim strFileName As String
Dim strFolder As String
Dim strRecord As String
Dim strHandsetNo As String
Dim strTerminalNo As String
Dim strCardID As String
Dim strCardType As String
Dim strTradeTime As String
Dim strRecordItem() As String
Dim liItem As ListItem
Dim strFileContent As String
Dim arrFileContent() As String
Dim iRecordCount As Integer
mvarLastError = ""
Dim strTipInfo As String
On Error GoTo errFlag
Set oFileObject = CreateObject("scripting.filesystemobject")
Dim ColResult As Collection '用于判重
'验证文件是否选中
If Not CheckFileSelected Then Exit Sub
If MsgBox("是否开始导入消费数据？", vbOKCancel, "提示信息") = vbCancel Then Exit Sub
strFolder = App.Path
strFolder = Replace(strFolder, "Client\Sub", "HandsetServer\TradeData")
If Mid(strFolder, Len(strFolder), 1) <> "\" And Mid(strFolder, Len(strFolder), 1) <> "/" Then
strFolder = strFolder + "\"
End If
Dim colSQL As Collection
Dim blnHaveFile As Boolean
blnHaveFile = False
j = 0
For i = 1 To lvList.ListItems.Count
If lvList.ListItems(i).Checked = True Then
'更新提示信息
sbMsg.Panels(1).Text = " 文件[" + Replace(lvList.ListItems(i).SubItems(1), strFolder, "") + "]正在进行处理...": DoEvents
strFileName = lvList.ListItems(i).SubItems(1)
Dim FreeNumber As Integer
Dim aa As String
Dim s() As String
If oFileObject.FileExists(strFileName) Then
'获取文件总行数
Open strFileName For Input As #1
strFileContent = StrConv(InputB(LOF(1), 1), vbUnicode)
Close #1
arrFileContent = Split(strFileContent, vbNewLine)
iRecordCount = UBound(arrFileContent) + 1
'打开文件
Open strFileName For Input As #1
If Err.Number <> 0 Then
MsgBox (Err.Description)
Exit Sub
End If
strRecord = ""
ProgressBar.Min = 0
ProgressBar.Max = iRecordCount
ProgressBar.Value = 0
Do Until EOF(1)
Line Input #1, strRecord
If strRecord <> "" Then
strRecord = Trim(strRecord)
strRecordItem = Split(strRecord, "，")
strHandsetNo = strRecordItem(0)
strHandsetNo = Replace(strHandsetNo, "手持机号:", "")
strTerminalNo = strRecordItem(1)
strTerminalNo = Replace(strTerminalNo, "终端机号:", "")
strCardID = strRecordItem(2)
strCardID = Replace(strCardID, "卡号:", "")
strCardType = strRecordItem(3)
strCardType = Replace(strCardType, "卡类:", "")
strTradeTime = strRecordItem(4)
strTradeTime = Replace(Replace(strTradeTime, "交易时间:", ""), ";", "")
strSQL = "Exec pubGenerateTrade "
strSQL = strSQL + "@CardID='" + StdValue(strCardID) + "'," '卡片编号
strSQL = strSQL + "@CardType=" + StdValue(strCardType, stNumber) + "," '卡片类别
strSQL = strSQL + "@HandsetNo=" + StdValue(strHandsetNo, stNumber) + "," '手持机编号
strSQL = strSQL + "@TerminalNo=" + StdValue(strTerminalNo, stNumber) + "," '消费机编号
strSQL = strSQL + "@ClientID=" + mvarConfig.ClientID + "," '客户端编号
strSQL = strSQL + "@TradeTime='" + StdValue(strTradeTime, stDateTime) + "'," '交易时间
strSQL = strSQL + "@OPName='" + mvarConfig.UserName + "'," '操作员
strSQL = strSQL + "@TradeCRC=''" '校验
strCMD = "RunSQLEx," + StrToHex(strSQL)
If mvarDataSource.GetRecordSet(strCMD) = False Then mvarLastError = mvarDataSource.LastError: Exit Do
Set rs = mvarDataSource.ReturnRecordset
If rs!RetCode <> 0 Then
j = j + 1
Set liItem = lvErrorList.ListItems.Add(, , CStr(j))
liItem.SubItems(1) = StdValue(Replace(lvList.ListItems(i).SubItems(1), strFolder, "")) '文件名
liItem.SubItems(2) = StdValue(rs!retMsg)
liItem.SubItems(3) = StdValue(strRecord)
'mvarLastError = rs!retMsg + " 文件名:" + lvList.ListItems(i).SubItems(1) & vbCrLf
'mvarLastError = mvarLastError + strRecord
End If
Set rs = Nothing
End If
If ProgressBar.Value <> iRecordCount Then
ProgressBar.Value = ProgressBar.Value + 1
End If
Loop
'关闭文件
Close #1
If mvarLastError = "" Then
'将文件移至备份文件夹
FileCopy strFileName, strFolder + "TradeDataBak\" & Replace(lvList.ListItems(i).SubItems(1), strFolder, "")
'删除文件
Kill strFileName
Else
MsgBox mvarLastError, vbInformation, "提示信息"
Exit Sub
End If
If strTipInfo = "" Then
strTipInfo = Replace(lvList.ListItems(i).SubItems(1), strFolder, "")
Else
strTipInfo = strTipInfo + "," + Replace(lvList.ListItems(i).SubItems(1), strFolder, "")
End If
End If
End If
Next i
If mvarLastError <> "" Then
MsgBox mvarLastError, vbInformation, "提示信息":
Else
If strTipInfo <> "" Then
MsgBox "消费信息" + strTipInfo + "文件导入成功", vbInformation, "提示信息"
Else
MsgBox "未导入任何文件！", vbInformation, "提示信息"
End If
End If
FillListView
On Error GoTo 0
Exit Sub
errFlag:
MsgBox Err.Description, vbInformation, "提示信息"
End Sub
退出按钮
Private Sub cmdExit_Click()
On Error Resume Next
Set oComm = Nothing
Set oResize = Nothing
Unload Me
On Error GoTo 0
End Sub 这是我的代码,需要怎么改啊??? 首先，把退出按钮代码改了。将 Unload 的处理放在另一个过程中。
Dim blnStop As Boolean, blnBusy As Boolean
Private Sub Exit_Form()
On Error Resume Next
Set oComm = Nothing
Set oResize = Nothing
Unload Me
On Error GoTo 0
End Sub
Private Sub cmdExit_Click()
If blnBusy Then
blnStop = True
Else
Exit_Form
End If
End Sub
其次，在你的上传代码中做一些改动：
......
blnBusy = True
For i = 1 To lvList.ListItems.Count
DoEvents
If blnStop Then
If MsgBox("是否中止导入消费数据？", vbOKCancel, "提示信息") = vbOK Then
Exit_Form
Exit Sub
Else
blnStop = False
End If
End If
......
Do Until EOF(1)
DoEvents
If blnStop Then
If MsgBox("是否中止导入消费数据？", vbOKCancel, "提示信息") = vbOK Then
Close #1
Exit_Form
Exit Sub
Else
blnStop = False
End If
End If
......
Next i
blnBusy = False
......
总体架构是这个样子。调试中可能会有其他问题，一一处理吧。
+1 就是这种中断方式
补充：VB , 数据库(包含打印，安装，报表)
