GSM Modem M95 от QUECTEL — опыт освоения

GSM Modem M95 от QUECTEL — опыт освоения

В начале

В первых строках своего поста хочу честно признаться что ранее опыта работы с GSM-модемами у меня не было, однако волею судьбы и служебной необходимостью набрел на сайт питерской конторы «Сатрон» — официального представителя QUECTEL. На сей ресурс забрел в поисках очередной железки — подходящего мне по параметрам GSM-модема и бютжетного GPS-приемника. Так получилось что информацию о продукции в виде даташитов и прочих полезных файлов можно было получить только после регистрации. Так и сделал.

Получив подтверждение через сутки (почти расстроился так долго ждать), первым делом закачал документацию на заинтересовавший меня модуль. На следующий день мне поступил звонок с неизвестного номера, приятный женский голос сообщил что звонит менеджер фирмы «Сатрон» по поводу моей заинтересованности в их продукции. Девушка на том конце телефонного контакта поинтересовалась какой у меня статус — частное лицо, либо юридическое. На этот вопрос ответил вопросом — с какой целью интересуетесь? И случилось то, чего я в принципе не ожидал, девушка объяснила что если я представляю юридическое лицо, то выбранную мною продукцию мне вышлют для испытаний при условии что будет оплачена пересылка. Естественно я согласился, хотя девушка-менеджер сама мне порекомендовала продукцию в ответ на запрошенные параметры. В пожеланиях было получить самый примитивный но предельно дешёвый GSM-модем, с возможностью слать SMS-ки и голосовой связью. В ответ мне были порекомендованы список продукции, а на запрос по модему предложен довольно свежий продукт M95 по цене «примитива». Естественно цен на продукцию я приводить не буду, это наши с «Сатрон» отношения, но замечу что модемы и другие модули были высланы в кратчайший срок и в нескольких экземплярах.

Сразу мне показалось что такой подход несколько странный, с чего это такая щедрость. Однако далее мне стало многое понятно, и дружелюбный подход фирмы, и качественная круглосуточная поддержка, и невероятное качество работы девушки-менеджера.

Дело в том что:

Так не бывает! Весь мой опыт контактов с Российскими поставщиками компонентов вопил — это подстава и очередное «впаривание» гнилого «отстоя». Однако при беглом знакомстве с документацией на модем M95 у меня зародилось странное сомнение, уж очень прорывные характеристики у наглого представителя китайского электронпрома по сравнению с именитыми монстрами, а цена… Это уже совсем отдельная история, боюсь обвинят в рекламе.

Так вот, поскольку опыта работы с модемами у меня было ровным счетом полное зеро, а испытать и проверить соответствие заявленным характеристикам было нужно, пришлось состряпать в Altium-е схему с импульсником на 4.4 вольта а сам модем обвесить необходимой периферией включая разъемы для наушников и микрофона, кнопками ON/OFF и Emergence OFF. Антенну применил AMMAP 003. Вся конструкция согласовалась по FT232LR с USB портом персоналки, причем питание портов FT232LR взято с выхода самого модема (2.8В), так что согласовывать по уровням не пришлось.

Первый старт — порт обнаружен, настраиваю порт в программе CommTrack (пока сырая, писалась сугубо под задачу) и естественно ввожу в окне консоли «AT» и жму . Замечательно! Модем ответил эхом:

AT
OK

Далее начались непонятности. Вначале как это водится решил устроить «звонок другу» (то есть себе). Однако модем устойчиво откликался «NO CARRIER». Сказалась невнимательность при изучении доки — оказывается есть разница при вызове для голосового соединения и для цифрового подключения. К номеру нужно было подцепить ";". К моему стыду я задал вопрос контактному лицу и получил ответ от инженера в весьма краткой и доходчивой форме.

Так, звоню себе на мобильник-вижу вызов. Подтверждаю вызов и пытаюсь поговорить с самим собой — тишина. Оказывается нужно настроить канал аналоговых входов и выходов. Посылаю команду модему «AT+QAUDCH=2».
Следующая попытка дозвониться оказалась удачной, и мне удалось услышать себя же по телефону и в гарнитуре. Удивило невероятно высокое качество звука и четкость речи, отсутствие каких либо эхо и других спецэффектов дешевой связи. Громкость и чувствительность микрофона регулировались в широком диапазоне, однако заводские настройки оказались наиболее удачными.
Немного поигравшись с голосовой связью SMS-ками и освоив необходимый набор команд из арсенала терминальных и GSM, приступил к установке GPRS соединения.

IP-стек и простота в использовании

Естественно установить соединение с удаленным сервером мне помог человек, уже имевший опыт с настройкой профиля соединения, и локальная задача тестирования модема на время отклика и скорости обмена данными заданной размерности была выполнена «по шаблону». Для тех кто еще не сталкивался с M95 приведу фрагмент кода программы на VB.NET.

Фрагмент кода

    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

Это скучная часть тестирующей подпрограммы просто пояснит последовательность действий по установке соединения и настройке профиля на конкретном примере, в котором отсутствует адрес сервера и APN провайдера. Надеюсь с этим затруднений не будет.

Модем тестировался длительной поездкой по городу в подключенном режиме с посещением «мертвых» зон, где связь по телефону обрывается. Вот что удивительно, из более чем 860 пакетов, потеряно было только два, а IP-сессия вообще не прерывалась, не говоря уже о соединении. Модем тестировался в сравнении с довольно известной моделью BGS2 второй версии. Результаты тестов показали сокрушительный провал Cinterion BGS2 по устойчивости связи и скорости обмена в пользу M95. Надо сразу отметить что оба модема питались от USB порта ноутбука и имели одинаковые антенны AMMAP 003, однако для BGS2 требовался конденсатор по питанию 1000мФ, а M95 обошелся согласно документации 100 микрофарадами. При этом средний ток потребления M95 был на 46% ниже чем у BGS2. Весьма впечатляющие результаты, а если вспомнить что для написания тестовой программы для M95 у меня ушло два дня, а для BGS2 пришлось «потеть» четыре, то очевидные преимущества (по крайней мере для меня) налицо.

В общем мой первый опыт знакомства с продукцией QUECTEL в виде модема M95 весьма меня порадовал, я в первый раз столкнулся с продукцией которую делали именно для разработчиков, без абстрактного умничанья и соблюдения мертвых стандартов.

Да простят меня уважаемые читатели хабра за воспевание M95, но мне ничего подобного просто не встречалось в моей практике, и перелопаченные после этого восемь моделей совместимых GPRS модемов 12 класса убедили меня что лучше и главное дешевле, а также экономичнее и непритязательнее модема пока на российском рынке не представлено!

Сухой код

Для тех, кто пожелает использовать мои наработки, привожу сырой, но работоспособный код модуля с классом использовавшимся в примере приведенном выше а также полную версию кода формы.

Код модуля содержащего класс:

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

Всем наилучшего! Если вы найдете в исходном коде для себя полезные фрагменты — буду рад что оказался полезен!