ehsanocx
جمعه 15 مرداد 1389, 11:10 صبح
53707
با سلام
دوستان برنامه رو که اجرا می کنم با این پیغام مواجه میشم.
دوستان کسی می تونه بگه ایراد کار از کجاست؟
و
برنامه هر دستور رو 2بار اجرا می کنه نمیدونم چرا؟
میشه کمکم کنید.
با تشکر
Option Explicit
Private strBuffer As String 'receive buffer
'Check for success
Private Function IsSuccess(ByVal data As String)
IsSuccess = InStr(data, vbCrLf & "OK" & vbCrLf) > 0
End Function
'Check for comm error
Private Function IsCommError(ByVal data As String)
IsCommError = InStr(data, vbCrLf & "ERROR" & vbCrLf) > 0
End Function
'Check for network error
Private Function IsNetworkError(ByVal data As String)
IsNetworkError = InStr(data, vbCrLf & "+CMS ERROR:") > 0
End Function
'Check for any known error
Private Function IsError(ByVal data As String)
IsError = IsCommError(data) Or IsNetworkError(data)
End Function
'Call this function when response is not the expected one.
'It analyzes the response and displays an appropriate error message if showMessage is True.
Private Sub ErrorDetails(ByVal data As String, Optional ByVal showMessage As Boolean = False)
Dim msg As String
'Check if there is data at all
If Len(data) = 0 Then
msg = "No answer from phone"
Else
'Check if comm error
If IsCommError(data) Then
msg = "Phone returned an error."
Else
'Check if network error
If IsNetworkError(data) Then
msg = "A network error occurred."
Else
'Anything else: Unexpected
msg = "Unexpected response: """ & data & """"
End If
End If
End If
Call Trace(msg)
If showMessage Then Call MsgBox(msg, vbCritical + vbOKOnly)
End Sub
'Ensures that the string contains a success message,
'If not, determines the error details.
Private Function VerifySuccess(ByVal data As String, Optional ByVal showMessage As Boolean = False) As Boolean
VerifySuccess = True
If Not IsSuccess(data) Then
VerifySuccess = False
Call ErrorDetails(data, showMessage)
End If
End Function
'Ensures that the string ends with a specific string.
'If not, determines the error details.
Private Function VerifyEndsWith(ByVal data As String, ByVal endsWith As String, Optional ByVal showMessage As Boolean = False) As Boolean
VerifyEndsWith = True
If InStr(data, endsWith) <> (Len(data) - Len(endsWith) + 1) Then
VerifyEndsWith = False
Call ErrorDetails(data, showMessage)
End If
End Function
'Sends data to the serial port
Private Sub Send(ByVal data As String)
strBuffer = ""
Call Trace("<< " & data)
MSComm1.Output = data
End Sub
'Receives data from the serial port
Private Function Receive() As String
Dim strPart As String
Dim strInput As String
strInput = ""
Do
strPart = ""
Call Delay(1)
strPart = strBuffer
strBuffer = ""
If strPart = "" Then Exit Do
strInput = strInput & strPart
Loop
If strInput <> "" Then Call Trace(">> " & strInput)
Receive = strInput
End Function
'Waits until a success message is received or a timeout occurred.
Private Function WaitForSuccess(ByRef data As String) As Boolean
Dim I As Integer
Dim strInput As String
Dim strPart As String
strInput = ""
'try receive 5 times with 2 seconds delay between
For I = 1 To 5
strPart = Receive
strInput = strInput & strPart
If IsSuccess(strInput) Or IsError(strInput) Then Exit For
If strPart = "" Then
Call Trace("Nothing new received, waiting 2s...")
Call Delay(2)
End If
Next
data = strInput
WaitForSuccess = IsSuccess(strInput)
End Function
Private Sub Trace(ByVal message As String)
Dim strLine As String
strLine = DateTime.Now & " " & message
txtLog.Text = txtLog.Text & strLine & vbCrLf
txtLog.SelStart = Len(txtLog.Text)
End Sub
Private Sub btnSend_Click()
txtLog.Text = ""
btnSend.Enabled = False
btnQuit.Enabled = False
On Error GoTo ErrorHandler
With MSComm1
.CommPort = 2
.Settings = "9600,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeBinary
.InputLen = 0
.PortOpen = True 'must be the last
End With
'Verify connection
Call Send("AT" & vbCrLf)
If Not VerifySuccess(Receive, True) Then GoTo finally
'Enter text mode (phone must support it)
Call Send("AT+CMGF=1" & vbCrLf)
If Not VerifySuccess(Receive, True) Then GoTo finally
'Receive the message
Dim buf As String
Call Send("AT+CMGL=" & Chr(34) & "ALL" & Chr(34) & vbCrLf)
If Not VerifyEndsWith(Receive, "> ", True) Then GoTo finally
GoTo finally
ErrorHandler:
finally:
If MSComm1.PortOpen Then MSComm1.PortOpen = False
btnSend.Enabled = True
btnQuit.Enabled = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Not btnQuit.Enabled Then Cancel = True
End Sub
Private Sub btnQuit_Click()
Call Unload(Me)
End Sub
Private Sub MSComm1_OnComm()
Dim strMessage As String
Select Case MSComm1.CommEvent
' Event messages.
Case comEvReceive
strMessage = StrConv(MSComm1.Input, vbUnicode)
' Error messages.
Case comBreak
strMessage = "[Break Received]"
Case comCDTO
strMessage = "[Carrier Detect Timeout]"
Case comCTSTO
strMessage = "[CTS Timeout]"
Case comDCB
strMessage = "[Error retrieving DCB]"
Case comDSRTO
strMessage = "[DSR Timeout]"
Case comFrame
strMessage = "[Framing Error]"
Case comOverrun
strMessage = "[Overrun Error]"
Case comRxOver
strMessage = "[Receive Buffer Overflow]"
Case comRxParity
strMessage = "[Parity Error]"
Case comTxFull
strMessage = "[Transmit Buffer Full]"
End Select
strBuffer = strBuffer & strMessage
End Sub
Private Sub Delay(ByVal HowLong As Date)
Dim endDate As Date
endDate = DateAdd("s", HowLong, Now)
While endDate > Now
DoEvents 'Allows windows to handle other stuff
Wend
End Sub
با سلام
دوستان برنامه رو که اجرا می کنم با این پیغام مواجه میشم.
دوستان کسی می تونه بگه ایراد کار از کجاست؟
و
برنامه هر دستور رو 2بار اجرا می کنه نمیدونم چرا؟
میشه کمکم کنید.
با تشکر
Option Explicit
Private strBuffer As String 'receive buffer
'Check for success
Private Function IsSuccess(ByVal data As String)
IsSuccess = InStr(data, vbCrLf & "OK" & vbCrLf) > 0
End Function
'Check for comm error
Private Function IsCommError(ByVal data As String)
IsCommError = InStr(data, vbCrLf & "ERROR" & vbCrLf) > 0
End Function
'Check for network error
Private Function IsNetworkError(ByVal data As String)
IsNetworkError = InStr(data, vbCrLf & "+CMS ERROR:") > 0
End Function
'Check for any known error
Private Function IsError(ByVal data As String)
IsError = IsCommError(data) Or IsNetworkError(data)
End Function
'Call this function when response is not the expected one.
'It analyzes the response and displays an appropriate error message if showMessage is True.
Private Sub ErrorDetails(ByVal data As String, Optional ByVal showMessage As Boolean = False)
Dim msg As String
'Check if there is data at all
If Len(data) = 0 Then
msg = "No answer from phone"
Else
'Check if comm error
If IsCommError(data) Then
msg = "Phone returned an error."
Else
'Check if network error
If IsNetworkError(data) Then
msg = "A network error occurred."
Else
'Anything else: Unexpected
msg = "Unexpected response: """ & data & """"
End If
End If
End If
Call Trace(msg)
If showMessage Then Call MsgBox(msg, vbCritical + vbOKOnly)
End Sub
'Ensures that the string contains a success message,
'If not, determines the error details.
Private Function VerifySuccess(ByVal data As String, Optional ByVal showMessage As Boolean = False) As Boolean
VerifySuccess = True
If Not IsSuccess(data) Then
VerifySuccess = False
Call ErrorDetails(data, showMessage)
End If
End Function
'Ensures that the string ends with a specific string.
'If not, determines the error details.
Private Function VerifyEndsWith(ByVal data As String, ByVal endsWith As String, Optional ByVal showMessage As Boolean = False) As Boolean
VerifyEndsWith = True
If InStr(data, endsWith) <> (Len(data) - Len(endsWith) + 1) Then
VerifyEndsWith = False
Call ErrorDetails(data, showMessage)
End If
End Function
'Sends data to the serial port
Private Sub Send(ByVal data As String)
strBuffer = ""
Call Trace("<< " & data)
MSComm1.Output = data
End Sub
'Receives data from the serial port
Private Function Receive() As String
Dim strPart As String
Dim strInput As String
strInput = ""
Do
strPart = ""
Call Delay(1)
strPart = strBuffer
strBuffer = ""
If strPart = "" Then Exit Do
strInput = strInput & strPart
Loop
If strInput <> "" Then Call Trace(">> " & strInput)
Receive = strInput
End Function
'Waits until a success message is received or a timeout occurred.
Private Function WaitForSuccess(ByRef data As String) As Boolean
Dim I As Integer
Dim strInput As String
Dim strPart As String
strInput = ""
'try receive 5 times with 2 seconds delay between
For I = 1 To 5
strPart = Receive
strInput = strInput & strPart
If IsSuccess(strInput) Or IsError(strInput) Then Exit For
If strPart = "" Then
Call Trace("Nothing new received, waiting 2s...")
Call Delay(2)
End If
Next
data = strInput
WaitForSuccess = IsSuccess(strInput)
End Function
Private Sub Trace(ByVal message As String)
Dim strLine As String
strLine = DateTime.Now & " " & message
txtLog.Text = txtLog.Text & strLine & vbCrLf
txtLog.SelStart = Len(txtLog.Text)
End Sub
Private Sub btnSend_Click()
txtLog.Text = ""
btnSend.Enabled = False
btnQuit.Enabled = False
On Error GoTo ErrorHandler
With MSComm1
.CommPort = 2
.Settings = "9600,N,8,1"
.Handshaking = comRTS
.RTSEnable = True
.DTREnable = True
.RThreshold = 1
.SThreshold = 1
.InputMode = comInputModeBinary
.InputLen = 0
.PortOpen = True 'must be the last
End With
'Verify connection
Call Send("AT" & vbCrLf)
If Not VerifySuccess(Receive, True) Then GoTo finally
'Enter text mode (phone must support it)
Call Send("AT+CMGF=1" & vbCrLf)
If Not VerifySuccess(Receive, True) Then GoTo finally
'Receive the message
Dim buf As String
Call Send("AT+CMGL=" & Chr(34) & "ALL" & Chr(34) & vbCrLf)
If Not VerifyEndsWith(Receive, "> ", True) Then GoTo finally
GoTo finally
ErrorHandler:
finally:
If MSComm1.PortOpen Then MSComm1.PortOpen = False
btnSend.Enabled = True
btnQuit.Enabled = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Not btnQuit.Enabled Then Cancel = True
End Sub
Private Sub btnQuit_Click()
Call Unload(Me)
End Sub
Private Sub MSComm1_OnComm()
Dim strMessage As String
Select Case MSComm1.CommEvent
' Event messages.
Case comEvReceive
strMessage = StrConv(MSComm1.Input, vbUnicode)
' Error messages.
Case comBreak
strMessage = "[Break Received]"
Case comCDTO
strMessage = "[Carrier Detect Timeout]"
Case comCTSTO
strMessage = "[CTS Timeout]"
Case comDCB
strMessage = "[Error retrieving DCB]"
Case comDSRTO
strMessage = "[DSR Timeout]"
Case comFrame
strMessage = "[Framing Error]"
Case comOverrun
strMessage = "[Overrun Error]"
Case comRxOver
strMessage = "[Receive Buffer Overflow]"
Case comRxParity
strMessage = "[Parity Error]"
Case comTxFull
strMessage = "[Transmit Buffer Full]"
End Select
strBuffer = strBuffer & strMessage
End Sub
Private Sub Delay(ByVal HowLong As Date)
Dim endDate As Date
endDate = DateAdd("s", HowLong, Now)
While endDate > Now
DoEvents 'Allows windows to handle other stuff
Wend
End Sub