$regfile = "m64def.dat"
$crystal = 16000000
$baud = 19200
$hwstack = 64
$swstack = 64
$framesize = 100

Declare Sub Getline(s As String)
Declare Sub Flushbuf()

Config Serialin = Buffered , Size = 60
Config 1wire = Portd.3                                      'сюда лепим 18b20

Enable Interrupts

'подключение светодиода
'======================================================================================
Config Porta.2 = Output
Led Alias Porta.2
Led = 0

'вход для контроля включенности модуля
'===========================================================================================
Config Portd.4 = Input
Vkl Alias Pind.4

'пин для включения модуля
'======================================================================================
Config Portd.5 = Output
Powerkey Alias Portd.5
Powerkey = 0

'--------------------------------------------------------------------------------------
Dim Number As String * 11                                   'номер телефона
Dim Temp As String * 10
Dim Temp1 As String * 10
Dim Temp2 As String * 10
Dim Rs As Byte
Dim A As Byte
Dim S As String * 50
Dim B As Byte
Dim R As Byte
Dim Z As String * 15
Dim Sms_num As String * 2                                   'порядковый номер смс
Dim Stmp As String * 1
Dim Sms As String * 120
Dim Otvet As String * 160                                   'сообщение, которое модуль будет отправлять
Dim Sk As String * 66
Dim Tmr As Byte
Dim Sms_val As Byte

Dim F As Byte
Dim Error As Byte                                           'переменная считающая попытки достучаться до модуля перед перезагрузкой
Dim U As Byte                                               'счетчик пустых циклов, если переполнился то выход из цикла подпрограммы getline
Dim Loadpin As Bit                                          'значение пина выхода под нагрузку
Dim Pirsend As Bit                                          'переменная для разрешения отправки сообщения по срабатыванию датчика движения
Dim Loadpinstr As String * 3
Dim Pirstr As String * 1
Dim Pirsendstr As String * 3

Pirsend = 1                                                 'запрет отсыла сообщений
Dim Byte0 As Byte
Dim Byte1 As Byte
Dim T1 As Byte
Dim T2 As Byte
Dim Tstr As String * 4

Dim Numb As Byte
Dim Connect As String * 6                                   'уровень сигнала
Dim Connectvar As Byte                                      'уровень сигнала в числовом значении
Dim Operator As String * 20
Dim Date_str As String * 20
Dim Time_str As String * 20

'---------------------------------------------------------------------------------------
Const Phonenumber = "+7908390хххх"                          'номер на который будут отправляться смс

'поехали

'$include "sim900.bas"                                       'включение и верификация модуля

'предварительные настройки
'********************************************************
Led = 1
Print "AT+CMGF=1"                                           'включаем текстовый формат сообщений
Waitms 50
Print "AT+CLIP=1"                                           'определение номера входящего вызова
Wait 3
Led = 0
Flushbuf

'###########################################################################
'Основная программа
'###########################################################################

Do

Led = 1
Gosub Checkmodule                                           'проверка работоспособности модуля
Gosub Readsms                                               'проверка буфера на наличие входящего сообщения
Gosub Readfirstsms                                          'читаем первую смс, если есть
Gosub Checksms                                              'выполняем подпрограмму с смс
'Gosub Operator                                              'идентификатор оператора
'Gosub Connect                                               'уровень сигнала
'Gosub Time_date                                             'время и дата
Gosub Eb500ans
Led = 0

Wait 10

Loop

End

'подпрограмма для разбора сообщения модуля
'=============================================================================
Sub Getline(s As String)
   S = ""
   Do

      B = Inkey()                                           'берем символ из буфера в формате ASCII
      Select Case B
          Case 0                                            'возвращает в случае пустого буфера
          Case 13                                           'возврат каретки (Enter), заместо него можно поставить пробел
          Case 10 : If S <> "" Then Exit Do                 'конец строки, значит выходит из подпрограммы
          Case Else : If B > 31 Then S = S + Chr(b)         'печатаемые символы начинаются с кода 32 по таблице АСКИ, из них составляем строку
      End Select
   Loop
End Sub

'очистка буфера
'=============================================================================
Sub Flushbuf()
Waitms 100
Do
B = Inkey()                                                'забираем все из буфера
Loop Until B = 0
End Sub

