用VB开发了一个自助终端程序，生成exe文件后，运行一段时间后会自动退出是什么原因呢？（程序一直在待机主界面不进行任何操作）
但是 在自己的电脑上运行，就没有这个问题。
在出问题的电脑上，安装了VB6，然后重新编译exe,还是没有解决该问题。
在出问题的电脑上，不生成exe文件，直接启用，貌似没有自动退出的情况。问题一：想请教各位前辈，有没有遇到过这种情况的，是怎么回事呢？问题二：我改怎么写代码，来记录他自动退出的时候的相关信息，比如，变量值 或者退出时的错误，时间等待机界面代码如下：Private Sub Form_Activate()
On Error Resume Next
DoEvents
Me.Move 0, 0, Screen.Width, Screen.Height
If icdev > 0 Then
st = dc_exit(icdev)
icdev = -1
End If
icdev = -1End SubPrivate Sub Form_Load()
On Error Resume Next
qdbw = "": qdbwh = ""
DoEvents
Me.Move 0, 0, Screen.Width, Screen.Height
If icdev > 0 Then
st = dc_exit(icdev)
icdev = -1
End If
'ShowCursor (0) '隐藏鼠标
icdev = -1yc.Caption = ""
ka = ""
'建立日志文档
pp = Format(Now(), "YYYY-MM-DD")If Dir(CurDir & "\log\", vbDirectory) = "" Then
MkDir CurDir & "\log"
End IfOpen (CurDir & "\log\" & pp) For Append As #5 '建立当天的日志txt文件
Close #5Open (CurDir & "\je") For Append As #2 '建立当天的日志txt文件
Close #2'读取配置文件path = CurDir
mypath = path & "\peizhi.ini"Dim myxz1 As String: Dim myxz2 As String: Dim myxz3 As String: Dim myxz4 As String:: Dim myxz5 As String:: Dim myxz6 As String: Dim myxz7 As String: Dim myxz8 As String: Dim myxz9 As String: 'ip,dk,zdh,bdls,tjxe,yydw,posbh,是否打印
myxz1 = String(255, 0): myxz2 = String(255, 0): myxz3 = String(255, 0): myxz4 = String(255, 0):
:
myxz5 = String(255, 0):: myxz6 = String(255, 0):: myxz7 = String(255, 0)::
: myxz8 = String(255, 0):: myxz9 = String(255, 0)
myxz1 = Space(1024): myxz2 = Space(1024): myxz3 = Space(1024):
myxz4 = Space(1024): myxz5 = Space(1024): myxz6 = Space(1024):
myxz7 = Space(1024): myxz8 = Space(1024):: myxz9 = Space(1024)
GetPrivateProfileString "参数", "xuan1", 0, myxz1, 255, mypath
GetPrivateProfileString "参数", "xuan2", 0, myxz2, 255, mypath
GetPrivateProfileString "参数", "xuan3", 0, myxz3, 255, mypath
GetPrivateProfileString "参数", "xuan4", 0, myxz4, 255, mypath
GetPrivateProfileString "参数", "xuan5", 0, myxz5, 255, mypath
GetPrivateProfileString "参数", "xuan6", 0, myxz6, 255, mypath
GetPrivateProfileString "参数", "xuan7", 0, myxz7, 255, mypath
GetPrivateProfileString "参数", "xuan8", 0, myxz8, 255, mypath
GetPrivateProfileString "参数", "xuan9", 0, myxz9, 255, mypath
ip = Left(myxz1, 14)
dk = Left(myxz2, 4)
zdh = Left(myxz3, 8)
bdls = Left(myxz4, 8)
If bdls = "99999999" Then
bdls = "00000001"
End If
fs = Left(myxz5, 16)
yydw = Val(myxz6)
dy = Val(myxz7)
czy = Left(myxz8, 12)
czsx = Val(myxz9)'''''''''''''''''''''''''''''''''''''''''
Close
MSComm1.CommPort = 1 '固定为串口com1
MSComm1.Settings = "9600,N,8,1" '设置Settings属性
MSComm1.InputMode = comInputModeBinary '访属性用于设置或者返回传输数据的类型 ComInputModeText文本 comInputModeBinary二进制
MSComm1.InputLen = 0 '
MSComm1.InBufferSize = 1024
MSComm1.OutBufferSize = 512
MSComm1.SThreshold = 0 '
MSComm1.RThreshold = 1
MSComm1.OutBufferCount = 0 '清除发送缓冲区
'发送充值签到报文
'发送充资签到报文
p = Format(Now(), "YYYYMMDDhhmmss")
qdbw = ""
qdbw = "000000" & p & "00000000" & "00" & Chr(10) & "00" & "0000000000" & zdh & czy & Chr(10)
Winsock1.CloseWinsock1.Protocol = sckTCPProtocoWinsock1.RemoteHost = ip
Winsock1.LocalPort = 0
Winsock1.RemotePort = dkWinsock1.ConnectTimer1.Interval = 500
Timer1.Enabled = True
End SubPrivate Sub Label1_Click()
Form1.Hide
flash.Show
End SubPrivate Sub Label3_Click()
Me.Timer1.Enabled = False
Form1.Hide
yuchong.ShowEnd Sub
Private Sub Label4_Click()
Timer1.Enabled = False
Me.Hidehaoma.Label3.Caption = "请放卡查询...."
haoma.Label7.Caption = ""haoma.Show
End SubPrivate Sub MSComm1_OnComm()
On Error Resume Next
Dim qz As String
Dim BytesReceived() As Byte
Dim buffer As String
Dim HData As String
Dim i As Integer
Select Case MSComm1.CommEvent
Case comEvReceive '接收十六进制数据。并以十六进制显示
MSComm1.InputLen = 0
buffer = MSComm1.Input '接收数据至字符串中
BytesReceived() = buffer '将数据转入Byte数组中
For i = 0 To UBound(BytesReceived) '显示结果以十六进制显示
If Len(Hex(BytesReceived(i))) = 1 Then
HData = HData & "0" & Hex(BytesReceived(i))
Else
HData = HData & Hex(BytesReceived(i))
End If
'最后将结果后入Text1中
MSComm1.OutBufferCount = 0 '清除发送缓冲区
MSComm1.InBufferCount = 0 '清除接收缓冲区
MSComm1.PortOpen = False
Next
End Select
qz = Left(HData, 2)
Select Case qz
Case "0E"
Me.Hide
yuchong.Show
Case "1C"
Me.Hide
yuchong.Show
Case "1A"
Me.Hide
yuchong.Show
Case "1E"
Me.Hide
yuchong.Show
Case "14"
Me.Hide
yuchong.Show
Case "16"
Me.Hide
yuchong.Show
Case "12"
Me.Hide
yuchong.Show
Case ""
MSComm1.Output = OutBuffer
Sleep (50)
Case Else
'Dim kk
'kk = MsgBox("目前无法打印凭证,是否继续交易", vbYesNo, "提示")
'If kk = 6 Then
'dy = 0
MSComm1.PortOpen = False
'Me.Hide
'yuchong.Show
Me.Hide
tixing.Show
End Select
End SubPrivate Sub Timer1_Timer()
On Error Resume NextIf Winsock1.State = 7 Then
Winsock1.senddata qdbw
End If
If Winsock1.State = 9 Then
Timer1.Interval = 0
Timer1.Enabled = False
End IfEnd Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
qdbwh = ""
Winsock1.GetData qdbwhIf Len(qdbwh) <> 202 Then Call Form_Load
Exit Sub
End If'同步后台时间
'同步本地时间
Call SetComputerTime(Mid(qdbwh, 82, 14))Dim aa As Long
Dim bb As Long
bb = 1
For aa = 0 To 7
lmwkey(aa) = "&H" & Mid(lmkey, bb, 2)
bb = bb + 2
Next aa
End SubPrivate Sub yc_Click()If dy = 1 Then
'检测是否缺纸
Dim que As String
que = "100404"Dim tem As Variant
Dim e As Integer
Dim q As Integer
Dim LenOfText As Integer
LenOfText = Len(que) \ 2 - 1
'ReDim OutBuffer(LenOfText) If Not MSComm1.PortOpen Then
MSComm1.PortOpen = True
End If
q = 0
For e = 1 To Len(que) Step 2
tem = Mid(que, e, 2)
OutBuffer(q) = Val("&H" & tem)
q = q + 1
Next
MSComm1.Output = OutBuffer
Sleep (100)
End IfIf dy = 0 Then
Me.Timer1.Enabled = False
Me.Hide
yuchong.Show
End If
End SubPublic Sub SetComputerTime(ByVal newDate As String)
'同步本地时间
On Error GoTo q
Dim newSysTime As SYSTEMTIME
Dim s() As String
If newDate = " " Then Exit Sub
ReDim s(5) As String
With newSysTime
.wYear = Left(newDate, 4)
.wMonth = Mid(newDate, 5, 2)
.wDay = Mid(newDate, 7, 2)
.wHour = Val(Mid(newDate, 9, 2)) - 8
.wMinute = Mid(newDate, 11, 2)
.wSecond = Mid(newDate, 13, 2)
.wMilliseconds = 0
End With
Call SetSystemTime(newSysTime)
q:
End Sub
但是 在自己的电脑上运行，就没有这个问题。
在出问题的电脑上，安装了VB6，然后重新编译exe,还是没有解决该问题。
在出问题的电脑上，不生成exe文件，直接启用，貌似没有自动退出的情况。问题一：想请教各位前辈，有没有遇到过这种情况的，是怎么回事呢？问题二：我改怎么写代码，来记录他自动退出的时候的相关信息，比如，变量值 或者退出时的错误，时间等待机界面代码如下：Private Sub Form_Activate()
On Error Resume Next
DoEvents
Me.Move 0, 0, Screen.Width, Screen.Height
If icdev > 0 Then
st = dc_exit(icdev)
icdev = -1
End If
icdev = -1End SubPrivate Sub Form_Load()
On Error Resume Next
qdbw = "": qdbwh = ""
DoEvents
Me.Move 0, 0, Screen.Width, Screen.Height
If icdev > 0 Then
st = dc_exit(icdev)
icdev = -1
End If
'ShowCursor (0) '隐藏鼠标
icdev = -1yc.Caption = ""
ka = ""
'建立日志文档
pp = Format(Now(), "YYYY-MM-DD")If Dir(CurDir & "\log\", vbDirectory) = "" Then
MkDir CurDir & "\log"
End IfOpen (CurDir & "\log\" & pp) For Append As #5 '建立当天的日志txt文件
Close #5Open (CurDir & "\je") For Append As #2 '建立当天的日志txt文件
Close #2'读取配置文件path = CurDir
mypath = path & "\peizhi.ini"Dim myxz1 As String: Dim myxz2 As String: Dim myxz3 As String: Dim myxz4 As String:: Dim myxz5 As String:: Dim myxz6 As String: Dim myxz7 As String: Dim myxz8 As String: Dim myxz9 As String: 'ip,dk,zdh,bdls,tjxe,yydw,posbh,是否打印
myxz1 = String(255, 0): myxz2 = String(255, 0): myxz3 = String(255, 0): myxz4 = String(255, 0):
:
myxz5 = String(255, 0):: myxz6 = String(255, 0):: myxz7 = String(255, 0)::
: myxz8 = String(255, 0):: myxz9 = String(255, 0)
myxz1 = Space(1024): myxz2 = Space(1024): myxz3 = Space(1024):
myxz4 = Space(1024): myxz5 = Space(1024): myxz6 = Space(1024):
myxz7 = Space(1024): myxz8 = Space(1024):: myxz9 = Space(1024)
GetPrivateProfileString "参数", "xuan1", 0, myxz1, 255, mypath
GetPrivateProfileString "参数", "xuan2", 0, myxz2, 255, mypath
GetPrivateProfileString "参数", "xuan3", 0, myxz3, 255, mypath
GetPrivateProfileString "参数", "xuan4", 0, myxz4, 255, mypath
GetPrivateProfileString "参数", "xuan5", 0, myxz5, 255, mypath
GetPrivateProfileString "参数", "xuan6", 0, myxz6, 255, mypath
GetPrivateProfileString "参数", "xuan7", 0, myxz7, 255, mypath
GetPrivateProfileString "参数", "xuan8", 0, myxz8, 255, mypath
GetPrivateProfileString "参数", "xuan9", 0, myxz9, 255, mypath
ip = Left(myxz1, 14)
dk = Left(myxz2, 4)
zdh = Left(myxz3, 8)
bdls = Left(myxz4, 8)
If bdls = "99999999" Then
bdls = "00000001"
End If
fs = Left(myxz5, 16)
yydw = Val(myxz6)
dy = Val(myxz7)
czy = Left(myxz8, 12)
czsx = Val(myxz9)'''''''''''''''''''''''''''''''''''''''''
Close
MSComm1.CommPort = 1 '固定为串口com1
MSComm1.Settings = "9600,N,8,1" '设置Settings属性
MSComm1.InputMode = comInputModeBinary '访属性用于设置或者返回传输数据的类型 ComInputModeText文本 comInputModeBinary二进制
MSComm1.InputLen = 0 '
MSComm1.InBufferSize = 1024
MSComm1.OutBufferSize = 512
MSComm1.SThreshold = 0 '
MSComm1.RThreshold = 1
MSComm1.OutBufferCount = 0 '清除发送缓冲区
'发送充值签到报文
'发送充资签到报文
p = Format(Now(), "YYYYMMDDhhmmss")
qdbw = ""
qdbw = "000000" & p & "00000000" & "00" & Chr(10) & "00" & "0000000000" & zdh & czy & Chr(10)
Winsock1.CloseWinsock1.Protocol = sckTCPProtocoWinsock1.RemoteHost = ip
Winsock1.LocalPort = 0
Winsock1.RemotePort = dkWinsock1.ConnectTimer1.Interval = 500
Timer1.Enabled = True
End SubPrivate Sub Label1_Click()
Form1.Hide
flash.Show
End SubPrivate Sub Label3_Click()
Me.Timer1.Enabled = False
Form1.Hide
yuchong.ShowEnd Sub
Private Sub Label4_Click()
Timer1.Enabled = False
Me.Hidehaoma.Label3.Caption = "请放卡查询...."
haoma.Label7.Caption = ""haoma.Show
End SubPrivate Sub MSComm1_OnComm()
On Error Resume Next
Dim qz As String
Dim BytesReceived() As Byte
Dim buffer As String
Dim HData As String
Dim i As Integer
Select Case MSComm1.CommEvent
Case comEvReceive '接收十六进制数据。并以十六进制显示
MSComm1.InputLen = 0
buffer = MSComm1.Input '接收数据至字符串中
BytesReceived() = buffer '将数据转入Byte数组中
For i = 0 To UBound(BytesReceived) '显示结果以十六进制显示
If Len(Hex(BytesReceived(i))) = 1 Then
HData = HData & "0" & Hex(BytesReceived(i))
Else
HData = HData & Hex(BytesReceived(i))
End If
'最后将结果后入Text1中
MSComm1.OutBufferCount = 0 '清除发送缓冲区
MSComm1.InBufferCount = 0 '清除接收缓冲区
MSComm1.PortOpen = False
Next
End Select
qz = Left(HData, 2)
Select Case qz
Case "0E"
Me.Hide
yuchong.Show
Case "1C"
Me.Hide
yuchong.Show
Case "1A"
Me.Hide
yuchong.Show
Case "1E"
Me.Hide
yuchong.Show
Case "14"
Me.Hide
yuchong.Show
Case "16"
Me.Hide
yuchong.Show
Case "12"
Me.Hide
yuchong.Show
Case ""
MSComm1.Output = OutBuffer
Sleep (50)
Case Else
'Dim kk
'kk = MsgBox("目前无法打印凭证,是否继续交易", vbYesNo, "提示")
'If kk = 6 Then
'dy = 0
MSComm1.PortOpen = False
'Me.Hide
'yuchong.Show
Me.Hide
tixing.Show
End Select
End SubPrivate Sub Timer1_Timer()
On Error Resume NextIf Winsock1.State = 7 Then
Winsock1.senddata qdbw
End If
If Winsock1.State = 9 Then
Timer1.Interval = 0
Timer1.Enabled = False
End IfEnd Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
qdbwh = ""
Winsock1.GetData qdbwhIf Len(qdbwh) <> 202 Then Call Form_Load
Exit Sub
End If'同步后台时间
'同步本地时间
Call SetComputerTime(Mid(qdbwh, 82, 14))Dim aa As Long
Dim bb As Long
bb = 1
For aa = 0 To 7
lmwkey(aa) = "&H" & Mid(lmkey, bb, 2)
bb = bb + 2
Next aa
End SubPrivate Sub yc_Click()If dy = 1 Then
'检测是否缺纸
Dim que As String
que = "100404"Dim tem As Variant
Dim e As Integer
Dim q As Integer
Dim LenOfText As Integer
LenOfText = Len(que) \ 2 - 1
'ReDim OutBuffer(LenOfText) If Not MSComm1.PortOpen Then
MSComm1.PortOpen = True
End If
q = 0
For e = 1 To Len(que) Step 2
tem = Mid(que, e, 2)
OutBuffer(q) = Val("&H" & tem)
q = q + 1
Next
MSComm1.Output = OutBuffer
Sleep (100)
End IfIf dy = 0 Then
Me.Timer1.Enabled = False
Me.Hide
yuchong.Show
End If
End SubPublic Sub SetComputerTime(ByVal newDate As String)
'同步本地时间
On Error GoTo q
Dim newSysTime As SYSTEMTIME
Dim s() As String
If newDate = " " Then Exit Sub
ReDim s(5) As String
With newSysTime
.wYear = Left(newDate, 4)
.wMonth = Mid(newDate, 5, 2)
.wDay = Mid(newDate, 7, 2)
.wHour = Val(Mid(newDate, 9, 2)) - 8
.wMinute = Mid(newDate, 11, 2)
.wSecond = Mid(newDate, 13, 2)
.wMilliseconds = 0
End With
Call SetSystemTime(newSysTime)
q:
End Sub
On Error Resume Next
取消掉？
on error goto errHandle
…… exit sub'(function)
errHandle:
msgbox err.number & ", " & err.Description