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
Всем наилучшего! Если вы найдете в исходном коде для себя полезные фрагменты — буду рад что оказался полезен!
Автор: StixNematic
![Мой опыт собеседования в Google [оффер на L5]](https://www.pvsm.ru/wp-content/plugins/contextual-related-posts/timthumb/timthumb.php?src=http%3A%2F%2Fwww.pvsm.ru%2Fimages%2F2023%2F12%2F05%2Fmoi-opyt-sobesedovaniya-v-Google-offer-na-L5.jpg&w=100&h=100&zc=1&q=75 "Мой опыт собеседования в Google [оффер на L5]")