'Подпрограмма для чтения смс
'=============================================================================
Readsms:
R = Ischarwaiting()                                         'проверка наличия сообщения в буфере
  If R = 1 Then
     Getline Sk                                             'уходим на подпрограмму и смотрим что пришло
     Z = Left(sk , 4)                                       'вытаскиваем левые 4 символа

        If Z = "+CMT" Then                                  'если +СМТ, значит пришло смс которое надо прочитать
           Sms_num = Right(sk , 2)                          'смотрим какая по счету смс
           Stmp = Left(sms_num , 1)                         'смотрим первый символ слева
               If Stmp = "," Then
                 Sms_num = Right(sk , 1)                    'если там "," значит берем первый символ справа. это и будет номером пришедшего смс
               End If
           Wait 1
           Number = ""
           Print "AT+CMGR=" ;                               'команда на чтение смс
           Print Sms_num                                    'отправляем номер  смски которую надо прочитать
           Waitms 10
           Getline Sk
           Waitms 10
           Getline Sk
           Number = Mid(sk , 22 , 12)                       'достаем номер с которого пришла смска
           Sms = Sk                                         'здесь первая строка ответа
           Waitms 10
           Getline Sk                                       'смотрим, что в этой смс
           Sms = Sk
           Sms = Left(sms , 14)                             'берем только первые 14 символов из смс (по кол-ву знакомест в строке)

            Do
              Led = 0
              Waitms 100
              Led = 1
              Waitms 50
              Incr F
            Loop Until F = 10                               'десять раз мигнем сетодиодом
            F = 0

           Print "AT+CMGDA=" ; Chr(34) ; "DEL ALL" ; Chr(34)       'удаление смс

        End If

      Waitms 100
      Flushbuf                                              'очищаем буфер

  End If

Return

'обработка команд из входящей смс
'======================================================================================================
Checksms:

If Sms = "1" Then                                           'если 1, модуль запросит баланс и пришлет нам ответ
Gosub Balanse
Sms = ""
Number = ""
End If

If Sms = "2" Then                                           'если в смс содержится 2, отправим обратно ответ с координатами
   Gosub 18b20
   Otvet = Sign + Tstr
   Gosub Sendsms
   Flushbuf
End If

Return

'подпрограмма отправки смс
'=============================================================================
Sendsms:

If Smsenble = 1 Then
Print "AT+CMGS=" ; Chr(34) ; Phonenumber ; Chr(34)
Waitms 200
Print Otvet ; Chr(26)

Print Chr(26);
Wait 1
Print Chr(13)
'мигнем светодиодом

    Do
    Led = 0
    Waitms 100
    Led = 1
    Waitms 50
    Incr F
    Loop Until F = 10
    F = 0

Return
End If

'Информация об уровне сигнала
'=====================================================================
Connect:
Print "AT+CSQ"                                              'уровень сигнала
  Waitms 300
  Getline Sk
  Waitms 100
   Getline Sk
   Connect = Sk

  Connect = Mid(connect , 7 , 2)
  Connectvar = Val(connect)

    If Connectvar > 0 And Connectvar < 32 Then              'отрисовка уровня сигнала
    Smsenble = 1
    Elseif Connectvar = 0 Or Connectvar = 99 Then
    Smsenble = 0
    End If
   Flushbuf
Return

'узнаем баланс
'=================================================================================
Balanse:
  Print "ATD*100#"
  Wait 1
  Getline Sk
  Getline Sk
  Getline Sk
  Otvet = Sk
  Gosub Sendsms
Flushbuf
Return

'проверка работоспособности модуля, если не проходит перезагружаем модуль
Checkmodule:
  If Loadpin = 0 Then
   Loadpinstr = "Off"
  Else
   Loadpinstr = "ON"
  End If
If Vkl = 0 Then                                             'если здесь ноль, то все гуд - модуль SIM900D включен
Else                                                        'а вот если 1, значит модуль вырубился - надо перезагрузить
  Wait 2
    If Vkl = 1 Then                                         'проверяем еще раз и если там по прежнему 1 перезагрузим
     Goto Pwrmodule
    Else
    End If
End If
Flushbuf
Waitms 10
Return

'=======================================J
Eb500ans:
'раскладываем строку содержащую идентификатор $GPRMC
'пример строки
'$GPRMC,190813.000,A,5312.7581,N,05009.1821,E,0.30,256.15,231212,,,A*62

