Dim mOK
Dim mErr
Dim mResult
Dim doit As Boolean
Dim sdata As String
Private Sub cmdSend_Click()
Dim n
' Setup PictureBox for Scale
List1.Clear
List1.AddItem "Starting..."
' Fire Rx Event Every Byte
MSComm1.RThreshold = 1
' When Inputting Data, Input All Bytes
MSComm1.InputLen = 0
' 19200 Baud, No Parity, 8 Data Bits, 1 Stop Bit
MSComm1.Settings = "19200,N,8,1"
' Make sure DTR line is low to prevent Stamp reset
MSComm1.DTREnable = True
MSComm1.InBufferSize = 32
MSComm1.OutBufferSize = 0
' Open COM1
MSComm1.CommPort = 5
MSComm1.RTSEnable = True
'Me.MSComm1.Handshaking = 2 - comRTS
MSComm1.PortOpen = True
List1.AddItem "Port Opened"
Dim what As Boolean
what = sendIt("AT+CMGF=1", "OK", "ERROR")
If what = True Then
what = sendIt("AT+CMGS=" & Chr(34) & Me.txtMNo & Chr(34), ">", "ERROR")
If what = True Then
n = Now
Me.txtMToSend = Me.txtMsg & n
'MSComm1.Output = Me.txtMsg & n & Chr(26) & Chr(13)
what = sendIt(Me.txtMToSend & Chr(26), "OK", "ERROR")
End If
End If
Me.MSComm1.PortOpen = False
List1.AddItem "Done..."
End Sub
Function sendIt(ByVal s, ByVal ok, ByVal eror, Optional ByVal TOut = 5) As Boolean
mOK = ok
mErr = eror
List1.AddItem "Sending.." & s
MSComm1.Output = s & Chr(13)
Dim p
p = 0.0001 * TOut
doit = False
sdata = ""
Dim dt1 As Date, dt2 As Date
dt1 = Now
Dim p1
While doit = False
dt2 = Now
p1 = (dt2 - dt1)
If p1 >= p Then
List1.AddItem "Timeout..."
doit = True
sendIt = False
Exit Function
End If
DoEvents
Wend
sendIt = True
End Function
Sub wait()
Dim p
p = 0.0005
doit = False
Me.List1.AddItem "Waiting..."
sdata = ""
Dim dt1 As Date, dt2 As Date
dt1 = Now
Dim p1
While doit = False
dt2 = Now
p1 = (dt2 - dt1)
If p1 >= p Then
List1.AddItem "Timeout..."
doit = True
End If
DoEvents
Wend
End Sub
Private Sub MSComm1_OnComm()
List1.AddItem "In OnComm"
Dim sdata1
If MSComm1.CommEvent = comEvReceive Then
sdata1 = MSComm1.Input
sdata = sdata & sdata1
If InStr(sdata, mOK) > 0 Then
doit = True
mResult = "OK"
List1.AddItem "--> " & sdata
ElseIf InStr(sdata, "ERROR") > 0 Then
doit = True
List1.AddItem "Err--->" & sdata
mResult = "ERR"
ElseIf InStr(sdata, ">") > 0 Then
doit = True
List1.AddItem ">>---> " & sdata
mResult = sdata
Else
List1.AddItem "?---> " & sdata
mResult = sdata
End If
End If
End Sub
No comments:
Post a Comment