QUECTEL GSM Modem M95-開発経験

Private Sub RunScript() Dim sRet, sTemp As String Dim timeStart As Date Dim timeStop As Date Dim nTime As Double = 0 Dim nCount As Integer Dim tSpan As TimeSpan Dim serialStatus As Boolean = SerialPortA.IsOpen Dim seansOpen As Boolean = False Dim sBlock440 As String = "operations$öûâðëéîð÷ñéðöâéîðó2837âí2àãïëöãéïàöëäî3ïðàëîöíóïàùã34ïàùãà4óíïùöãíï4àêãùíöïùøãí4ïàùãöóåïàêãöù4ïàùãø4íïàùöã4íïàêùö6å4ê6åïöøãíàïö4ùïåàöùàïöùãà4ïöùã47ïåàêùöïù4ãïàøöãàï4ùãï4àùãöïàùöãï4àøùã6ï4àùãö4ïåàøãöï64àøã46ïà6öïàø76ö4ïàäöãàïíöãøíïuiowq3ygrowg3fowrtgowufygbow4gfowueyfgco6wt4go68gfrwkuyfcgwkgy4ckuw4ygfouwygou4fgrfouwf4gow4grfw4yofgowu4ygfou4fgwo4uygfwy4gfow4g4gfowufgou4rgyfwuyfguwygf4uyg4f6gfiu4gklejhdkwehfewhrkferhiuht43iuhiur" '         Dim nDisconnect As Integer = 0 Dim nMinTimeA, nMinTimeB, nMaxTimeA, nMaxTimeB, nEvgTimeA, nEvgTimeB As Integer Dim nSendAttemptA, nSendAttemptB, nLostPackA, nLostPackB As Integer Dim nSendSuccA, nSendSuccB As Integer Dim nLostConnect As Integer = 0 Dim timeSummary As Double = 0 Dim timeSummaryMin As Double = 0 Dim timeSummaryMax As Double = 0 Dim timeSummaryEvg As Double = 0 _allowRun = True _allowEcho = True _ReadBuff = "" _lastClear = False _lastLine = "" nMinTimeA = 0 nMinTimeB = 0 nMaxTimeA = 0 nMaxTimeB = 0 nEvgTimeA = 0 nEvgTimeB = 0 nSendAttemptA = 0 nSendAttemptB = 0 nLostPackA = 0 nLostPackB = 0 nSendSuccA = 0 nSendSuccB = 0 '   MessPull.ClearMessage() MessPull.AllowCMEErrorIntercept = True MessPull.AllowFuncIntercept = True MessPull.AllowSMSErrorIntercept = True MessPull.DropCME_Error() MessPull.DropSMS_Error() '   Dim record As New StreamWriter(Application.StartupPath & "\Default.log") Me.WriteToConsole("Script started at " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Script started at " + DateTime.Now.ToLongTimeString + "!") If Not SerialPortA.IsOpen Then Try SerialPortA.Open() Catch Me.WriteToConsole("Serial Port: " + SerialPortA.PortName + " is busy! Script stopped at: " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Serial Port: " + SerialPortA.PortName + " is busy! Script stopped at: " + DateTime.Now.ToLongTimeString + "!") _allowRun = False End Try End If '   If _allowRun Then nCount = 0 sTemp = "" MessPull.ClearMessage() While ((InStr(sTemp, "OK") = 0) And _allowRun) nCount += 1 sTemp = MessPull.ExecuteAT(SerialPortA, "AT" + vbCrLf, 3000) Me.WriteToConsole("Attempt: " + Str(nCount) + " Send: " + sTemp) End While Me.DisplayFunc() '   Me.WriteToConsole("Turn on the modem!" + vbCrLf) If Not MessPull.CheckAndSetup(SerialPortA, "AT+CFUN?", "CFUN", "1", , , , , "AT+CFUN=1", "Call Ready", 15000) Then Me.WriteToConsole("Modem does not turn on! Script Aborted!" + vbCrLf) _allowRun = False Else '    Me.WriteToConsole(MessPull.ExecuteAT(SerialPortA, "ATE1", 3000)) MessPull.CheckAndSetup(SerialPortA, "AT+CREG?", "CREG", "1", 0, ",", "OK", 1000, "AT+CREG=1", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+CGREG?", "CGREG", "1", 0, ",", "OK", 1000, "AT+CGREG=1", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+CRC?", "CRC", "0", 0, ",", "OK", 1000, "AT+CRC=0", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QAUDCH?", "QAUDCH", "2", 0, ",", "OK", 1000, "AT+QAUDCH=2", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QIFGCNT?", "QIFGCNT", "1", 0, ",", "OK", 1000, "AT+QIFGCNT=1", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QICSGP?", "QICSGP", "1", 0, ",", "OK", 1000, "AT+QICSGP=" + _QICSGP, "OK", 5000) End If Me.DisplayFunc() End If While _allowRun While _allowRun If (MessPull.CheckAndSetup(SerialPortA, "AT+CREG?", "CREG", "1", 1) And MessPull.CheckAndSetup(SerialPortA, "AT+CGREG?", "CGREG", "1", 1)) Then Exit While End If Me.DisplayFunc() End While Me.DisplayFunc() Me.WriteToConsole("Modem is registered on the home network at: " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Modem is registered on the home network at: " + DateTime.Now.ToLongTimeString + "!") '    While (_allowRun And (Not seansOpen = True)) Me.DisplayFunc() Me.WriteToConsole(MessPull.ExecuteAT(SerialPortA, "AT+QISTAT", 2000) + vbCrLf) 'MessPull.WaitAnswer(SerialPortA, 5000, "", False) 'record.WriteLine("Request status at: " + DateTime.Now.TimeOfDay.ToString + "!") sRet = MessPull.GetFuncValue("STATE") Select Case sRet Case "IP INITIAL" MessPull.CheckAndSetup(SerialPortA, "AT+QISDE?", "QISDE", "0", 0, ",", "OK", 1000, "AT+QISDE = 0", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QIMUX?", "QIMUX", "0", 0, ",", "OK", 1000, "AT+QIMUX = 0", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QIMODE?", "QIMODE", "0", 0, ",", "OK", 1000, "AT+QIMODE=0", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QIDNSIP?", "QIDNSIP", "0", 0, ",", "OK", 1000, "AT+QIDNSIP=0", 5000) If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QIREGAPP", 1000, "OK|ERROR"), "OK") > 0 Then Me.WriteToConsole("Can not register application on network! Next Attempt!" + vbCrLf) record.WriteLine("Can't Activate GPRS/CSD context! Next Attempt!") End If Case "IP START" If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QIACT", 1000, "OK|ERROR"), "OK") > 0 Then Me.WriteToConsole("Can't Activate GPRS/CSD context! Next Attempt!" + vbCrLf) record.WriteLine("Can't Activate GPRS/CSD context! Next Attempt!") End If Case "IP GPRSACT" If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QILOCIP", 2000, "."), ".") > 0 Then Me.WriteToConsole("Can't Get local IP addres!" + vbCrLf) record.WriteLine("Can't Get local IP addres!") End If Case "IP STATUS" If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QIOPEN=" + _QIOPEN, 5000, "OK"), "OK") > 0 Then seansOpen = True Else Me.WriteToConsole("Can not estabilish connect!" + vbCrLf) record.WriteLine("Can not estabilish connect!") seansOpen = False End If Case "IP CLOSE" MessPull.ExecuteAT(SerialPortA, "AT+QIDEACT", 5000, "DEACT OK") Me.WriteToConsole("Deactivate GPRS/CSD context!" + vbCrLf) record.WriteLine("Deactivate GPRS/CSD context!") seansOpen = False Case "CONNECT OK" seansOpen = True Me.WriteToConsole("Connection OK!" + vbCrLf) record.WriteLine("Connection OK!") Case "PDP DEACT" Me.WriteToConsole("GPRS/CSD context was deactivated because of unknown reason. Reconnecting!" + vbCrLf) record.WriteLine("GPRS/CSD context was deactivated because of unknown reason. Reconnecting!") If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QIACT", 1000, "OK|ERROR"), "OK") > 0 Then Me.WriteToConsole("Can't Activate GPRS/CSD context! Next Attempt!" + vbCrLf) record.WriteLine("Can't Activate GPRS/CSD context! Next Attempt!") End If Case "TCP CONNECTING" Sleep(800) Case Else Me.WriteToConsole("Connection status: " + sRet + vbCrLf) record.WriteLine("Connection status: " + sRet) End Select Me.WriteToConsole("Connection status: " + sRet + vbCrLf) Me.DisplayFunc() End While While (seansOpen And _allowRun) MessPull.ClearMessage() MessPull.ExecuteAT(SerialPortA, "AT+QISTAT") timeSummary = 0 nSendAttemptA += 1 timeStart = Now sRet = Trim(MessPull.ExecuteAT(SerialPortA, "AT+QISEND=8", 3000, ">", False)) 'Me.WriteToConsole("Time execution AT+QISEND=8" + MessPull.LastTimeRun.ToString + vbCrLf) If InStr(sRet, ">") > 0 Then sRet = MessPull.ExecuteAT(SerialPortA, "balance$", 3000, "SEND OK", False) 'Me.WriteToConsole("Time execution [balance$]" + MessPull.LastTimeRun.ToString + vbCrLf) If InStr(sRet, "SEND OK") > 0 Then _nCharWait = 40 sRet = MessPull.WaitAnswer(SerialPortA, 10000, "balance>................................", , False) If sRet = "balance>................................" Then Me.WriteToConsole(vbCrLf) timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds timeSummary = tSpan.TotalMilliseconds nMinTimeA = IIf(nMinTimeA = 0, nTime, IIf(nMinTimeA > nTime, nTime, nMinTimeA)) nMaxTimeA = IIf(nMaxTimeA = 0, nTime, IIf(nMaxTimeA < nTime, nTime, nMaxTimeA)) nEvgTimeA = IIf(nEvgTimeA = 0, nTime, (nTime + nEvgTimeA) / 2) nSendSuccA += 1 '     nSendAttemptB += 1 timeStart = Now sRet = Trim(MessPull.ExecuteAT(SerialPortA, "AT+QISEND=440", 3000, ">", False)) 'Me.WriteToConsole("Time execution AT+QISEND=440" + MessPull.LastTimeRun.ToString + vbCrLf) If InStr(sRet, ">") > 0 Then MessPull.ClearMessage() _nCharWait = 4 sRet = MessPull.ExecuteAT(SerialPortA, sBlock440, 5000, "SEND OK", False) If InStr(sRet, "SEND OK") > 0 Then sRet = MessPull.WaitAnswer(SerialPortA, 10000, "done", , False) If InStr(sRet, "done") > 0 Then timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds timeSummary = timeSummary + tSpan.TotalMilliseconds nMinTimeB = IIf(nMinTimeB = 0, nTime, IIf(nMinTimeB > nTime, nTime, nMinTimeB)) nMaxTimeB = IIf(nMaxTimeB = 0, nTime, IIf(nMaxTimeB < nTime, nTime, nMaxTimeB)) nEvgTimeB = IIf(nEvgTimeB = 0, nTime, (nTime + nEvgTimeB) / 2) nSendSuccB += 1 Me.WriteToConsole(vbCrLf) Me.WriteToConsole("Cycle Ok. Time: " + timeSummary.ToString + vbCrLf) record.WriteLine("Cycle Ok. Time: " + timeSummary.ToString) timeSummaryMin = IIf(timeSummaryMin = 0, timeSummary, IIf(timeSummaryMin > timeSummary, timeSummaryMin, timeSummaryMin)) timeSummaryMax = IIf(timeSummaryMax = 0, timeSummary, IIf(timeSummaryMax < timeSummary, timeSummary, timeSummaryMax)) timeSummaryEvg = IIf(timeSummaryEvg = 0, timeSummary, (timeSummary + timeSummaryEvg) / 2) Else nLostPackB += 1 Me.WriteToConsole("Not Answer (440 byte). Time: " + nTime.ToString + vbCrLf) record.WriteLine("Not Answer (440 byte). Time: " + nTime.ToString) End If Else Me.WriteToConsole("Unsuccessfully send Data Pack (440 byte). Time: " + nTime.ToString + vbCrLf) record.WriteLine("Unsuccessfully send Data Pack (440 byte). Time: " + nTime.ToString) End If Else timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds Me.WriteToConsole("Error execute command AT+QISEND=440. Time: " + nTime.ToString + vbCrLf) record.WriteLine("Error execute command AT+QISEND=440. Time: " + timeSummary.ToString) End If Else timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds nLostPackA += 1 Me.WriteToConsole("Unsuccessfully execute command [balance$]. Time: " + nTime.ToString + vbCrLf) record.WriteLine("Unsuccessfully execute command [balance$]. Time: " + nTime.ToString) End If Else Me.WriteToConsole("Unsuccessfully send command [balance$]. Time: " + nTime.ToString + vbCrLf) record.WriteLine("Unsuccessfully send command [balance$]. Time: " + nTime.ToString) MessPull.ExecuteAT(SerialPortA, "AT", 3000, "") MessPull.ExecuteAT(SerialPortA, "AT", 3000, "") timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds End If Else MessPull.ExecuteAT(SerialPortA, "AT", 3000, "") Me.WriteToConsole("Error execute command AT+QISEND=8!" + vbCrLf) record.WriteLine("Error execute command AT+QISEND=8!") End If MessPull.SetFuncValue("CounterA", nSendAttemptA.ToString) MessPull.SetFuncValue("CounterB", nSendAttemptB.ToString) MessPull.SetFuncValue("AverageTimeA", nEvgTimeA.ToString) MessPull.SetFuncValue("AverageTimeB", nEvgTimeB.ToString) Me.DisplayFunc() If Not MessPull.GetFuncValue("STATE") = "CONNECT OK" Then nLostConnect += 1 seansOpen = False Me.WriteToConsole("Connection lost at: " + DateTime.Now.ToLongTimeString + vbCrLf) record.WriteLine("Connection lost at: " + DateTime.Now.ToLongTimeString) Me.WriteToConsole("Attempt to reconnect." + vbCrLf) record.WriteLine("Attempt to reconnect.") End If Sleep(2000) End While End While MessPull.ExecuteAT(SerialPortA, "AT+QICLOSE", 5000, "CLOSE OK|ERROR") MessPull.ExecuteAT(SerialPortA, "AT+QIDEACT", 5000, "DEACT OK|ERROR") Me.WriteToConsole("Connection Closed and GPRS/CSD context was deactivated at: " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Connection Closed and GPRS/CSD context was deactivated at: " + DateTime.Now.ToLongTimeString + "!") Me.WriteToConsole("---------------------------------------------------------------------------------------------" + vbCrLf) record.WriteLine("---------------------------------------------------------------------------------------------") Me.WriteToConsole("Execution repport:" + vbCrLf) record.WriteLine("Execution repport:") Me.WriteToConsole("[balance$] request MIN time (milliseconds): " + nMinTimeA.ToString + vbCrLf) record.WriteLine("[balance$] request MIN time (milliseconds): " + nMinTimeA.ToString) Me.WriteToConsole("[balance$] request MAX time (milliseconds): " + nMaxTimeA.ToString + vbCrLf) record.WriteLine("[balance$] request MAX time (milliseconds): " + nMaxTimeA.ToString) Me.WriteToConsole("[balance$] request AVERAGE time (milliseconds): " + nEvgTimeA.ToString + vbCrLf) record.WriteLine("[balance$] request AVERAGE time (milliseconds): " + nEvgTimeA.ToString) Me.WriteToConsole(vbCrLf) record.WriteLine("") Me.WriteToConsole("[440 byte pack] request MIN time (milliseconds): " + nMinTimeB.ToString + vbCrLf) record.WriteLine("[440 byte pack] request MIN time (milliseconds): " + nMinTimeB.ToString) Me.WriteToConsole("[440 byte pack] request MAX time (milliseconds): " + nMaxTimeB.ToString + vbCrLf) record.WriteLine("[440 byte pack] request MAX time (milliseconds): " + nMaxTimeB.ToString) Me.WriteToConsole("[440 byte pack] request AVERAGE time (milliseconds): " + nEvgTimeB.ToString + vbCrLf) record.WriteLine("[440 byte pack] request AVERAGE time (milliseconds): " + nEvgTimeB.ToString) Me.WriteToConsole(vbCrLf) record.WriteLine("") Me.WriteToConsole("Summary request MIN time (milliseconds): " + timeSummaryMin.ToString + vbCrLf) record.WriteLine("Summary request MIN time (milliseconds): " + timeSummaryMin.ToString) Me.WriteToConsole("Summary request MAX time (milliseconds): " + timeSummaryMax.ToString + vbCrLf) record.WriteLine("Summary request MAX time (milliseconds): " + timeSummaryMax.ToString) Me.WriteToConsole("Summary request AVERAGE time (milliseconds): " + timeSummaryEvg.ToString + vbCrLf) record.WriteLine("Summary request AVERAGE time (milliseconds): " + timeSummaryEvg.ToString) Me.WriteToConsole(vbCrLf) record.WriteLine("") Me.WriteToConsole("Total send attempt command [balance$]: " + nSendAttemptA.ToString + vbCrLf) record.WriteLine("Total send attempt command [balance$]: " + nSendAttemptA.ToString) Me.WriteToConsole("Total send attempt packet [440 byte]: " + nSendAttemptB.ToString + vbCrLf) record.WriteLine("Total send attempt packet [440 byte]: " + nSendAttemptB.ToString) Me.WriteToConsole("Total send succes [balance$]: " + nSendSuccA.ToString + vbCrLf) record.WriteLine("Total send succes [balance$]: " + nSendSuccA.ToString) Me.WriteToConsole("Total send succes [440 byte]: " + nSendSuccB.ToString + vbCrLf) record.WriteLine("Total send succes [440 byte]: " + nSendSuccB.ToString) Me.WriteToConsole(vbCrLf) record.WriteLine("") Me.WriteToConsole("Lost packet [balanse$]: " + nLostPackA.ToString + vbCrLf) record.WriteLine("Lost packet [balanse$]: " + nLostPackA.ToString) Me.WriteToConsole("Lost packet [440 byte]: " + nLostPackB.ToString + vbCrLf) record.WriteLine("Lost packet [440 byte]: " + nLostPackB.ToString) Me.WriteToConsole("---------------------------------------------------------------------------------------------" + vbCrLf) record.WriteLine("---------------------------------------------------------------------------------------------") Me.WriteToConsole("Script stopped at: " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Script stopped at: " + DateTime.Now.ToLongTimeString + "!") record.Close() '   If Not serialStatus Then SerialPortA.Close() End If '    _allowEcho = True End Sub
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

 Imports System Imports System.Object Imports System.Collections Imports System.Threading.Thread Imports System.IO.Ports Module ScriptRun 'Public Enum AnswerStatus As Integer ' Reciv_Nothing = 0 ' Reciv_OK = 1 ' Reciv_Send = 2 ' Reciv_Func = 4 ' Reciv_Mess = 8 ' Reciv_CME_ERROR = 16 ' Reciv_ERROR = 32 ' Reciv_TimeOut = 256 'End Enum Public Class MessPull #Region "Declaration Block" Private Shared msgList As String() = {} '  ,    '#Private Shared AnsModem As AnswerStatus '    AnswerStatus Private Shared _funcTable As New Hashtable() '    +:  Private Shared _Recieved As Boolean '     - True '#Private Shared _messTable As New Hashtable() '   +  '    ,       ,   '    -    - _funcVal Private Shared _funcIntercept As Boolean = True '   "+FUNC: VALUE" Private Shared _EchoIntegcept As Boolean = True '      (  ATE0) Private Shared _cmeIntercept As Boolean = True '     "+CME ERROR: XXX" Private Shared _smsIntercept As Boolean = True '     "+SMS ERROR: XXX" Private Shared _cmeError As Boolean = False ' -  "+CME ERROR: XXX" Private Shared _smsError As Boolean = False ' -  "+SMS ERROE: XXX" Private Shared _cmeLastError As Integer = -1 '  "+CME ERROR:" Private Shared _smsLastError As Integer = -1 '  "+SMS ERROR:" Private Shared _lastCommand As String = "" '    '    Private Shared startTime, stopTime As Date '   TimeOut-    Private Shared tSpan As TimeSpan '  TimeOut,    Private Shared _lastTRun As Integer '   TimeOut- Private Shared _timeOut As Boolean ' TimeOut   TimeOut- '   SyncLock,       Private Shared blockSync As New Object Public Shared URCMessageList() As String = {"RING", _ "MO RING", _ "MO CONNECTED", _ "Call Ready", _ "CCWV", _ "RDY", _ "NORMAL POWER DOWN", _ "UNDER_VOLTAGE WARNING", _ "UNDER_VOLTAGE POWER DOWN", _ "OVER_VOLTAGE WARNING", _ "OVER_VOLTAGE POWER DOWN"} #End Region #Region "Property definition Block" Public Shared ReadOnly Property FuncTable As Hashtable Get SyncLock blockSync Return _funcTable End SyncLock End Get End Property Public Shared ReadOnly Property MessageRecieved As Boolean Get SyncLock blockSync Return _Recieved End SyncLock End Get End Property Public Shared ReadOnly Property LastTimeRun() As Integer Get SyncLock blockSync Return _lastTRun End SyncLock End Get End Property Public Shared ReadOnly Property TimeOutState() As Boolean Get SyncLock blockSync Return _timeOut End SyncLock End Get End Property Public Shared Property AllowFuncIntercept() As Boolean Get SyncLock blockSync Return _funcIntercept End SyncLock End Get Set(value As Boolean) SyncLock blockSync _funcIntercept = value End SyncLock End Set End Property Public Shared Property AllowEchoIntercept() As Boolean Get SyncLock blockSync Return _EchoIntegcept End SyncLock End Get Set(value As Boolean) SyncLock blockSync _EchoIntegcept = value End SyncLock End Set End Property Public Shared Property AllowCMEErrorIntercept() As Boolean Get SyncLock blockSync Return _cmeIntercept End SyncLock End Get Set(value As Boolean) SyncLock blockSync _cmeIntercept = value End SyncLock End Set End Property Public Shared Property AllowSMSErrorIntercept() As Boolean Get SyncLock blockSync Return _smsIntercept End SyncLock End Get Set(value As Boolean) SyncLock blockSync _smsIntercept = value End SyncLock End Set End Property Public Shared ReadOnly Property LastCME_Error() As Boolean Get SyncLock blockSync Return _cmeLastError End SyncLock End Get End Property Public Shared ReadOnly Property LastSMS_Error() As String Get SyncLock blockSync Return _smsLastError End SyncLock End Get End Property Public Shared Property LastCommand() As String Get SyncLock blockSync Return _lastCommand End SyncLock End Get Set(value As String) SyncLock blockSync _lastCommand = value End SyncLock End Set End Property #End Region #Region "TimeOut-Function" Public Shared Function CheckAndSetup(ByRef comPort As SerialPort, ByVal sCheckCommand As String, ByVal sFunc As String, ByVal sValue As String, Optional ByVal nIndex As Integer = 0, Optional ByVal sDelim As String = ",", Optional ByVal sCheckExpect As String = "OK", Optional ByVal nCheckTimeOut As Integer = 1000, Optional ByVal sSetCommand As String = "", Optional ByVal sSetExpect As String = "OK", Optional ByVal nSetTimeOut As Integer = 2000) As Boolean '----------------------------------------------------------------------------------- ' ChechAndSetup  AT- <sCheckCommand>    <comPort>  '   <nCheckTimeOut>      ' "OK"  "0".       '<sFunc>   <nIndex>    <sValue>.    ',    True      False. '   <sCheckCommand>      ,   ' False. '--------------------------------- '     <sSetCommand>   ,    '    False,     <comPort>  ' <sSetCommand>      "OK"  "0"  '  <nSetTimeOut>.       ,  '   <sFunc>   <nIndex>    <sValue>. '      False  True. '--------------------------------- '           'False   TimeOutState  True '--------------------------------- ' <sDelim>   ,      '   String.Split() '----------------------------------------------------------------------------------- Dim stTime As Date = Now Dim sRet As String Dim bCheck As Boolean ' startTime = stTime CheckAndSetup = False _timeOut = False If (comPort.IsOpen And (sCheckCommand.Length > 0)) Then SerialWriteLine(comPort, sCheckCommand) sRet = WaitAnswer(comPort, nCheckTimeOut, sCheckExpect, False) bCheck = CheckFuncValue(sFunc, sValue, sDelim, nIndex) If ((Not bCheck) And (Not _timeOut) And (sSetCommand.Length > 0)) Then startTime = Now SerialWriteLine(comPort, sSetCommand) sRet = WaitAnswer(comPort, nSetTimeOut, sSetExpect, False) If Not _timeOut Then CheckAndSetup = CheckFuncValue(sFunc, sValue, sDelim, nIndex) End If Else CheckAndSetup = bCheck End If End If stopTime = Now tSpan = stopTime.Subtract(stTime) _lastTRun = Int(tSpan.TotalMilliseconds) End Function Public Shared Function SendData(ByRef comPort As SerialPort, _ Optional sComm As String = "", _ Optional ByVal tOut As Integer = 1000, _ Optional sExpect As String = "OK|ERROR") As String '----------------------------------------------------------------------------------- '  AT-      comPort   '      sComm ( )    '       sExpect. '------------------------------------ '  sComm = ""  ,       AT- ',           . '------------------------------------ '  tOut ,      1  '------------------------------------ '   '  .     '   '   "|".      '() ' ,        ' '        ,    ' .    ,   '" " + " " - vbCrLf. '    tOut,       ',    TimeOutState = True   LastTimeRun   '   '    WaitAnswer, TimeOutState   False '  LastTimeRun     '----------------------------------------------------------------------------------- startTime = Now If sComm.Length > 0 Then SerialWrite(comPort, sComm) End If SendData = WaitAnswer(comPort, tOut, sExpect, False) stopTime = Now tSpan = stopTime.Subtract(startTime) _lastTRun = Int(tSpan.TotalMilliseconds) End Function Public Shared Function ExecuteAT(ByRef comPort As SerialPort, _ Optional sComm As String = "", _ Optional ByVal tOut As Integer = 1000, _ Optional sExpect As String = "OK|ERROR", _ Optional ByVal bSetCrLf As Boolean = True) As String '----------------------------------------------------------------------------------- '  AT-      comPort   '      sComm ( )    '       sExpect. '------------------------------------ '  sComm = ""  ,       AT- ',           . '------------------------------------ '  tOut ,      1  '------------------------------------ '   '  .     '   '   "|".      '() ' ,        ' '        ,    ' .    ,   '" " + " " - vbCrLf. '    tOut,       ',    TimeOutState = True   LastTimeRun   '   '    WaitAnswer, TimeOutState   False '  LastTimeRun     '----------------------------------------------------------------------------------- startTime = Now If sComm.Length > 0 Then comPort.WriteLine(Trim(sComm)) End If ExecuteAT = WaitAnswer(comPort, tOut, sExpect, False) stopTime = Now tSpan = stopTime.Subtract(startTime) _lastTRun = Int(tSpan.TotalMilliseconds) End Function Public Shared Function WaitAnswer(ByRef commPort As SerialPort, _ Optional tOut As Integer = 1000, _ Optional sExpect As String = "OK|ERROR", _ Optional ByVal bStTime As Boolean = True, _ Optional ByVal bSetCrLf As Boolean = True) As String '----------------------------------------------------------------------------------- '         commPort  '  tOut          '    sExpect. '------------------------------------ ' bStTime      , '( - ) '------------------------------------ '  tOut ,      1  '------------------------------------ '   '  .     '   '   "|".      '() ' ,        ' '        ,    ' .    ,   '" " + " " - vbCrLf. '    tOut,       ',    TimeOutState = True   LastTimeRun   '   '    WaitAnswer, TimeOutState   False '  LastTimeRun     '----------------------------------------------------------------------------------- Dim sTemp, sText As String Dim sTerminator As String = IIf(bSetCrLf, vbCrLf, "") Dim aExpect As String() = {} Dim bContinue As Boolean = True _timeOut = False If bStTime Then startTime = Now End If WaitAnswer = "" If sExpect.Length > 0 Then aExpect = sExpect.Split("|".ToCharArray) Else aExpect = {} End If While bContinue While (MsgCount() < 1) Sleep(5) stopTime = Now tSpan = stopTime.Subtract(startTime) If tSpan.TotalMilliseconds > tOut Then _timeOut = True _lastTRun = Int(tSpan.TotalMilliseconds) bContinue = False Exit While End If End While If bContinue Then sTemp = ExtractMess() WaitAnswer = IIf(WaitAnswer.Length > 0, WaitAnswer + sTemp + sTerminator, sTemp + sTerminator) If aExpect.Length > 0 Then For Each sText In aExpect If InStr(sTemp, sText) > 0 Then bContinue = False Exit For End If Next sText End If Else Exit While End If End While stopTime = Now tSpan = stopTime.Subtract(startTime) _lastTRun = Int(tSpan.TotalMilliseconds) End Function Public Shared Function WaitFunc(ByVal sKey As String, Optional ByVal tOut As Integer = 1000, Optional ByVal sDelim As String = ",", Optional ByVal nIndex As Integer = -1) As String '----------------------------------------------------------------------------------- '    sKey  -    tOut  '.          '     nIndex. '------------------------------------ '  tOut ,      1  '------------------------------------ '  nIndex  ,       '     sDelim.   nIndex ,  '    sKey       . '----------------------------------------------------------------------------------- Dim sTemp As String _timeOut = False startTime = Now WaitFunc = "" While True sTemp = GetFuncValue(sKey, sDelim, nIndex) If sTemp.Length > 0 Then WaitFunc = sTemp Exit While End If stopTime = Now tSpan = stopTime.Subtract(startTime) If tSpan.TotalMilliseconds > tOut Then _timeOut = True _lastTRun = Int(tSpan.TotalMilliseconds) Exit While End If Sleep(5) End While stopTime = Now tSpan = stopTime.Subtract(startTime) _lastTRun = Int(tSpan.TotalMilliseconds) End Function #End Region #Region "Public Methods ()" Public Shared Sub SerialWrite(ByVal comPort As SerialPort, ByVal sComm As String) If (comPort.IsOpen And (sComm.Length > 0)) Then comPort.Write(sComm) _lastCommand = Trim(sComm) End If End Sub Public Shared Sub SerialWriteLine(ByVal comPort As SerialPort, ByVal sComm As String) If (comPort.IsOpen And (sComm.Length > 0)) Then comPort.WriteLine(sComm) _lastCommand = Trim(sComm) End If End Sub Public Shared Function IsCME_Error() As Boolean IsCME_Error = _cmeError End Function Public Shared Function IsSMS_Error() As Boolean IsSMS_Error = _smsError End Function Public Shared Sub DropCME_Error() _cmeError = False _cmeLastError = -1 End Sub Public Shared Sub DropSMS_Error() _smsError = False _smsLastError = -1 End Sub Public Shared Function AppendLines(ByVal aLines As String()) As Integer '------------------------------------------------------------------------------- '        '         '       ,      Dim sText As String If aLines.Length > 0 Then For Each sText In aLines AppendLines = AppendMess(sText) Next End If End Function Public Shared Function AppendMess(ByVal sText As String) As Integer '------------------------------------------------------------------------------- '        '         '       ,     Dim nCount As Integer = 0 If _funcIntercept Then sText = FuncIntercept(sText) End If If sText.Length > 0 Then SyncLock blockSync nCount = msgList.Length ReDim Preserve msgList(nCount) msgList(nCount) = Trim(sText) nCount = msgList.Length _Recieved = True End SyncLock Else SyncLock blockSync nCount = msgList.Length End SyncLock End If AppendMess = nCount End Function Public Shared Function Items() As String() '------------------------------------------------------------------------------- '      ( )  Dim aStr As String() SyncLock blockSync Dim nCount As Integer = UBound(msgList) ReDim aStr(nCount) Array.Copy(msgList, aStr, msgList.Length) End SyncLock Items = aStr End Function Public Shared Function MsgCount() As Integer '------------------------------------------------------------------------------- '       SyncLock blockSync MsgCount = msgList.Length End SyncLock End Function Public Shared Function ExtractMess() As String '------------------------------------------------------------------------------- '           '       ,    '     '       ,    Dim nCount As Integer ExtractMess = "" SyncLock blockSync If msgList.Length > 0 Then ExtractMess = msgList(0) nCount = UBound(msgList) nCount -= 1 Array.Copy(msgList, 1, msgList, 0, msgList.Length - 1) ReDim Preserve msgList(nCount) End If If msgList.Length = 0 Then _Recieved = False End SyncLock End Function Public Shared Sub ClearMessage() '------------------------------------------------------------------------------- '     SyncLock blockSync msgList = {} _Recieved = False End SyncLock End Sub Public Shared Function GetFuncValue(ByVal sKey As String, Optional ByVal sDelim As String = ",", Optional ByVal nIndex As Integer = -1) As String Dim sVal As String = "" Dim aVal As String() = {} GetFuncValue = "" SyncLock _funcTable.SyncRoot If _funcTable.ContainsKey(sKey) Then sVal = _funcTable(sKey) End If End SyncLock If (sVal.Length > 0) And (nIndex >= 0) Then aVal = sVal.Split(sDelim.ToCharArray, StringSplitOptions.RemoveEmptyEntries) If nIndex > UBound(aVal) Then Exit Function Else GetFuncValue = aVal(nIndex) End If Else GetFuncValue = sVal End If End Function Public Shared Function CheckFuncValue(ByVal sFunc As String, ByVal sValue As String, Optional ByVal sDelim As String = ",", Optional ByVal nIndex As Integer = 0) As Boolean Dim aVal As String() CheckFuncValue = False If (sFunc.Length > 0) And (_funcTable.Contains(sFunc)) Then aVal = _funcTable(sFunc).ToString.Split(sDelim.ToCharArray, StringSplitOptions.RemoveEmptyEntries) If nIndex <= UBound(aVal) Then CheckFuncValue = IIf(Trim(sValue) = Trim(aVal(nIndex)), True, False) End If End If End Function Public Shared Sub SetFuncValue(ByVal sKey, ByVal Value) SyncLock _funcTable.SyncRoot _funcTable(sKey) = Value End SyncLock End Sub Public Shared Sub RemuveFunc(ByVal sKey) SyncLock _funcTable.SyncRoot _funcTable.Remove(sKey) End SyncLock End Sub Public Shared Sub ClearFuncList() SyncLock _funcTable.SyncRoot _funcTable.Clear() End SyncLock End Sub #End Region #Region "Private Methods" Private Shared Function FuncIntercept(ByVal sText As String) As String '------------------------------------------------------------------------------- ' ""   +CREG:1.     '      "+"   '  ":",         ',    ":".  "+"  ":"   ' . '---------------- '          '    ,     '  . '---------------- Dim i, n, m As Integer Dim aLine As String() Dim key As String = "" Dim val As String = "" '      sText = Trim(sText) If (_EchoIntegcept And (sText = _lastCommand)) Then FuncIntercept = "" Exit Function End If '       FuncIntercept = sText i = InStr(sText, "+") n = InStr(sText, ":") m = InStr(sText, "^") If ((i > 0) Or (n > 0) Or (m > 0)) Then If sText.Length > 0 Then aLine = sText.Split("+^:".ToCharArray, StringSplitOptions.RemoveEmptyEntries) If aLine.Length = 0 Then Exit Function ElseIf aLine.Length = 1 Then key = aLine(0) val = "" ElseIf aLine.Length = 2 Then key = aLine(0) val = aLine(1) End If If val = "CME ERROR" Then _cmeError = True _cmeLastError = Int(val) If Not _cmeIntercept Then Exit Function End If ElseIf val = "SMS ERROR" Then _smsError = True _smsLastError = Int(val) If Not _smsIntercept Then Exit Function End If End If SyncLock _funcTable.SyncRoot _funcTable(Trim(key)) = Trim(val) End SyncLock FuncIntercept = "" End If End If End Function #End Region End Class End Module
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     

 #Region "Import Namespace" Imports System Imports System.Text Imports System.IO Imports System.IO.Ports Imports System.Threading Imports System.Threading.Thread Imports System.Collections Imports System.Object Imports System.ComponentModel Imports System.Runtime.InteropServices Imports System.Runtime.ConstrainedExecution #End Region Public Class CommCare #Region "Declaration" Shared SerialPortA As SerialPort Shared _continue As Boolean ' False      ComboBox    Shared _readPort As Boolean ' False         TextBoxM Shared _lineCount As Integer '      TextBoxM,   -      Shared _nCharWait As Integer = 0 '    ,    _nCharWait    vbCrLf Shared _lastLine As String = "" '     COM   Shared _lastRead As String = "" '  ,       COM  Shared _ReadBuff As String = "" '            Shared _lastClear As Boolean '      _lastRead Shared _lockRead As Boolean '       _lastRead Shared _allowRun As Boolean '     ,   (False)   Shared _allowEcho As Boolean '           COM  Shared _timeOut As Boolean ' Shared _QICSGP As String '        Shared _QIOPEN As String '        Public hashToken As Hashtable '     AT- Private ScriptThread As Thread = New Thread(AddressOf RunScript) '     Public Enum scNames scKeyWord scVarData scLabel scCodeData scSubData End Enum '    Public aScript As Array = {New Hashtable, New Hashtable, New Hashtable, New ArrayList, New ArrayList} Public RunStack As Stack = New Stack Private BaudList As String() = {"4800", "9600", "14400", "19200", "38400", "57600", "115200", "128000", "230400", "460800", "614400", "921600", "1228800"} Private DataBitsList As String() = {"8", "7", "6", "5", "4"} ' API -     INI- Private Declare Auto Function GetPrivateProfileString Lib "kernel32" _ (ByVal lpAppName As String, _ ByVal lpKeyName As String, _ ByVal lpDefault As String, _ ByVal lpReturnedString As StringBuilder, _ ByVal nSize As Integer, _ ByVal lpFileName As String) As Int32 ' API -     INI- Private Declare Auto Function WritePrivateProfileString Lib "Kernel32" _ (ByVal Section As String, _ ByVal Key As String, _ ByVal putStr As String, _ ByVal INIfile As String) As Int32 ' This delegate enables asynchronous calls for setting ' the text property on a TextBox control. Delegate Sub SetTextCallback([text] As String, bClear As Boolean) #End Region #Region "COM Collectors" ' Recollect COM port setting Private Sub Refresh_COMSetting() _continue = False ' Dim readThread As Thread = New Thread(AddressOf Read) ' Create a new SerialPort object with default settings. Call CollectParity() Call CollectBaudRate() Call DataBitsSet() Call StopBitsSet() Call FlowControlSet() _continue = True End Sub ' Collect list of available COM ports (registry info) Private Sub CollectCOMM_List() Dim listCOM As String() = IO.Ports.SerialPort.GetPortNames() Dim port As String ' Clear list of COM Ports ComboBoxCOM_List.Items.Clear() ' Get list of serial COM ports ' Fill ComboBox, names of COM For Each port In listCOM ComboBoxCOM_List.Items.Add(port) Next port ComboBoxCOM_List.SelectedIndex = 0 End Sub ' Fill ComboBox BaudRate value and set ComboBox to port value allready setted Private Sub CollectBaudRate() 'Fill ComboBox_BaudList available speed list Dim BaudRate As String Dim DefBaud As Integer Dim DefSel As Integer Dim SelBox As Integer ComboBox_BaudList.Items.Clear() DefSel = 0 DefBaud = SerialPortA.BaudRate For Each BaudRate In BaudList Try SerialPortA.BaudRate = Int(BaudRate) If Int(BaudRate) = DefBaud Then SelBox = DefSel End If DefSel = DefSel + 1 ComboBox_BaudList.Items.Add(BaudRate) Catch ex As Exception ' Do nothing End Try Next SerialPortA.BaudRate = DefBaud ComboBox_BaudList.SelectedIndex = SelBox End Sub ' Fill ComboBox DataBits value and set ComboBox to port value allready setted Private Sub DataBitsSet() Dim DefDataBits As Integer Dim sBits As Integer Dim BoxSel, nSel As Integer ComboBox_DataBits.Items.Clear() DefDataBits = SerialPortA.DataBits nSel = 0 For Each sBits In DataBitsList If Int(sBits) = DefDataBits Then BoxSel = nSel End If nSel = nSel + 1 ComboBox_DataBits.Items.Add(sBits) Next ComboBox_DataBits.SelectedIndex = BoxSel End Sub ' Fill ComboBox StopBits value and set ComboBox to port value allready setted Private Sub StopBitsSet() ComboBox_StopBits.Items.Clear() Dim s As String For Each s In [Enum].GetNames(GetType(StopBits)) ComboBox_StopBits.Items.Add(s) Next s ComboBox_StopBits.SelectedIndex = SerialPortA.StopBits End Sub ' Fill ComboBox Parity value and set ComboBox to port value allready setted Private Sub CollectParity() Dim s As String ComboBox_ParityList.Items.Clear() For Each s In [Enum].GetNames(GetType(Parity)) ComboBox_ParityList.Items.Add(s) Next s ComboBox_ParityList.SelectedIndex = SerialPortA.Parity End Sub ' Fill ComboBox Handshake value and set ComboBox to port value allready setted Private Sub FlowControlSet() Dim s As String ComboBox_FlowControl.Items.Clear() For Each s In [Enum].GetNames(GetType(Handshake)) ComboBox_FlowControl.Items.Add(s) Next s ComboBox_FlowControl.SelectedIndex = SerialPortA.Parity End Sub #End Region #Region "Thread safe sub" ' Thread-Safe write to console TextBoxM Private Sub WriteToConsole(ByVal [text] As String, Optional bClear As Boolean = False) If Me.TextBoxM.InvokeRequired Then Dim d As New SetTextCallback(AddressOf WriteToConsole) Me.Invoke(d, New Object() {[text], bClear}) Else _readPort = False If bClear Then Me.TextBoxM.Text = [text] Else Me.TextBoxM.AppendText([text]) End If Me.CB_DataRecived.Checked = MessPull.MessageRecieved End If End Sub ' Thread-Safe write to console TextBox_Recieved Private Sub WriteToRecieved(ByVal [text] As String, Optional bClear As Boolean = False) If Me.TextBox_Recieved.InvokeRequired Then Dim d As New SetTextCallback(AddressOf WriteToRecieved) Me.Invoke(d, New Object() {[text], bClear}) Else If bClear Then Me.TextBox_Recieved.Text = [text] Else Me.TextBox_Recieved.AppendText([text]) End If End If End Sub #End Region #Region "Local procedure" ' Load token list from file Private Sub LoadToken(ByVal fName As String) Dim nCntr As Integer Dim sToken As String If File.Exists(fName) Then Dim rdStream As New StreamReader(fName) hashToken = New Hashtable nCntr = 1 While Not rdStream.EndOfStream sToken = rdStream.ReadLine() hashToken.Add(sToken, nCntr) nCntr += 1 End While rdStream.Close() End If End Sub ' Write COM port configuration to file Private Sub WriteConfig(ByVal fName) WritePrivateProfileString("SERIAL1", "PortName", ComboBoxCOM_List.Text, fName) WritePrivateProfileString("SERIAL1", "BaudRate", ComboBox_BaudList.Text, fName) WritePrivateProfileString("SERIAL1", "Parity", Str(ComboBox_ParityList.SelectedIndex), fName) WritePrivateProfileString("SERIAL1", "DataBits", ComboBox_DataBits.Text, fName) WritePrivateProfileString("SERIAL1", "StopBits", Str(ComboBox_StopBits.SelectedIndex), fName) WritePrivateProfileString("SERIAL1", "Handshake", Str(ComboBox_FlowControl.SelectedIndex), fName) WritePrivateProfileString("DATE", "LastSaved", Date.Today, fName) ' Form Size & Position WritePrivateProfileString("FORMPOS", "Y", Me.Location.Y.ToString(), fName) WritePrivateProfileString("FORMPOS", "X", Me.Location.X.ToString(), fName) WritePrivateProfileString("FORMPOS", "Height", Me.Height.ToString(), fName) WritePrivateProfileString("FORMPOS", "Width", Me.Width.ToString(), fName) ' TabControl WritePrivateProfileString("INTERNAL", "TabActive", TabControlA.SelectedIndex.ToString(), fName) WritePrivateProfileString("SCRIPT", "QICSGP", TextBoxBearer.Text, fName) WritePrivateProfileString("SCRIPT", "QIOPEN", TextBoxIP.Text, fName) End Sub ' Load COM port configuration from file Private Sub LoadConfig(ByVal fName) Dim nLength As Integer Dim sBuff As StringBuilder Dim iniparam As String Dim nIndex As Integer Dim aPoint As Point sBuff = New StringBuilder(500) sBuff.Clear() If File.Exists(fName) Then nLength = GetPrivateProfileString("SERIAL1", "PortName", ComboBoxCOM_List.Text, sBuff, sBuff.Capacity, fName) iniparam = sBuff.ToString() nIndex = ComboBoxCOM_List.FindString(iniparam) If nIndex >= 0 Then ComboBoxCOM_List.SelectedIndex = nIndex SerialPortA.PortName = ComboBoxCOM_List.Text End If sBuff.Clear() ' nLength = GetPrivateProfileString("SERIAL1", "BaudRate", ComboBox_BaudList.Text, sBuff, sBuff.Capacity, fName) iniparam = sBuff.ToString() nIndex = ComboBox_BaudList.FindString(iniparam) If nIndex >= 0 Then ComboBox_BaudList.SelectedIndex = nIndex SerialPortA.BaudRate = Int(ComboBox_BaudList.Text) End If sBuff.Clear() ' nLength = GetPrivateProfileString("SERIAL1", "Parity", Str(ComboBox_ParityList.SelectedIndex), sBuff, sBuff.Capacity, fName) iniparam = sBuff.ToString() ComboBox_ParityList.SelectedIndex = Int(iniparam) SerialPortA.Parity = Int(iniparam) sBuff.Clear() ' nLength = GetPrivateProfileString("SERIAL1", "DataBits", ComboBox_DataBits.Text, sBuff, sBuff.Capacity, fName) iniparam = sBuff.ToString() nIndex = ComboBox_DataBits.FindString(iniparam) If nIndex >= 0 Then ComboBox_DataBits.SelectedIndex = nIndex SerialPortA.DataBits = Int(iniparam) End If sBuff.Clear() ' nLength = GetPrivateProfileString("SERIAL1", "StopBits", Str(ComboBox_StopBits.SelectedIndex), sBuff, sBuff.Capacity, fName) iniparam = sBuff.ToString() ComboBox_StopBits.SelectedIndex = Int(iniparam) SerialPortA.StopBits = Int(iniparam) sBuff.Clear() ' nLength = GetPrivateProfileString("SERIAL1", "Handshake", Str(ComboBox_FlowControl.SelectedIndex), sBuff, sBuff.Capacity, fName) iniparam = sBuff.ToString() ComboBox_FlowControl.SelectedIndex = Int(iniparam) SerialPortA.Handshake = Int(iniparam) ' Form size & position sBuff.Clear() nLength = GetPrivateProfileString("FORMPOS", "Y", Me.Location.Y.ToString(), sBuff, sBuff.Capacity, fName) aPoint.Y = Int(sBuff.ToString()) sBuff.Clear() nLength = GetPrivateProfileString("FORMPOS", "X", Me.Location.X.ToString(), sBuff, sBuff.Capacity, fName) aPoint.X = Int(sBuff.ToString()) Me.Location = aPoint sBuff.Clear() nLength = GetPrivateProfileString("FORMPOS", "Height", Me.Height.ToString(), sBuff, sBuff.Capacity, fName) Me.Height = Int(sBuff.ToString()) sBuff.Clear() nLength = GetPrivateProfileString("FORMPOS", "Width", Me.Width.ToString(), sBuff, sBuff.Capacity, fName) Me.Width = Int(sBuff.ToString()) ' Tab control sBuff.Clear() nLength = GetPrivateProfileString("INTERNAL", "TabActive", TabControlA.SelectedIndex.ToString(), sBuff, sBuff.Capacity, fName) nLength = Int(sBuff.ToString()) TabControlA.SelectTab(nLength) ' Script process sBuff.Clear() nLength = GetPrivateProfileString("INTERNAL", "ScriptAutoLoad", "No", sBuff, sBuff.Capacity, fName) If UCase(sBuff.ToString()) = "YES" Then AutoLoadScriptToolStripMenuItem.Checked = True sBuff.Clear() Dim scriptPathName As String = sBuff.ToString() nLength = GetPrivateProfileString("INTERNAL", "ScriptFile", "", sBuff, sBuff.Capacity, fName) scriptPathName = sBuff.ToString() Dim read As New StreamReader(scriptPathName) TextBox_Script.Text = read.ReadToEnd.ToString read.Close() End If ' Load default token nLength = GetPrivateProfileString("SCRIPT", "TokenFileName", Application.StartupPath & "\Default.tok", sBuff, sBuff.Capacity, fName) Call LoadToken(sBuff.ToString()) sBuff.Clear() nLength = GetPrivateProfileString("SCRIPT", "QICSGP", "1,""inet.bwc.ru""", sBuff, sBuff.Capacity, fName) TextBoxBearer.Text = sBuff.ToString() sBuff.Clear() nLength = GetPrivateProfileString("SCRIPT", "QIOPEN", """TCP"",""46.254.241.3"",9999""", sBuff, sBuff.Capacity, fName) TextBoxIP.Text = sBuff.ToString() End If End Sub ' Check native token Private Function CheckNativeToken(ByVal sToken) As Boolean CheckNativeToken = hashToken.Contains(sToken) End Function ' Run script operation Private Sub RunScript() Dim sRet, sTemp As String Dim timeStart As Date Dim timeStop As Date Dim nTime As Double = 0 Dim nCount As Integer Dim tSpan As TimeSpan Dim serialStatus As Boolean = SerialPortA.IsOpen Dim seansOpen As Boolean = False Dim sBlock440 As String = "operations$öûâðëéîð÷ñéðöâéîðó2837âí2àãïëöãéïàöëäî3ïðàëîöíóïàùã34ïàùãà4óíïùöãíï4àêãùíöïùøãí4ïàùãöóåïàêãöù4ïàùãø4íïàùöã4íïàêùö6å4ê6åïöøãíàïö4ùïåàöùàïöùãà4ïöùã47ïåàêùöïù4ãïàøöãàï4ùãï4àùãöïàùöãï4àøùã6ï4àùãö4ïåàøãöï64àøã46ïà6öïàø76ö4ïàäöãàïíöãøíïuiowq3ygrowg3fowrtgowufygbow4gfowueyfgco6wt4go68gfrwkuyfcgwkgy4ckuw4ygfouwygou4fgrfouwf4gow4grfw4yofgowu4ygfou4fgwo4uygfwy4gfow4g4gfowufgou4rgyfwuyfguwygf4uyg4f6gfiu4gklejhdkwehfewhrkferhiuht43iuhiur" '         Dim nDisconnect As Integer = 0 Dim nMinTimeA, nMinTimeB, nMaxTimeA, nMaxTimeB, nEvgTimeA, nEvgTimeB As Integer Dim nSendAttemptA, nSendAttemptB, nLostPackA, nLostPackB As Integer Dim nSendSuccA, nSendSuccB As Integer Dim nLostConnect As Integer = 0 Dim timeSummary As Double = 0 Dim timeSummaryMin As Double = 0 Dim timeSummaryMax As Double = 0 Dim timeSummaryEvg As Double = 0 _allowRun = True _allowEcho = True _ReadBuff = "" _lastClear = False _lastLine = "" nMinTimeA = 0 nMinTimeB = 0 nMaxTimeA = 0 nMaxTimeB = 0 nEvgTimeA = 0 nEvgTimeB = 0 nSendAttemptA = 0 nSendAttemptB = 0 nLostPackA = 0 nLostPackB = 0 nSendSuccA = 0 nSendSuccB = 0 '   MessPull.ClearMessage() MessPull.AllowCMEErrorIntercept = True MessPull.AllowFuncIntercept = True MessPull.AllowSMSErrorIntercept = True MessPull.DropCME_Error() MessPull.DropSMS_Error() '   Dim record As New StreamWriter(Application.StartupPath & "\Default.log") Me.WriteToConsole("Script started at " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Script started at " + DateTime.Now.ToLongTimeString + "!") If Not SerialPortA.IsOpen Then Try SerialPortA.Open() Catch Me.WriteToConsole("Serial Port: " + SerialPortA.PortName + " is busy! Script stopped at: " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Serial Port: " + SerialPortA.PortName + " is busy! Script stopped at: " + DateTime.Now.ToLongTimeString + "!") _allowRun = False End Try End If '   If _allowRun Then nCount = 0 sTemp = "" MessPull.ClearMessage() While ((InStr(sTemp, "OK") = 0) And _allowRun) nCount += 1 sTemp = MessPull.ExecuteAT(SerialPortA, "AT" + vbCrLf, 3000) Me.WriteToConsole("Attempt: " + Str(nCount) + " Send: " + sTemp) End While Me.DisplayFunc() '   Me.WriteToConsole("Turn on the modem!" + vbCrLf) If Not MessPull.CheckAndSetup(SerialPortA, "AT+CFUN?", "CFUN", "1", , , , , "AT+CFUN=1", "Call Ready", 15000) Then Me.WriteToConsole("Modem does not turn on! Script Aborted!" + vbCrLf) _allowRun = False Else '    Me.WriteToConsole(MessPull.ExecuteAT(SerialPortA, "ATE1", 3000)) MessPull.CheckAndSetup(SerialPortA, "AT+CREG?", "CREG", "1", 0, ",", "OK", 1000, "AT+CREG=1", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+CGREG?", "CGREG", "1", 0, ",", "OK", 1000, "AT+CGREG=1", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+CRC?", "CRC", "0", 0, ",", "OK", 1000, "AT+CRC=0", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QAUDCH?", "QAUDCH", "2", 0, ",", "OK", 1000, "AT+QAUDCH=2", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QIFGCNT?", "QIFGCNT", "1", 0, ",", "OK", 1000, "AT+QIFGCNT=1", "OK", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QICSGP?", "QICSGP", "1", 0, ",", "OK", 1000, "AT+QICSGP=" + _QICSGP, "OK", 5000) End If Me.DisplayFunc() End If While _allowRun While _allowRun If (MessPull.CheckAndSetup(SerialPortA, "AT+CREG?", "CREG", "1", 1) And MessPull.CheckAndSetup(SerialPortA, "AT+CGREG?", "CGREG", "1", 1)) Then Exit While End If Me.DisplayFunc() End While Me.DisplayFunc() Me.WriteToConsole("Modem is registered on the home network at: " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Modem is registered on the home network at: " + DateTime.Now.ToLongTimeString + "!") '    While (_allowRun And (Not seansOpen = True)) Me.DisplayFunc() Me.WriteToConsole(MessPull.ExecuteAT(SerialPortA, "AT+QISTAT", 2000) + vbCrLf) 'MessPull.WaitAnswer(SerialPortA, 5000, "", False) 'record.WriteLine("Request status at: " + DateTime.Now.TimeOfDay.ToString + "!") sRet = MessPull.GetFuncValue("STATE") Select Case sRet Case "IP INITIAL" MessPull.CheckAndSetup(SerialPortA, "AT+QISDE?", "QISDE", "0", 0, ",", "OK", 1000, "AT+QISDE = 0", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QIMUX?", "QIMUX", "0", 0, ",", "OK", 1000, "AT+QIMUX = 0", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QIMODE?", "QIMODE", "0", 0, ",", "OK", 1000, "AT+QIMODE=0", 5000) MessPull.CheckAndSetup(SerialPortA, "AT+QIDNSIP?", "QIDNSIP", "0", 0, ",", "OK", 1000, "AT+QIDNSIP=0", 5000) If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QIREGAPP", 1000, "OK|ERROR"), "OK") > 0 Then Me.WriteToConsole("Can not register application on network! Next Attempt!" + vbCrLf) record.WriteLine("Can't Activate GPRS/CSD context! Next Attempt!") End If Case "IP START" If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QIACT", 1000, "OK|ERROR"), "OK") > 0 Then Me.WriteToConsole("Can't Activate GPRS/CSD context! Next Attempt!" + vbCrLf) record.WriteLine("Can't Activate GPRS/CSD context! Next Attempt!") End If Case "IP GPRSACT" If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QILOCIP", 2000, "."), ".") > 0 Then Me.WriteToConsole("Can't Get local IP addres!" + vbCrLf) record.WriteLine("Can't Get local IP addres!") End If Case "IP STATUS" If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QIOPEN=" + _QIOPEN, 5000, "OK"), "OK") > 0 Then seansOpen = True Else Me.WriteToConsole("Can not estabilish connect!" + vbCrLf) record.WriteLine("Can not estabilish connect!") seansOpen = False End If Case "IP CLOSE" MessPull.ExecuteAT(SerialPortA, "AT+QIDEACT", 5000, "DEACT OK") Me.WriteToConsole("Deactivate GPRS/CSD context!" + vbCrLf) record.WriteLine("Deactivate GPRS/CSD context!") seansOpen = False Case "CONNECT OK" seansOpen = True Me.WriteToConsole("Connection OK!" + vbCrLf) record.WriteLine("Connection OK!") Case "PDP DEACT" Me.WriteToConsole("GPRS/CSD context was deactivated because of unknown reason. Reconnecting!" + vbCrLf) record.WriteLine("GPRS/CSD context was deactivated because of unknown reason. Reconnecting!") If Not InStr(MessPull.ExecuteAT(SerialPortA, "AT+QIACT", 1000, "OK|ERROR"), "OK") > 0 Then Me.WriteToConsole("Can't Activate GPRS/CSD context! Next Attempt!" + vbCrLf) record.WriteLine("Can't Activate GPRS/CSD context! Next Attempt!") End If Case "TCP CONNECTING" Sleep(800) Case Else Me.WriteToConsole("Connection status: " + sRet + vbCrLf) record.WriteLine("Connection status: " + sRet) End Select Me.WriteToConsole("Connection status: " + sRet + vbCrLf) Me.DisplayFunc() End While While (seansOpen And _allowRun) MessPull.ClearMessage() MessPull.ExecuteAT(SerialPortA, "AT+QISTAT") timeSummary = 0 nSendAttemptA += 1 timeStart = Now sRet = Trim(MessPull.ExecuteAT(SerialPortA, "AT+QISEND=8", 3000, ">", False)) 'Me.WriteToConsole("Time execution AT+QISEND=8" + MessPull.LastTimeRun.ToString + vbCrLf) If InStr(sRet, ">") > 0 Then sRet = MessPull.ExecuteAT(SerialPortA, "balance$", 3000, "SEND OK", False) 'Me.WriteToConsole("Time execution [balance$]" + MessPull.LastTimeRun.ToString + vbCrLf) If InStr(sRet, "SEND OK") > 0 Then _nCharWait = 40 sRet = MessPull.WaitAnswer(SerialPortA, 10000, "balance>................................", , False) If sRet = "balance>................................" Then Me.WriteToConsole(vbCrLf) timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds timeSummary = tSpan.TotalMilliseconds nMinTimeA = IIf(nMinTimeA = 0, nTime, IIf(nMinTimeA > nTime, nTime, nMinTimeA)) nMaxTimeA = IIf(nMaxTimeA = 0, nTime, IIf(nMaxTimeA < nTime, nTime, nMaxTimeA)) nEvgTimeA = IIf(nEvgTimeA = 0, nTime, (nTime + nEvgTimeA) / 2) nSendSuccA += 1 '     nSendAttemptB += 1 timeStart = Now sRet = Trim(MessPull.ExecuteAT(SerialPortA, "AT+QISEND=440", 3000, ">", False)) 'Me.WriteToConsole("Time execution AT+QISEND=440" + MessPull.LastTimeRun.ToString + vbCrLf) If InStr(sRet, ">") > 0 Then MessPull.ClearMessage() _nCharWait = 4 sRet = MessPull.ExecuteAT(SerialPortA, sBlock440, 5000, "SEND OK", False) If InStr(sRet, "SEND OK") > 0 Then sRet = MessPull.WaitAnswer(SerialPortA, 10000, "done", , False) If InStr(sRet, "done") > 0 Then timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds timeSummary = timeSummary + tSpan.TotalMilliseconds nMinTimeB = IIf(nMinTimeB = 0, nTime, IIf(nMinTimeB > nTime, nTime, nMinTimeB)) nMaxTimeB = IIf(nMaxTimeB = 0, nTime, IIf(nMaxTimeB < nTime, nTime, nMaxTimeB)) nEvgTimeB = IIf(nEvgTimeB = 0, nTime, (nTime + nEvgTimeB) / 2) nSendSuccB += 1 Me.WriteToConsole(vbCrLf) Me.WriteToConsole("Cycle Ok. Time: " + timeSummary.ToString + vbCrLf) record.WriteLine("Cycle Ok. Time: " + timeSummary.ToString) timeSummaryMin = IIf(timeSummaryMin = 0, timeSummary, IIf(timeSummaryMin > timeSummary, timeSummaryMin, timeSummaryMin)) timeSummaryMax = IIf(timeSummaryMax = 0, timeSummary, IIf(timeSummaryMax < timeSummary, timeSummary, timeSummaryMax)) timeSummaryEvg = IIf(timeSummaryEvg = 0, timeSummary, (timeSummary + timeSummaryEvg) / 2) Else nLostPackB += 1 Me.WriteToConsole("Not Answer (440 byte). Time: " + nTime.ToString + vbCrLf) record.WriteLine("Not Answer (440 byte). Time: " + nTime.ToString) End If Else Me.WriteToConsole("Unsuccessfully send Data Pack (440 byte). Time: " + nTime.ToString + vbCrLf) record.WriteLine("Unsuccessfully send Data Pack (440 byte). Time: " + nTime.ToString) End If Else timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds Me.WriteToConsole("Error execute command AT+QISEND=440. Time: " + nTime.ToString + vbCrLf) record.WriteLine("Error execute command AT+QISEND=440. Time: " + timeSummary.ToString) End If Else timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds nLostPackA += 1 Me.WriteToConsole("Unsuccessfully execute command [balance$]. Time: " + nTime.ToString + vbCrLf) record.WriteLine("Unsuccessfully execute command [balance$]. Time: " + nTime.ToString) End If Else Me.WriteToConsole("Unsuccessfully send command [balance$]. Time: " + nTime.ToString + vbCrLf) record.WriteLine("Unsuccessfully send command [balance$]. Time: " + nTime.ToString) MessPull.ExecuteAT(SerialPortA, "AT", 3000, "") MessPull.ExecuteAT(SerialPortA, "AT", 3000, "") timeStop = Now tSpan = timeStop.Subtract(timeStart) nTime = tSpan.TotalMilliseconds End If Else MessPull.ExecuteAT(SerialPortA, "AT", 3000, "") Me.WriteToConsole("Error execute command AT+QISEND=8!" + vbCrLf) record.WriteLine("Error execute command AT+QISEND=8!") End If MessPull.SetFuncValue("CounterA", nSendAttemptA.ToString) MessPull.SetFuncValue("CounterB", nSendAttemptB.ToString) MessPull.SetFuncValue("AverageTimeA", nEvgTimeA.ToString) MessPull.SetFuncValue("AverageTimeB", nEvgTimeB.ToString) Me.DisplayFunc() If Not MessPull.GetFuncValue("STATE") = "CONNECT OK" Then nLostConnect += 1 seansOpen = False Me.WriteToConsole("Connection lost at: " + DateTime.Now.ToLongTimeString + vbCrLf) record.WriteLine("Connection lost at: " + DateTime.Now.ToLongTimeString) Me.WriteToConsole("Attempt to reconnect." + vbCrLf) record.WriteLine("Attempt to reconnect.") End If Sleep(2000) End While End While MessPull.ExecuteAT(SerialPortA, "AT+QICLOSE", 5000, "CLOSE OK|ERROR") MessPull.ExecuteAT(SerialPortA, "AT+QIDEACT", 5000, "DEACT OK|ERROR") Me.WriteToConsole("Connection Closed and GPRS/CSD context was deactivated at: " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Connection Closed and GPRS/CSD context was deactivated at: " + DateTime.Now.ToLongTimeString + "!") Me.WriteToConsole("---------------------------------------------------------------------------------------------" + vbCrLf) record.WriteLine("---------------------------------------------------------------------------------------------") Me.WriteToConsole("Execution repport:" + vbCrLf) record.WriteLine("Execution repport:") Me.WriteToConsole("[balance$] request MIN time (milliseconds): " + nMinTimeA.ToString + vbCrLf) record.WriteLine("[balance$] request MIN time (milliseconds): " + nMinTimeA.ToString) Me.WriteToConsole("[balance$] request MAX time (milliseconds): " + nMaxTimeA.ToString + vbCrLf) record.WriteLine("[balance$] request MAX time (milliseconds): " + nMaxTimeA.ToString) Me.WriteToConsole("[balance$] request AVERAGE time (milliseconds): " + nEvgTimeA.ToString + vbCrLf) record.WriteLine("[balance$] request AVERAGE time (milliseconds): " + nEvgTimeA.ToString) Me.WriteToConsole(vbCrLf) record.WriteLine("") Me.WriteToConsole("[440 byte pack] request MIN time (milliseconds): " + nMinTimeB.ToString + vbCrLf) record.WriteLine("[440 byte pack] request MIN time (milliseconds): " + nMinTimeB.ToString) Me.WriteToConsole("[440 byte pack] request MAX time (milliseconds): " + nMaxTimeB.ToString + vbCrLf) record.WriteLine("[440 byte pack] request MAX time (milliseconds): " + nMaxTimeB.ToString) Me.WriteToConsole("[440 byte pack] request AVERAGE time (milliseconds): " + nEvgTimeB.ToString + vbCrLf) record.WriteLine("[440 byte pack] request AVERAGE time (milliseconds): " + nEvgTimeB.ToString) Me.WriteToConsole(vbCrLf) record.WriteLine("") Me.WriteToConsole("Summary request MIN time (milliseconds): " + timeSummaryMin.ToString + vbCrLf) record.WriteLine("Summary request MIN time (milliseconds): " + timeSummaryMin.ToString) Me.WriteToConsole("Summary request MAX time (milliseconds): " + timeSummaryMax.ToString + vbCrLf) record.WriteLine("Summary request MAX time (milliseconds): " + timeSummaryMax.ToString) Me.WriteToConsole("Summary request AVERAGE time (milliseconds): " + timeSummaryEvg.ToString + vbCrLf) record.WriteLine("Summary request AVERAGE time (milliseconds): " + timeSummaryEvg.ToString) Me.WriteToConsole(vbCrLf) record.WriteLine("") Me.WriteToConsole("Total send attempt command [balance$]: " + nSendAttemptA.ToString + vbCrLf) record.WriteLine("Total send attempt command [balance$]: " + nSendAttemptA.ToString) Me.WriteToConsole("Total send attempt packet [440 byte]: " + nSendAttemptB.ToString + vbCrLf) record.WriteLine("Total send attempt packet [440 byte]: " + nSendAttemptB.ToString) Me.WriteToConsole("Total send succes [balance$]: " + nSendSuccA.ToString + vbCrLf) record.WriteLine("Total send succes [balance$]: " + nSendSuccA.ToString) Me.WriteToConsole("Total send succes [440 byte]: " + nSendSuccB.ToString + vbCrLf) record.WriteLine("Total send succes [440 byte]: " + nSendSuccB.ToString) Me.WriteToConsole(vbCrLf) record.WriteLine("") Me.WriteToConsole("Lost packet [balanse$]: " + nLostPackA.ToString + vbCrLf) record.WriteLine("Lost packet [balanse$]: " + nLostPackA.ToString) Me.WriteToConsole("Lost packet [440 byte]: " + nLostPackB.ToString + vbCrLf) record.WriteLine("Lost packet [440 byte]: " + nLostPackB.ToString) Me.WriteToConsole("---------------------------------------------------------------------------------------------" + vbCrLf) record.WriteLine("---------------------------------------------------------------------------------------------") Me.WriteToConsole("Script stopped at: " + DateTime.Now.ToLongTimeString + "!" + vbCrLf) record.WriteLine("Script stopped at: " + DateTime.Now.ToLongTimeString + "!") record.Close() '   If Not serialStatus Then SerialPortA.Close() End If '    _allowEcho = True End Sub Private Sub InitialIpSession() Dim sTemp As String ' Select a context as foreground context AT+QIFGCNT=1 sTemp = MessPull.ExecuteAT(SerialPortA, "AT+QIFGCNT=1", 3000) If sTemp = "OK" Then Me.WriteToConsole(sTemp + vbCrLf) Else Me.WriteToConsole("AT+QIFGCNT=1 Returns ERROR. Script stopped at:" + DateTime.Now.ToLongTimeString + "!" + vbCrLf) _allowRun = False 'Exit While End If 'AT+QICSGP=1,"inet.bwc.ru" sTemp = MessPull.ExecuteAT(SerialPortA, "AT+QICSGP=1,""inet.bwc.ru""", 3000) If sTemp = "OK" Then Me.WriteToConsole(sTemp + vbCrLf) Else Me.WriteToConsole("AT+QICSGP Returns ERROR. Script stopped at:" + DateTime.Now.ToLongTimeString + "!" + vbCrLf) _allowRun = False 'Exit While End If 'AT+QIMUX=0 sTemp = MessPull.ExecuteAT(SerialPortA, "AT+QIMUX=0", 3000) If sTemp = "OK" Then Me.WriteToConsole(sTemp + vbCrLf) Else Me.WriteToConsole("AT+QIMUX=0 Returns ERROR. Script stopped at:" + DateTime.Now.ToLongTimeString + "!" + vbCrLf) _allowRun = False 'Exit While End If 'AT+QIMODE=0 sTemp = MessPull.ExecuteAT(SerialPortA, "AT+QIMUX=0", 3000) If sTemp = "OK" Then Me.WriteToConsole(sTemp + vbCrLf) Else Me.WriteToConsole("AT+QIMODE=0 Returns ERROR. Script stopped at:" + DateTime.Now.ToLongTimeString + "!" + vbCrLf) _allowRun = False 'Exit While End If 'AT+QIDNSIP=0 sTemp = MessPull.ExecuteAT(SerialPortA, "AT+QIDNSIP=0", 3000) If sTemp = "OK" Then Me.WriteToConsole(sTemp + vbCrLf) Else Me.WriteToConsole("AT+QIDNSIP=0 Returns ERROR. Script stopped at:" + DateTime.Now.ToLongTimeString + "!" + vbCrLf) _allowRun = False 'Exit While End If 'AT+QIREGAPP sTemp = MessPull.ExecuteAT(SerialPortA, "AT+QIREGAPP", 3000) If sTemp = "OK" Then Me.WriteToConsole(sTemp + vbCrLf) Else Me.WriteToConsole("AT+QIREGAPP Returns ERROR. Script stopped at:" + DateTime.Now.ToLongTimeString + "!" + vbCrLf) _allowRun = False 'Exit While End If 'AT+QIACT sTemp = MessPull.ExecuteAT(SerialPortA, "AT+QIACT", 3000) If sTemp = "OK" Then Me.WriteToConsole(sTemp + vbCrLf) Else Me.WriteToConsole("AT+QIACT Returns ERROR. Script stopped at:" + DateTime.Now.ToLongTimeString + "!" + vbCrLf) _allowRun = False 'Exit While End If 'AT+QILOCIP sTemp = MessPull.ExecuteAT(SerialPortA, "AT+QILOCIP", 3000) If sTemp = "OK" Then Me.WriteToConsole(sTemp + vbCrLf) Else Me.WriteToConsole("AT+QILOCIP Returns ERROR. Script stopped at:" + DateTime.Now.ToLongTimeString + "!" + vbCrLf) _allowRun = False 'Exit While End If End Sub '          Private Function GetLastValue(ByVal sParam As String) As Integer Dim aLine As String() = sParam.Split(",".ToCharArray) GetLastValue = Int(aLine(UBound(aLine))) End Function '  ,     AT-     Private Sub DisplayFunc() Dim enumFunc As IDictionaryEnumerator = MessPull.FuncTable.GetEnumerator Me.WriteToRecieved("Function parametr list:" + vbCrLf, True) enumFunc.Reset() While enumFunc.MoveNext Me.WriteToRecieved(enumFunc.Key + "=" + enumFunc.Value.ToString + vbCrLf) End While End Sub ' Parse string Private Function StringParse(ByVal sText As String, Optional ByVal sParser As String = " ") As String() Dim sParam As Char() = sParser.ToCharArray() StringParse = {} If sText.Length > 0 Then StringParse = sText.Split(sParam) End If End Function Private Sub LoadKeyWord() Dim htKeyWord As Hashtable Dim aKeyToken As System.Delegate() 'aKeyToken.A() htKeyWord = aScript(scNames.scKeyWord) htKeyWord.Add("IF", 0) End Sub Private Sub SendToModem(ByVal sText) If SerialPortA.IsOpen Then SerialPortA.WriteLine(sText) Else TextBoxM.AppendText("Serial port: " + SerialPortA.PortName + " Is closed. Script Aborted!") _allowRun = False End If End Sub #End Region #Region "Event Handler's" ' Procedure handler recept any change in TextBoxM. Send command string to COM-port Private Sub TextBoxM_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBoxM.TextChanged Dim LineNum As Integer LineNum = Me.TextBoxM.Lines.Length If LineNum > 1 Then If (LineNum > _lineCount) Then If _readPort Then If SerialPortA.IsOpen Then _lastLine = Me.TextBoxM.Lines(LineNum - 2) _lastLine = Trim(_lastLine) SerialPortA.WriteLine(_lastLine + vbCrLf) Else _readPort = False Me.TextBoxM.AppendText("Serial port " + SerialPortA.PortName + " serial port is closed, open it first!" + vbCrLf) End If Else _readPort = True End If _lineCount = Me.TextBoxM.Lines.Length End If Else _lineCount = Me.TextBoxM.Lines.Length End If End Sub ' Clear text in TextBoxM on button click Private Sub BtClearText_Click(sender As System.Object, e As System.EventArgs) Handles BtClearText.Click TextBoxM.Clear() TextBoxM.Refresh() _lineCount = 0 End Sub ' Change port Name on ComboBox changes Private Sub ComboBoxCOM_List_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBoxCOM_List.SelectedIndexChanged If _continue Then Call Refresh_COMSetting() TSLabelCOM.Text = ComboBoxCOM_List.Text SerialPortA.PortName = ComboBoxCOM_List.Text End If End Sub ' Change port Parity on ComboBox changes Private Sub ComboBox_ParityList_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox_ParityList.SelectedIndexChanged If _continue Then Try SerialPortA.Parity = ComboBox_ParityList.SelectedIndex Catch ex As Exception 'None MsgBox("Can't set selected parity." + vbCrLf, MsgBoxStyle.Exclamation, AcceptButton) End Try End If End Sub ' Change port Baud Rate on ComboBox changes Private Sub ComboBox_BaudList_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox_BaudList.SelectedIndexChanged If _continue Then SerialPortA.BaudRate = Int(ComboBox_BaudList.Text) TSLabelSpeed.Text = ComboBox_BaudList.Text End If End Sub ' Change port Data Bits on ComboBox changes Private Sub ComboBox_DataBits_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox_DataBits.SelectedIndexChanged If _continue Then SerialPortA.DataBits = Int(ComboBox_DataBits.Text) End If End Sub ' Change port Stop Bits on ComboBox changes Private Sub ComboBox_StopBits_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox_StopBits.SelectedIndexChanged If _continue Then SerialPortA.StopBits = ComboBox_StopBits.SelectedIndex End If End Sub ' Change port Handshake on ComboBox changes Private Sub ComboBox_FlowControl_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox_FlowControl.SelectedIndexChanged If _continue Then SerialPortA.Handshake = ComboBox_FlowControl.SelectedIndex End If End Sub ' Check COM port setting & write text to TextBox Private Sub BTCheck_Click(sender As System.Object, e As System.EventArgs) Handles BTCheck.Click TextBox1.AppendText("Serial port name: " + SerialPortA.PortName + vbCrLf) 'TextBox1.AppendText("Serial port num: " + Str(_serialPort.PortName) + vbCrLf) TextBox1.AppendText("Serial port status: " + IIf(SerialPortA.IsOpen, "Port Open", "Port Closed") + vbCrLf) TextBox1.AppendText("Baud Rate: " + SerialPortA.BaudRate.ToString + vbCrLf) TextBox1.AppendText("Parity: " + SerialPortA.Parity.ToString + vbCrLf) TextBox1.AppendText("Parity Num: " + Str(SerialPortA.Parity) + vbCrLf) TextBox1.AppendText("Data Bits: " + SerialPortA.DataBits.ToString + vbCrLf) TextBox1.AppendText("Stop Bits: " + SerialPortA.StopBits.ToString + vbCrLf) TextBox1.AppendText("Flow Control: " + SerialPortA.Handshake.ToString + vbCrLf) TextBox1.AppendText("Read Timeout: " + SerialPortA.ReadTimeout.ToString + vbCrLf) TextBox1.AppendText("Write Timeout: " + SerialPortA.WriteTimeout.ToString + vbCrLf) TextBox1.AppendText("-------------------------" + vbCrLf + vbCrLf) End Sub ' Clear text recieved in TextBox Private Sub BTClearRecieved_Click(sender As System.Object, e As System.EventArgs) Handles BTClearRecieved.Click TextBox_Recieved.Clear() _lastRead = "" End Sub ' Event handlers on form close. Private Sub CommCare_FormClosed(sender As System.Object, e As System.Windows.Forms.FormClosedEventArgs) Handles MyBase.FormClosed If SerialPortA.IsOpen Then SerialPortA.Close() End Sub ' Open/Close serial port Private Sub BtSerial_Click(sender As System.Object, e As System.EventArgs) Handles BtSerial.Click If SerialPortA.IsOpen Then Try SerialPortA.DiscardInBuffer() SerialPortA.DiscardOutBuffer() SerialPortA.Close() Catch ex As Exception End Try TSLastCommand.Text = "Serial port: " + SerialPortA.PortName.ToString + " closed!" BtSerial.Text = "Open Port" Else Try SerialPortA.Open() SerialPortA.ReadTimeout = 1000 SerialPortA.WriteTimeout = 1000 If SerialPortA.IsOpen Then BtSerial.Text = "Close Port" TSLastCommand.Text = "Serial port: " + SerialPortA.PortName.ToString + " open successfully!" Else BtSerial.Text = "Open Port" TSLastCommand.Text = "Can't open serial port: " + SerialPortA.PortName.ToString End If Catch ex As Exception End Try End If End Sub ' Save COM port setting on menu click Private Sub SaveSettingToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles SaveSettingToolStripMenuItem.Click Dim saveDialog As New SaveFileDialog Dim fName As String saveDialog.InitialDirectory = Application.StartupPath saveDialog.Filter = "INI Files (*.ini)|*.ini" saveDialog.FileName = "Setting.ini" If saveDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub fName = saveDialog.InitialDirectory & "\" & saveDialog.FileName Call WriteConfig(fName) End Sub ' Save at-protocol text from TextBox to file Private Sub SaveATProtocolToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles SaveATProtocolToolStripMenuItem.Click Dim saveDialog As New SaveFileDialog saveDialog.InitialDirectory = Application.StartupPath saveDialog.Filter = "Log Files (*.log)|*.log|All Files (*.*)|*.*" saveDialog.FileName = "CommCare.log" If saveDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub Dim record As New StreamWriter(saveDialog.FileName) record.Write(TextBoxM.Text) record.Close() End Sub ' Load at-protocol text into TextBox from file Private Sub LoapATProtocolToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles LoapATProtocolToolStripMenuItem.Click Dim openDialog As New OpenFileDialog openDialog.InitialDirectory = Application.StartupPath openDialog.Filter = "Log Files (*.log)|*.log|All Files (*.*)|*.*" openDialog.FileName = "CommCare.log" If openDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub Dim read As New StreamReader(openDialog.FileName) TextBoxM.Text = read.ReadToEnd.ToString read.Close() End Sub ' Load form Events. Proceed initialisation Private Sub CommCare_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load Dim fName, defParam, retParam As String _lastRead = "" ' Empty _lastRead _allowEcho = True ' Permit echo the received data handler CB_DataRecived.Checked = False ' Set visual data recieved check ' Collect serial port info adn declare it _continue = False ' prevent reactions to fill ComboBox SerialPortA = New SerialPort() ' Create serial port object ' Define handler to recieved data AddHandler SerialPortA.DataReceived, AddressOf DataReceviedHandler 'SerialPortA.ReadTimeout = 1000 ' set Read timeout 1000mS 'SerialPortA.WriteTimeout = 1000 ' set Write timeout 1000mS Call CollectCOMM_List() ' Collect COM port Names ' Set port name first line ComboBox SerialPortA.PortName = ComboBoxCOM_List.Text Call Refresh_COMSetting() ' Collect the remaining serial port settings ' Complete fragments of the status bar TSLabelSpeed.Text = ComboBox_BaudList.Text TSLabelCOM.Text = ComboBoxCOM_List.Text _readPort = True ' Allow the reaction to the emergence of a new line in TextBoxM ' Read default config file fName = Application.StartupPath & "\Default.ini" Call LoadConfig(fName) _continue = True ' Allow the reaction to changes in the ComboBox's WritePrivateProfileString("INTERNAL", "ScriptSaved", "No", fName) WritePrivateProfileString("INTERNAL", "ScriptSaved", "No", fName) ' TextBox_Recieved.ReadOnly = True End Sub ' Close form events. Execute finishing action Private Sub CommCare_FormClosing(sender As System.Object, e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing Dim fName As String fName = Application.StartupPath & "\Default.ini" Call WriteConfig(fName) If Not (ScriptThread.ThreadState = Threading.ThreadState.Unstarted) Then ScriptThread.Abort() ScriptThread.Join(1000) End If End Sub ' Load COM port setting from file Private Sub OpenSettingToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles OpenSettingToolStripMenuItem.Click Dim openDialog As New OpenFileDialog Dim fName As String openDialog.InitialDirectory = Application.StartupPath openDialog.Filter = "INI Files (*.ini)|*.ini" openDialog.FileName = "Setting.ini" If openDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub fName = openDialog.InitialDirectory & "\" & openDialog.FileName _continue = False Call LoadConfig(fName) _continue = True End Sub ' Test button Parse click. Go parse testing string Private Sub BT_Parse_Click(sender As System.Object, e As System.EventArgs) Handles BT_Parse.Click Dim words() As String Dim word As String Dim textStr As String Dim delim As Char() Dim parseString As String parseString = TB_InStr.Text textStr = TB_Delimiters.Text delim = textStr.ToCharArray() words = parseString.Split(delim, StringSplitOptions.RemoveEmptyEntries) For Each word In words TB_Console.AppendText(word + vbCrLf) Next End Sub ' Test button Clear click. Clear TextBox text. Private Sub BT_Clear_Click(sender As System.Object, e As System.EventArgs) Handles BT_Clear.Click TB_Console.Clear() End Sub ' CheckBox prevent manually changes Private Sub CB_DataRecived_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles CB_DataRecived.CheckedChanged CB_DataRecived.Checked = MessPull.MessageRecieved End Sub ' Load token from file Private Sub LoadTokenToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles LoadTokenToolStripMenuItem.Click Dim openDialog As New OpenFileDialog openDialog.InitialDirectory = Application.StartupPath openDialog.Filter = "Token Files (*.tok)|*.tok|All Files (*.*)|*.*" 'openDialog.FileName = "Default.tok" If openDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub Call LoadToken(openDialog.FileName) WritePrivateProfileString("SCRIPT", "TokenFileName", openDialog.FileName, Application.StartupPath & "\Default.ini") End Sub ' Menu File-Exit Private Sub ExitToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles ExitToolStripMenuItem.Click Application.Exit() End Sub ' Script Save to file Private Sub SaveTaskScriptToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles SaveTaskScriptToolStripMenuItem.Click Dim saveDialog As New SaveFileDialog saveDialog.InitialDirectory = Application.StartupPath saveDialog.Filter = """Go"" Script Files (*.gos)|*.gos|All Files (*.*)|*.*" saveDialog.FileName = "Noname.gos" If saveDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub Dim record As New StreamWriter(saveDialog.FileName) record.Write(TextBox_Script.Text) record.Close() WritePrivateProfileString("INTERNAL", "ScriptSaved", "Yes", Application.StartupPath & "\Default.ini") WritePrivateProfileString("INTERNAL", "ScriptFile", saveDialog.FileName, Application.StartupPath & "\Default.ini") End Sub ' Script Load from file Private Sub LoadTaskScriptToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles LoadTaskScriptToolStripMenuItem.Click Dim openDialog As New OpenFileDialog openDialog.InitialDirectory = Application.StartupPath openDialog.Filter = """Go"" Script Files (*.gos)|*.gos|All Files (*.*)|*.*" 'openDialog.FileName = "CommCare.gos" If openDialog.ShowDialog = Windows.Forms.DialogResult.Cancel Then Exit Sub Dim read As New StreamReader(openDialog.FileName) TextBox_Script.Text = read.ReadToEnd.ToString read.Close() WritePrivateProfileString("INTERNAL", "ScriptLoaded", "Yes", Application.StartupPath & "\Default.ini") WritePrivateProfileString("INTERNAL", "ScriptFile", openDialog.FileName, Application.StartupPath & "\Default.ini") End Sub ' Auto load script check/uncheck Private Sub AutoLoadScriptToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles AutoLoadScriptToolStripMenuItem.Click AutoLoadScriptToolStripMenuItem.Checked = True WritePrivateProfileString("INTERNAL", "ScriptAutoLoad", "Yes", Application.StartupPath & "\Default.ini") End Sub #End Region #Region "COM port Handler's" Private Sub DataReceviedHandler(sender As Object, e As SerialDataReceivedEventArgs) Dim sp As SerialPort = CType(sender, SerialPort) Dim aLine As String() Dim nAt As Integer Dim sParam As Char() Dim sTemp As String Dim indata As String = "" indata = sp.ReadExisting() ' sTemp = vbCrLf sParam = sTemp.ToCharArray() ' _lastRead = _lastRead + indata 'If _lastRead.Length > 1 Then 'If _lastRead = "> " Then 'MessPull.AppendMess(Trim(_lastRead)) '_lastRead = "" 'End If 'End If nAt = InStr(_lastRead, vbCrLf) While nAt > 0 MessPull.AppendMess(Mid(_lastRead, 1, nAt - 1)) _lastRead = Mid(_lastRead, nAt + 2) nAt = InStr(_lastRead, vbCrLf) End While If (_nCharWait > 0) And (_lastRead.Length = _nCharWait) Then MessPull.AppendMess(Trim(_lastRead)) _lastRead = "" _nCharWait = 0 ElseIf _lastRead = "> " Then MessPull.AppendMess(Trim(_lastRead)) _lastRead = "" End If 'If nAt > 0 Then 'aLine = _lastRead.Split(sParam, StringSplitOptions.RemoveEmptyEntries) 'If aLine.Length > 0 Then 'MsPull.AppendLines(aLine) '_lastRead = "" 'End If 'End If ' If _allowEcho Then Call Me.WriteToConsole(indata) End If End Sub #End Region Private Sub BTRunStop_Click(sender As System.Object, e As System.EventArgs) Handles BTRunStop.Click If _allowRun Then _allowRun = False BTRunStop.Text = "Run Script" Else _lastRead = "" CB_DataRecived.Checked = MessPull.MessageRecieved _allowRun = True BTRunStop.Text = "Stop Script" ScriptThread = New Thread(AddressOf RunScript) TimerA.Interval = 10000 TimerA.Enabled = True _timeOut = False ScriptThread.Start() End If End Sub Private Sub TimerA_Tick(sender As System.Object, e As System.EventArgs) Handles TimerA.Tick If Not _timeOut Then _timeOut = True End Sub Private Sub BTTestMsg1_Click(sender As System.Object, e As System.EventArgs) Handles BTTestMsg1.Click Dim nCount As Integer = MessPull.AppendMess(TB_InStr.Text) TSLastCommand.Text = "Message count: " + Str(nCount) End Sub Private Sub BTTestMsg2_Click(sender As System.Object, e As System.EventArgs) Handles BTTestMsg2.Click Dim sText As String = TB_InStr.Text Dim sParam As String = " ,.;:!@#$%&*()-=+|\/?<>" Dim aParam As Char() = sParam.ToCharArray() TSLastCommand.Text = "Message count: " + Str(MessPull.AppendLines(sText.Split(aParam, StringSplitOptions.RemoveEmptyEntries))) End Sub Private Sub BTTestMsg3_Click(sender As System.Object, e As System.EventArgs) Handles BTTestMsg3.Click Dim alines As String() = MessPull.Items() Dim sText As String For Each sText In alines TB_Console.AppendText(sText + vbCrLf) Next End Sub Private Sub BTTestMsg4_Click(sender As System.Object, e As System.EventArgs) Handles BTTestMsg4.Click TB_InStr.Text = MessPull.ExtractMess() TSLastCommand.Text = "Message count: " + Str(MessPull.MsgCount()) End Sub Private Sub BTTestMsgClear_Click(sender As System.Object, e As System.EventArgs) Handles BTTestMsgClear.Click MessPull.ClearMessage() End Sub Private Sub TextBoxBearer_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBoxBearer.TextChanged _QICSGP = TextBoxBearer.Text End Sub Private Sub TextBoxIP_TextChanged(sender As System.Object, e As System.EventArgs) Handles TextBoxIP.TextChanged _QIOPEN = TextBoxIP.Text End Sub End Class