Do
R = Ischarwaiting(#1)                                       'проверка наличия сообщения в буфере
  If R = 1 Then
     Getlineg S                                             'уходим на подпрограмму и смотрим что пришло
     Z = Left(s , 4)                                        'вытаскиваем левые 4 символа
        If Z = "$GPR" Then

           Shirota = Mid(s , 21 , 9)                        '5312.7581
           Dolgota = Mid(s , 33 , 10)                       '05009.1821

           Z = Left(shirota , 1)                            'если там "," данные с модуля идут пустые, их выводить не нужно
           If Z <> "," Then

            Ns = Mid(s , 31 , 1 )                           'N
            Ew = Mid(s , 44 , 1)                            'E

            'обработка широты и долготы под формат гуглокарт
            Grad_shirota = Left(shirota , 2 )
            Minuta_shirota = Mid(shirota , 3 , 2)
            Second_shirota = Right(shirota , 4)
             Temp = Val(second_shirota)                     '7581
             Temp = Temp * 60                               '454860
             Temp = Temp / 10000                            '45,486
            Second_shirota = Fusing(temp , "##.##")         '45.49

            Grad_dolgota = Left(dolgota , 3 )
            Minuta_dolgota = Mid(dolgota , 4 , 2)
            Second_dolgota = Right(dolgota , 4)
             Temp = Val(second_dolgota)                     '1821
             Temp = Temp * 60                               '109260
             Temp = Temp / 10000                            '10,926
            Second_dolgota = Fusing(temp , "##.##")         '10,93

            'обработка скорости и азимута движения
            Skorost = Mid(s , 46 , 4)                       '0.30 (в узлах)
             Temp = Val(skorost)
             Temp = Temp * 1.852                            'перевод в км/ч
            Skorost = Str(temp )
            Skorost = Format(skorost , "000.00")

            'время UTC
            Hour = Mid(s , 8 , 2)                           '19
            Minut = Mid(s , 10 , 2)                         '08
            Second = Mid(s , 12 , 2)                        '13

          Otvet =ns + grad_shirota + "°" + minuta_shirota + "'" + second_shirota + "''" + ew + grad_dolgota + "°" + minuta_dolgota + "'" + second_dolgota + "''" + Chr(10) + skorost + "km/h" + Chr(10) + hour + ":" + minut + ":" + second +"UTC"
      Gosub Sendsms
      
          Flushbufg                                         'очищаем буфер обмена
          Else
           Flushbufg
          End If
        End If
  End If
Loop
End

'подпрограмма для разбора сообщения модуля
'=============================================================================
Sub Getlineg(s As String)
   S = ""
   Do
      B = Inkey()                                           'берем символ из буфера в формате ASCII
      Select Case B
          Case 10 : If S <> "" Then Exit Do                 'конец строки, значит выходит из подпрограммы
          Case Else : If B > 31 Then S = S + Chr(b)         'печатаемые символы начинаются с кода 32 по таблице АСКИ, из них составляем строку
      End Select
  Loop
End Sub

'очистка буфера
'=============================================================================
Sub Flushbufg()
Waitms 10
Do
B = Inkey()                                                 'забираем все из буфера
Loop Until B = 0
End Sub

'принудительное чтение первой смс из памяти
'это необходимо если прошляпили приход смс, во время выполнения одной из подпрограмм
'==========================================================================================
Readfirstsms:

  Print "AT+CMGR=1"                                         'команда на чтение смс
  Waitms 10
  Getline Sk
  Waitms 10
  Getline Sk
  Number = Mid(sk , 22 , 12)                                'достаем номер с которого пришла смска
  Sms = Sk                                                  'здесь первая строка ответа
  Sms = Left(sms , 4)

   If Sms = "+CMG" Then

    Waitms 10
    Getline Sk                                              'смотрим, что в этой смс
    Sms = Sk
    Sms = Left(sms , 14)                                    'берем только первые 14 символов из смс (по кол-ву знакомест в строке)

            Do
              Led = 0
              Waitms 100
              Led = 1
              Waitms 50
              Incr F
            Loop Until F = 10                               'десять раз мигнем сетодиодом
            F = 0
  Print "AT+CMGDA=" ; Chr(34) ; "DEL ALL" ; Chr(34)         'удаление всех смс

End If

  Waitms 100
  Flushbuf                                                  'очищаем буфер

Return

Pwrmodule:

'Включение, регистрация и верификация модуля
'********************************************************

Led = 1
Powerkey = 1

F = 0
Waitms 270

Do
   Waitms 270
  Incr F
Loop Until F = 2

Powerkey = 0
Led = 0

Print "AT+CREG?"
Waitms 500
   Getline Sk
   Waitms 100
   Getline Sk
   Reg = Sk
   Reg = Mid(reg , 7 , 3)

if Reg = "0,0" Then
  Gosub  Pwrmodule 
end if

if Reg = "0,2"Then
  Gosub  Pwrmodule 
end if

  Incr F
Loop Until F = 6                                           'ждем окончания регистрации, примерно 10 секунд

   Incr F                                                   'f=7

'прогрессбар верификации ответа модуля на команду АТ

    Do
     Print "AT"
      Waitms 40
      Getline Sk
    Loop Until Sk = "OK"                                    'не выйдет из цикла пока модуль не ответит OK
    Flushbuf

  Incr F                                                    'f=8

'удаление смс из памяти сим-карты

   Print "AT+CMGDA=" ; Chr(34) ; "DEL ALL" ; Chr(34)        'удаление смс

   Do
      Waitms 40
      Getline Sk
    Loop Until Sk = "OK"                                    'не выйдет из цикла пока модуль не ответит OK
    Flushbuf

   Incr F                                                   'f = 9

Flushbuf