Администрация форума не несёт ответственности за достоверность информации и оставляет за собой право редактировать или в особых случаях даже удалять посты без предупреждения. Спасибо за понимание.

Программирование ATMEL в BASCOM.

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » Программирование ATMEL в BASCOM. » Разное » Руки чешуться - ПЕРФОФЛЕШКА!!!


Руки чешуться - ПЕРФОФЛЕШКА!!!

Сообщений 1 страница 20 из 20

1

Друзья! Вчера захожу в цех и вижу картину, как два электромеханика перфолентят старый станок, но это ещё не всё, есть ещё пару станков, которые каждый день перфолентой кормят. Неудержался, видео отснял  :crazy:

Назревает новое устройство - Перфофлешка!!!  :D
Думаю Atmega32 с SD картой потянет. Воткнул, нажал кнопку и всё в станке )))
Может идейки есть, статейки, решения?

Отредактировано Ev3658 (2015-03-26 13:49:32)

0

2

пора на визитки записывать информацию как на перфокарты)

0

3

RDW написал(а):

пора на визитки записывать информацию как на перфокарты)

Жене напишу любовное послание, приклею к открытке с мини инструкцией по расшифровке ))))
Получилось с компьютера перфокарить и обратно считывать  :cool:
Нашёл описание протокола, думаю смогу Atmega по UART подружить, может кто видел проект DOS и Usb накопитель в BascomAVR? Теоретически можно и без флешки обойтись, программы там не маленькие, 12кБ один моток!!!  :D

0

4

я делал такое для станка: делал плату + МК.
там куча нюансов может быть: от старт-стоповых сигналов, до данных АРУ от фоторезистора...
делал без usb - хранил в i2c памяти
fat делал на mega128 (читает данные + воиспроизведение wav-файлов с моими звуковыми инструкциями)

0

5

Почесал руки  :D

Вот у нас такое чудо есть:
https://pp.vk.me/c625625/v625625961/4b93a/nC0zn8pIrnU.jpg

Сломался у него перфомафон (ФСУ фото счит.устройтсво)

https://pp.vk.me/c625625/v625625961/4b985/dR2eQgpn4jA.jpg

Танцы с бубном, анализ сигнала, куча мукулатуры по перфоленте, а так-же гугла, яндекс и т.п.

https://pp.vk.me/c625625/v625625961/4b931/m37fSsBXHUw.jpg

https://pp.vk.me/c625625/v625625961/4b927/fL9HV5hr_HY.jpg

Проект поднял на Atmega328p, не стал парится, использовал плату и SD модуль от Ардуино.

https://pp.vk.me/c625625/v625625961/4b968/2Tve2QOIFcU.jpg

https://pp.vk.me/c625625/v625625961/4b95e/Mr-QZZZR8tY.jpg

https://pp.vk.me/c625625/v625625961/4b94c/Czn3YyBWzK8.jpg

Прощай перфолента!

https://pp.vk.me/c625625/v625625961/4b97b/8cUL6Ar5SP8.jpg

Использовал AVR DOS, алгоритм простой. Для отсылки в станок, оказалось для передачи символом ASCII семи бит, восьмой бит шел как контроль чётности.

Вот кусочек шаманского кода )))))

Код:
Dlinactenia = 0
Open File For Input As #1                                   'открываем файл Log.txt и записываем в него данные
Do
If Ctenie = 1 Then
   Lineinput #1 , Dat
   Ctenie = 0
   Dlinactenia = Dlinactenia + 1
   L = Len(dat)
   L = L + 1
   Simvol = 0
End If


If Star = 1 Then

   Simvol = Simvol + 1
   Bukva = Mid(dat , Simvol , 1)
   If Simvol = L Then
      Bait = 13
      Else
      Bait = Asc(bukva)
   End If

   A = 0
   For O = 0 To 6
         If Bait.o = 1 Then A = A + 1
   Next O
   If A = 1 Then Bait.7 = 1
   If A = 3 Then Bait.7 = 1
   If A = 5 Then Bait.7 = 1
   If A = 7 Then Bait.7 = 1
   '===================================
   Gosub Outbit
                                                                                                                                                             'посылаем данные
   Ig = 0                                                   'стробирем для того, чтоб принял
   Waitms 1                                                 'делаем паузу для строба
   Ig = 1                                                   '
   If Simvol > L Then Ctenie = 1

   '===== Вывод выводимой информации в терминал не обязательный блок ============
   '   If Bait.7 = 1 Then Print "|"; 'для обозначения нечётного числа
   Bait.7 = 0
   '(
   If Bait = 13 Then
                  Print Chr(bait)
                   Else
                   Print Chr(bait);
   End If
')
'===================================

   P = 0
End If

If Star = 0 And P = 0 Then
    Waitms 10
    P = 1
End If

https://pp.vk.me/c625625/v625625961/4b943/62PJc7QppGw.jpg

Отредактировано Ev3658 (2015-09-26 15:33:14)

+2

6

молодец! :)
приятно читать о таких вот творениях

0

7

Первый вариант сделал без SD флешки, просто забил программу в контроллер.
Использовал информацию из проекта "Синтезатор речи RC2 на AVR (говорилка)", там программа есть, которая из Wav делает блок "Data .. ... ... ". Просто взял, указал текстовый блокнот и он мне в DATA перевёл. Станку понравилось  :cool:

Вот, полностью рабочая программа без SD флешки:

Код:
$regfile = "m328pdef.dat"
$crystal = 16000000
$hwstack = 40
$swstack = 16
$framesize = 32
$baud = 9600                                                                                        'если используете UART

Config Portc = Output
Config Portd = Input
Config Portb = Input

'==== конфигурация портов
D0 Alias Portc.5                                                                                    'Шина данных Db0
D1 Alias Portc.4                                                                                    'Шина данных Db1
D2 Alias Portc.3                                                                                    'Шина данных Db2
D3 Alias Portc.2                                                                                    'Шина данных Db3
D4 Alias Portc.1                                                                                    'Шина данных Db4
D5 Alias Portc.0                                                                                    'Шина данных Db5
D6 Alias Portb.2                                                                                    'Шина данных Db6
D7 Alias Portb.1                                                                                    'Шина данных Db7 (используется для проверки чётности)
Config Portb.2 = Output
Config Portb.1 = Output

Config D0 = Output
Config D1 = Output
Config D2 = Output
Config D3 = Output
Config D4 = Output
Config D5 = Output
Config D6 = Output
Config D7 = Output


Ig Alias Portd.5                                                                                    'выход ИНФОРМАЦИОННАЯ ГОТОВНОСТЬ
Config Ig = Output
Star Alias Pind.6                                                                                  'выход "СТАРТ"
Stp Alias Pind.7                                                                                    'выход "СТОП" (почему-то всегда 1 даже если старт=1)
Nd Alias Pinb.0                                                                                  'выход "НД" (направление движения)

Fsg Alias Portd.4                                                                                  'Готовность Фск (ЕСЛИ 1 ТО ГОТОВ)
Config Fsg = Output

'====== Переменные
Dim Bait As Byte
Dim O As Byte
Dim A As Byte
Dim P As Integer
Dim I As Integer                                                                                    'служит для ограничения чтения данных из памяти

Goto Prog:                                                                                                ' переход на главную прогармму
'=========== Начало подпрограмм=================================
'==== Подпрограмма отправки данных в шину данных
Outbit:
D0 = Bait.0
D1 = Bait.1
D2 = Bait.2
D3 = Bait.3
D4 = Bait.4
D5 = Bait.5
D6 = Bait.6
D7 = Bait.7
Return
'=====================================================================
'================= ГЛАВНАЯ ПРОГРАММА =================================
'=====================================================================
Prog:
Fsg = 0
Wait 1
Fsg = 1
Ig = 0
'Print "OK"
Restore Dat

Do                                                                                                                '==== вечный цикл
'=== ограничиваем размерность массива, а то полезет в другие области памяти
If I = 908 Then                                                                                  '908 - 'колличество символов в блоке данных
   Restore Dat:  'переходим в начало блока данных DATA
   I = 0                                                                                                    'обнуляем счётчик отосланных данных
End If
'===================================================== БЛОК СТАРТА ==========================
'=== Если дан сигнал СТАРТ=1, пускаем данные
If Star = 1 Then
   '=== Посылка байта=======
   Read Bait : I = I + 1                                                                    'считываем данные из блока DATA и прибовляем счётчик для последующей проверки, чтоб не ушли за пределы блока DATA
   '=== Проверка чётности==============
   'пробегаемся по битам, находим единицы, подсчитываем кол-во и выводим вердикт
   A = 0
   For O = 0 To 6
          If Bait.o = 1 Then A = A + 1
   Next O
   If A = 1 Then Bait.7 = 1
   If A = 3 Then Bait.7 = 1
   If A = 5 Then Bait.7 = 1
   If A = 7 Then Bait.7 = 1
   '===================================

   Gosub Outbit                                                                                  'посылаем данные
   Ig = 0                                                                                                  'стробирем для того, чтоб принял
   Waitms 1                                                                                              'делаем паузу для строба
   Ig = 1                                                                                                  '

'(
   '===== Вывод выводимой информации в терминал не обязательный блок ============
   '   If Bait.7 = 1 Then Print "|"; 'для обозначения нечётного числа
   Bait.7 = 0
   If Bait = 13 Then
          Print Chr(bait)
           Else
           Print Chr(bait);
   End If
'===================================
')
   P = 0
End If
'===========================================================================================
'==== если страт = 0 то делаем паузу в отсылке данных
If Star = 0 And P = 0 Then
    Waitms 10
    P = 1
End If

'=== если сработал главный стоп, то переходим в начала отсылаемых данных
If Stp = 1 And Star = 0 Then
          Restore Dat                                                                              'переходим в начало блока данных DATA
          I = 0
End If
Loop                                                                                                        ' вечный цикл, опять в Do
End                                                                                                              'конец программы

'==================== БЛОК ДАННЫХ ========================================================
Dat:
' ddd
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H25 , &HA , &H0 , &H0 , &H0 , &H0
Data &H0 , &H0 , &H3A , &H30 , &H37 , &HA , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H28 , &H52 , &H4A , &H43
Data &H48 , &H41 , &H47 , &H33 , &H33 , &H31 , &H30 , &H34 , &H29 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E
Data &H32 , &H47 , &H39 , &H30 , &H47 , &H31 , &H37 , &H47 , &H35 , &H34 , &H47 , &H31 , &H58 , &H2B , &H36 , &H30
Data &H2E , &H7F , &H7F , &H7F , &H59 , &H2D , &H36 , &H30 , &H2E , &H46 , &H35 , &H30 , &H30 , &H30 , &H7F , &HA
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H33 , &H53 , &H38 , &H30 , &H30 , &H4D , &H30 , &H33
Data &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H34 , &H5A , &H2D , &H32 , &H36 , &H2E , &H4D , &H30
Data &H38 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H35 , &H47 , &H34 , &H32 , &H58 , &H2B , &H33
Data &H38 , &H2E , &H34 , &H39 , &H46 , &H32 , &H35 , &H30 , &H44 , &H31 , &H37 , &HA , &H0 , &H0 , &H0 , &H0
Data &H4E , &H37 , &H59 , &H2D , &H33 , &H36 , &H7F , &H2E , &H39 , &H38 , &HA , &H0 , &H0 , &H0 , &H0 , &H0
Data &H4E , &H38 , &H58 , &H2B , &H37 , &H32 , &H2E , &H39 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H38
Data &H38 , &H47 , &H34 , &H30 , &H59 , &H2D , &H34 , &H34 , &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H4E , &H39
Data &H47 , &H34 , &H32 , &H59 , &H2D , &H33 , &H34 , &H2E , &H34 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H30 , &H58 , &H2B
'------
Data &H38 , &H38 , &H2E , &H35 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H31 , &H47 , &H34
Data &H30 , &H59 , &H2D , &H34 , &H35 , &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H32 , &H47
Data &H31 , &H5A , &H2B , &H31 , &H32 , &H2E , &H46 , &H33 , &H30 , &H30 , &H30 , &HA , &H0 , &H0 , &H0 , &H0
Data &H0 , &H4E , &H31 , &H33 , &H58 , &H2B , &H39 , &H30 , &H2E , &H59 , &H2D , &H31 , &H32 , &H2E , &HA , &H0
Data &H0 , &H0 , &H0 , &H4E , &H31 , &H34 , &H5A , &H2D , &H32 , &H36 , &H2E , &HA , &H0 , &H0 , &H0 , &H0
Data &H0 , &H0 , &H4E , &H31 , &H35 , &H47 , &H34 , &H32 , &H59 , &H2D , &H32 , &H35 , &H2E , &H36 , &H46 , &H32
Data &H35 , &H30 , &H44 , &H31 , &H37 , &HA , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H36 , &H58 , &H2B , &H37
Data &H32 , &H2E , &H39 , &HA , &H0 , &H0 , &H0 , &H0 , &H4E , &H36 , &H31 , &H36 , &H47 , &H34 , &H30 , &H59
Data &H2D , &H31 , &H37 , &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H37 , &H47 , &H34 , &H32
Data &H59 , &H2D , &H32 , &H33 , &H2E , &H30 , &H32 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H38 , &H58 , &H2B
Data &H33 , &H38 , &H2E , &H34 , &H39 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H39 , &H59
Data &H2D , &H31 , &H35 , &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H32 , &H30 , &H47 , &H34 , &H30
Data &H58 , &H2B , &H35 , &H30 , &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H32 , &H31
Data &H47 , &H39 , &H30 , &H47 , &H35 , &H35 , &H47 , &H31 , &H59 , &H2B , &H31 , &H30 , &H2E , &H46 , &H32 , &H30
Data &H30 , &H30 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H32 , &H32 , &H47 , &H34 , &H32 , &H58
'------
Data &H2B , &H33 , &H38 , &H2E , &H34 , &H39 , &H46 , &H32 , &H35 , &H30 , &H44 , &H31 , &H37 , &HA , &H0 , &H0
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H32 , &H33 , &H59 , &H2B , &H32 , &H33 , &H2E
Data &H30 , &H32 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H30 , &H58 , &H2B , &H37 , &H32 , &H2E , &H39
Data &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H39 , &H30 , &H47 , &H34 , &H30 , &H59 , &H2B , &H31 , &H37
Data &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H39 , &H47 , &H34 , &H32 , &H59 , &H2B , &H32 , &H35
Data &H2E , &H36 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31
Data &H30 , &H58 , &H2B , &H38 , &H38 , &H2E , &H35 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31
Data &H31 , &H47 , &H34 , &H30 , &H59 , &H2B , &H31 , &H38 , &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E
Data &H32 , &H38 , &H47 , &H31 , &H5A , &H2B , &H31 , &H32 , &H2E , &H46 , &H33 , &H30 , &H30 , &H30 , &HA , &H0
Data &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H33 , &H58 , &H2B , &H39 , &H30 , &H2E , &H59 , &H2B , &H34 , &H38
Data &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H34 , &H5A , &H2D , &H32 , &H36 , &H2E , &HA , &H0
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H35 , &H47 , &H34 , &H32 , &H59 , &H2B , &H33 , &H34 , &H2E
Data &H34 , &H46 , &H32 , &H35 , &H30 , &H44 , &H31 , &H37 , &HA , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H36
Data &H58 , &H2B , &H37 , &H32 , &H2E , &H39 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H36 , &H36
Data &H47 , &H34 , &H30 , &H59 , &H2B , &H34 , &H34 , &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31
Data &H37 , &H47 , &H34 , &H32 , &H59 , &H2B , &H33 , &H36 , &H2E , &H39 , &H38 , &HA , &H0 , &H0 , &H0 , &H0
'------
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H38 , &H58 , &H2B , &H33 , &H38
Data &H2E , &H34 , &H39 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H31 , &H39 , &H59 , &H2B , &H34
Data &H35 , &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H33 , &H36 , &H47 , &H34 , &H30 , &H58 , &H2B
Data &H35 , &H30 , &H2E , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H33 , &H37 , &H47 , &H31 , &H5A , &H2B
Data &H36 , &H30 , &H2E , &H46 , &H32 , &H30 , &H30 , &H30 , &H4D , &H30 , &H39 , &HA , &H0 , &H0 , &H0 , &H0
Data &H4E , &H33 , &H38 , &H59 , &H2B , &H31 , &H30 , &H30 , &H2E , &H46 , &H36 , &H30 , &H30 , &H30 , &H4D , &H30
Data &H35 , &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H4E , &H33 , &H39 , &H4D , &H30 , &H32
Data &HA , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H25 , &H25 , &HA , &H0 , &H0 , &H0 , &H0 , &H0
Data &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0 , &H0
' Размер - 908

Я скомпилировал программу, которая преобразует файлы в блок DATA, спасибо автору, выручает ))). Если чего, вот она - https://yadi.sk/d/ZV-DHldijGAqz

А ещё есть прикол. зацените вот то, что продаётся заместо того, что я сделал  :D

http://stanok.cncinfo.ru/files/catalog/46/gallery/big/3e33355c8710a1210f8678d8f.jpg

УСТРОЙСТВО ВВОДА ПРОГРАММ УСВП-01

Может отослать им исходники, пускай модернезируются  :crazy:

Отредактировано Ev3658 (2015-09-26 20:38:38)

+2

8

Пошли им просто фоты или ссыль дай, пусть позавидуют.  :crazy:

0

9

RDW написал(а):

Пошли им просто фоты или ссыль дай, пусть позавидуют.

Они ответили, что это старая модель, у них теперь по Ethernet и с флешки может получать данные  :rolleyes:

0

10

Другая рука зачесалась!!!! Уже нужно решение с Uart.
Есть 4ре древних ЧПУ станка, так UART очень мудрый, с компа фиг в него запихнёшь. Взял Arduino Nano, взял... и спалил всё к чертям.
Оказался, блок ЧПУ нужно запитывать через разделительный трансформатор. Я так-то включил его, он током не бился, воткнул в него устройство, попёрли искры и вырубилось всё. Решил заземлить, так из блока ЧПУ повалили искры, перевернул вилку в розетке, из ЧПУ попёр огонь.
Вообщем восстановил всё, под рукой это-го говна достаточно.
Два дня боролся с глюками и неприятностямИ, то флешка сдохла, то Arduino Nano занимало RX/TX, то преобразователь не хотел вырабатывать много (сделал на плате умножитель, работающий на 1 полевом транзисторе с Timer1), то LCD 5110 не работал вообще с любой библиотекой из поисковика, а альтернатива была только по I2C и тут блок оказался с тайным адресом...всё-же наколхозил!
Смог получить на 3е сутки данные с ЧПУ блока!!!!

Сегодня 4е сутки, с самого утра боролся с этим Uart, но под вечер открыл для себя тайные регистры и ЧПУ блок скушал наконец-то чего-то, но не до конца.

0

11

Как всегда молодец!
Камера правда оптика заляпаная, всё в тумане)

0

12

RDW написал(а):

.... всё в тумане)

Отснял по лучше и подробнее  :D

Культурная версия:

Отредактировано Ev3658 (2016-03-29 11:05:03)

0

13

Видео надеюсь будет, ну, а так, вот, сделал инструкцию для перегарного Валеры, в картинках  :crazy:
http://cs626221.vk.me/v626221961/2ac1/lkT-oeqnIhI.jpg

Формат: Word 2007
Файл: https://yadi.sk/d/-ZcY9n5zqzJJx
Хотелось бы много чего успеть, но думаю, вы оцените возможности созданного устройство на Китайском LCD.
Правда есть одна дилемма, что сделать с исходником? Скинуть на флешку и закопать на два метра в глубину или всё сжечь?

Код:
'--------------------   Конфигурация используемого МК   ------------------------
$regfile = "m128def.dat"
$crystal = 14745600
$framesize = 200
$hwstack = 200
$swstack = 220
 '---------------------- ПЕРЕМЕННЫЕ


Const Cn1 = 0.0048
Const Cn2 = 0.010
Const Cn3 = 3.4
Const Cn4 = 4.5
Const Cn5 = 4.1

Dim Servic As Bit
Dim Tr1 As Byte
Dim Tr5 As Byte
Dim Tr6 As Byte
Dim Kn As Byte
Dim Schau As Byte
Dim Vibor As Bit
Dim Prob As Byte
Dim Maxx As Long
Dim B As Byte
Dim Tm1 As Byte                                             'переменная подсчёта чего нибудь
Dim Tm2 As Byte                                             'переменная подсчёта чего нибудь
Dim Powerup As Integer                                      'переменная для питания
Dim Vr As Single                                            'временная переменная для рассчёта АЦП
Dim Vr1 As Integer                                          'временная переменная для рассчёта АЦП
Dim Vr2 As Byte
Dim Vr3 As Long
Dim Ok As Byte
Dim Vout As Integer                                         'переменная для АЦП
Dim Tim1 As Byte                                            'переменная для ШИМа
Dim P As Byte
Dim Rx As Byte
Dim Dlinafile As Long
Dim L As Byte
Dim Stroka As Integer
Dim O As Byte
Dim A As Byte                                               'для подсчёта чётности
Dim Slovo As Byte
Dim Procent As Long                                         'начало в файле
Dim Dlinak As Long                                          'конец в файле
Dim Dlinan As Long                                          'конец в файле
Dim Programm As Long                                        'кол-во найденых программ в файле
Dim Bat As String * 12
Dim Tx As String * 20
Dim Rx1 As String * 3
Dim File As String * 16
Dim Delitel1 As Single
Dim Delitel2 As Single
Dim Vbatin As Single
Dim Vbatout As Single
Dim Vbatok As Single


Dim Rm1 As Eram Single
Dim Rm2 As Eram Single
Dim Rm4 As Eram Single
Dim Rm5 As Eram Single
Dim Rm6 As Eram Single




Vr = Rm1
If Vr <= 0 Then Rm1 = Cn1
Vr = Rm2
If Vr <= 0 Then Rm2 = Cn2
Vr = Rm4
If Vr <= 0 Then Rm4 = Cn3
Vr = Rm5
If Vr <= 0 Then Rm5 = Cn4
Vr = Rm6
If Vr <= 0 Then Rm6 = Cn5


Delitel1 = Rm1
Delitel2 = Rm2
Vbatin = Rm4
Vbatout = Rm5
Vbatok = Rm6



Zarad Alias Pine.7
Config Porte.7 = Input



'----- Порты Uart
Dsr1 Alias Pind.1                                           'вход
Rts1 Alias Portd.6                                          'выход
Cts1 Alias Pind.4                                           'вход                                     'вход
Dtr1 Alias Portd.5                                          'выход
Config Portd.1 = Input
Config Portd.4 = Input
Config Rts1 = Output
Config Dtr1 = Output
Rts1 = 0
Dtr1 = 0

'Echo Off
'Enable Interrupts

 '-------------------------------------------------------------------------------
Kn1 Alias Pinc.7
Kn2 Alias Pinc.6
Kn3 Alias Pinc.5
Kn4 Alias Pinc.4
Config Portc . 7 = Input
Config Portc . 6 = Input
Config Portc . 5 = Input
Config Portc . 4 = Input


'--------------------   настройки таймера и ацп ----------------------------------
 Config Adc = Single , Prescaler = Auto , Reference = Internal
 Start Adc

Config Timer1 = Pwm , Pwm = 8 , Compare A Pwm = Clear Down , Prescale = 1
Config Portb.5 = Output
'Config Portf.3 = Input
'Config Porta.7 = Input
Pwm1a = 135
Waitms 300
'-------------------- LCD конфигурация
Svetlcd Alias Portg.2
Config Svetlcd = Output
Svetlcd = 0
Config Lcdpin = Pin , Rs = Porta.0 , E = Porta.1 , Db4 = Porta.2 , Db5 = Porta.4 , Db6 = Porta.5 , Db7 = Porta.6
Config Lcd = 20 * 4
Waitms 100
Initlcd                                                     ' Обязательно инициализируем LCD
Waitms 100
Deflcdchar 0 , 31 , 17 , 17 , 17 , 17 , 17 , 17 , 17        ' 0-П
Deflcdchar 1 , 31 , 16 , 16 , 16 , 16 , 16 , 16 , 16        ' 1-Г
Deflcdchar 2 , 21 , 21 , 21 , 14 , 14 , 21 , 21 , 21        ' 2-Ж
Deflcdchar 3 , 17 , 17 , 19 , 21 , 25 , 17 , 17 , 32        ' 3-И
Deflcdchar 4 , 6 , 10 , 10 , 10 , 10 , 10 , 31 , 17         ' 4-Д
Deflcdchar 5 , 3 , 5 , 9 , 9 , 17 , 17 , 17 , 17            ' 5-Л
Deflcdchar 6 , 16 , 16 , 16 , 30 , 17 , 17 , 17 , 30        ' 6-Ь
Deflcdchar 7 , 15 , 17 , 17 , 17 , 15 , 5 , 9 , 17          ' 7-Я
Cursor Off                                                  ' Выключаем курсор
 Cls



'================================================ UART ===========================
Config Com2 = 300 , Synchrone = 0 , Parity = Even , Stopbits = 1 , Databits = 7 , Clockpol = 0

Config Serialin1 = Buffered , Size = 64                     ', Bytematch = All
Open "COM2:" For Binary As #4

Enable Serial
Config Portd.3 = Output
Config Portd.2 = Input

'=================================================================================

If Delitel1 <= 0 Or Vbatout <= 0 Or Delitel2 <= 0 Or Vbatin <= 0 Or Vbatok <= 0 Then
   Cls
   Lcd "ERROR ERAM!"
   Do
   Loop
End If
'Cls
'Locate 1 , 1 : Lcd Delitel1
'Locate 2 , 1 : Lcd Delitel2
'Locate 3 , 1 : Lcd Vbatin
'Locate 4 , 1 : Lcd Vbatok
'Do
'Loop


Goto Prog:
'=================================================================   ПОДПРОГРАММЫ ==================================================================
Tire:
For P = 1 To 20
Locate 1 , P : Lcd "-"
Locate 2 , P : Lcd "-"
Locate 3 , P : Lcd "-"
Locate 4 , P : Lcd "-"
Next P
Return




'Slova:                                                      '------------------------------------------------------  СЛОВА КИРИЛИЦЕЙ НА китАйском LCD
'If Slovo = 1 Then Lcd "3AMEH" ; Chr(3) ; "T" ; Chr(6);      'ЗАМЕНИТЬ
'If Slovo = 2 Then Lcd "BOCCTAHOB" ; Chr(5) ; "EH" ; Chr(3) ; "E";       'ВОССТАНОВЛЕНИЕ
'If Slovo = 3 Then Lcd "PE" ; Chr(2) ; Chr(3) ; "M y" ; Chr(0);       'Режим УП
'If Slovo = 4 Then Lcd Chr(0) ; "EPE" ; Chr(4) ; "AT" ; Chr(6);       'Передать
'If Slovo = 5 Then Lcd "y" ; Chr(0) ; " " ; Chr(3) ; Chr(2) ; "E ECT" ; Chr(6);       'УП УЖЕ ЕСТЬ
'If Slovo = 6 Then Lcd "y" ; Chr(4) ; "A" ; Chr(5) ; Chr(3) ; "T" ; Chr(6);       'УДАЛИТЬ
'If Slovo = 7 Then Lcd Chr(0) ; "P" ; Chr(3) ; "H" ; Chr(7) ; "T" ; Chr(6);       'Принять
'If Slovo = 8 Then Lcd "OT" ; Chr(0) ; "PAB" ; Chr(3) ; "T" ; Chr(6);       'ОТПРАВИТЬ
'If Slovo = 9 Then Lcd Chr(4) ; "AT" ; Chr(6) ; " " ; Chr(4) ; "P" ; Chr(3) ; Chr(1) ; "OE " ; Chr(3) ; "M" ; Chr(7);       'ДАТЬ ДРУГОЕ ИМЯ

'If Slovo = 11 Then Lcd Chr(4) ; Chr(5) ; Chr(7) ; " " ; Chr(0) ; "PO" ; Chr(4) ; "O" ; Chr(5) ; Chr(2) ; "EH" ; Chr(3) ; Chr(7);       ' ДЛЯ ПРОДОЛЖЕНИЯ
'Return


Getchar:
Rts1 = 1
Return

Kn0:
If Kn > 0 And Kn < 10 Then Kn = 0

If Kn1 = 0 And Kn = 0 Then
   Kn = 10
   Waitms 10
End If
If Kn2 = 0 And Kn = 0 Then
   Kn = 20
   Waitms 10
End If
If Kn3 = 0 And Kn = 0 Then
   Kn = 30
   Waitms 10
End If
If Kn4 = 0 And Kn = 0 Then
   Kn = 40
   Waitms 10
End If


  Gosub Zaradka:


If Kn1 = 1 And Kn = 10 Then Kn = 1
If Kn2 = 1 And Kn = 20 Then Kn = 2
If Kn3 = 1 And Kn = 30 Then Kn = 3
If Kn4 = 1 And Kn = 40 Then Kn = 4

Return
Zaradka:
   'Disable Interrupts
 Start Adc
 If Zarad = 1 Then
   Cls

   Pwm1a = 255
   Disable Interrupts
   Do
   Waitms 10

   Vout = Getadc(3)


   Vr = Vout * Delitel1
   Locate 2 , 1 : Lcd "BAT:" ; Vr ; "v " ; "    "
   Locate 1 , 1
   If Vr >= Vbatok Then
      Lcd "yCTPO" ; Chr(3) ; "CTBO 3AP" ; Chr(7) ; Chr(2) ; "EHO!"
      Else
      Lcd "3AP" ; Chr(7) ; Chr(4) ; "KA yCTPO" ; Chr(3) ; "CTBA!"
   End If
   Waitms 10

   'Vout = Getadc(7)

   'Vr = Vout * Delitel2

   'Locate 3 , 1 : Lcd Vr ; "v" ; "   "

   Loop Until Zarad = 0
   Pwm1a = 135
   Wait 1
   Goto Prog
 End If


   Vout = Getadc(3)
   Vr = Vout * Delitel1
   If Vr < Vbatin And Servic = 0 Then
      Incr Tr5
      Else
      Tr5 = 0
   End If
   If Tr5 = 100 Then
      Cls
      Locate 1 , 1
      Lcd "yCTPO" ; Chr(3) ; "CTBO PA3P" ; Chr(7) ; Chr(2) ; "EHO!!"
      Locate 2 , 1 : Lcd "BAT: " ; Vr ; "v" ; "       "
      Locate 3 , 1 : Lcd Chr(0) ; "OCTAB" ; Chr(6) ; "TE HA 3AP" ; Chr(7) ; Chr(4) ; "Ky"
      Do
         Waitms 500
         Svetlcd = Not Svetlcd
      Loop Until Zarad = 1
      Goto Prog
   End If
   Waitms 10
   Vout = Getadc(7)
   Vr = Vout * Delitel2
   If Vr < Vbatout And Servic = 0 Then
         Incr Tr6
      Else
      Tr6 = 0
   End If
   If Tr6 = 100 Then
      Cls
      Locate 1 , 1
      Lcd "MA" ; Chr(5) ; "O HA" ; Chr(0) ; "P" ; Chr(2) ; ". B UART"
      Locate 2 , 1 : Lcd "HA" ; Chr(0) ; "P" ; Chr(7) ; Chr(2) ; "EH" ; Chr(3) ; "E"
      Locate 2 , 1 : Lcd "UART: " ; Vr ; "v" ; "       "
      Locate 4 , 1 : Lcd Chr(0) ; "OCTAB" ; Chr(6) ; "TE HA 3AP" ; Chr(7) ; Chr(4) ; "Ky"
      Do
         Waitms 500
         Svetlcd = Not Svetlcd
      Loop Until Zarad = 1
      Goto Prog
   End If
'Enable Interrupts
Return

Sbrkn:
Do
   Kn = 0
   Gosub Kn0
Loop Until Kn = 0
Return

'================================================================================================================================================
'===================================================================================== НАЧАЛО ПРОГРАММЫ =========================================
'================================================================================================================================================


Prog:


Servic = 1
Gosub Zaradka:

Cls
Locate 1 , 1 : Lcd "-=" ; Chr(4) ; "OKTOP SCHAUBLIN=-"
Locate 2 , 5 : Lcd "BEPC" ; Chr(3) ; Chr(7) ; ":1.0       2016"
Locate 4 , 1 : Lcd "3ABO" ; Chr(4) ; " A" ; Chr(1) ; "AT " ; Chr(1) ; ".KCTOBO"
For P = 1 To 30
Svetlcd = Not Svetlcd
Waitms 30
Next P
For P = 1 To 20
Locate 3 , P : Lcd Chr(255)
If Kn1 = 1 And Kn2 = 0 And Kn3 = 1 And Kn4 = 0 Then Goto Servmenu:
Waitms 100
Next P
Wait 1
Servic = 0
Prog1:
Cls
Spiflesh:



$include "Config_MMC.bas"
$include "Config_AVR-DOS.BAS"

Locate 1 , 1 : Lcd "AVR DOS:>RUN"
If Svetlcd = 1 Then Waitms 100 Else Wait 1
'==================== Проверка флешки
B = Initfilesystem(1)                                       'инициализация флэшки
If B <> 0 Then                                              'если инициализация не прошла
 Locate 2 , 1 : Lcd "HET HAKO" ; Chr(0) ; Chr(3) ; "TE" ; Chr(5) ; Chr(7) ; "!!!"
 Locate 1 , 14 : Lcd "ERROR"
 'Waitms 100
Svetlcd = Not Svetlcd
 Goto Spiflesh:

End If
Locate 2 , 1 : Lcd "HAKO" ; Chr(0) ; Chr(3) ; "TE" ; Chr(5) ; Chr(6) ; " HA" ; Chr(3) ; Chr(4) ; "EH!"
Svetlcd = 0
 Locate 1 , 14 : Lcd "OK   "


'------------------------------------------- Проверка питания ----------------

Disable Interrupts
    Locate 3 , 1
    Lcd Chr(0) ; "POBEPKA " ; Chr(0) ; Chr(3) ; "TAH" ; Chr(3) ; Chr(7) ; ":"
Start Adc
Batlover:

   Vout = Getadc(3)
   Vr = Vout * Delitel1
'   Vr1 = Int(vr)

   If Vr < Vbatin Then
      Locate 3 , 1 : Lcd "BAT: " ; Delitel1 ; "v   "
      Locate 4 , 1 : Lcd "3AP" ; Chr(7) ; Chr(4) ; Chr(3) ; "TE yCTPO" ; Chr(3) ; "CTBO!"
      Svetlcd = Not Svetlcd
      If Svetlcd = 1 Then Waitms 100 Else Wait 1
      Goto Batlover:
   End If
   Waitms 10

   Vout = Getadc(7)
   Vr = Vout * Delitel2
   Vr1 = Int(vr)
   Locate 3 , 18 : Lcd Vr1 ; "v"
  If Vr < Vbatout Then
      Locate 4 , 3 : Lcd "MA" ; Chr(5) ; "O HA" ; Chr(0) ; "P" ; Chr(7) ; Chr(2) ; "EH" ; Chr(3) ; Chr(7)
      Svetlcd = Not Svetlcd
      If Svetlcd = 1 Then Waitms 100 Else Wait 1
      Goto Batlover:
   End If
Locate 3 , 18 : Lcd "OK "


Menu1:
Rts1 = 1
Dtr1 = 1
Disable Urxc1
Disable Interrupts

Vibor = 0:
Chdir "\"
Kn = 0
File = ""
Gosub Tire:
Locate 1 , 1 : Lcd "PEMOHT SCHAUBLIN 102"
Locate 2 , 1 : Lcd "PEMOHT SCHAUBLIN 128"
Locate 3 , 1 : Lcd "OT" ; Chr(0) ; "PABKA " ; Chr(0) ; "PO" ; Chr(1) ; "PAMM>>>"
Locate 4 , 1 : Lcd Chr(0) ; "P" ; Chr(3) ; "EM " ; Chr(0) ; "PO" ; Chr(1) ; "PAMM<<<"
Gosub Sbrkn
Do
Gosub Kn0
If Kn = 1 Then
   Schau = 0
   Goto Menu2
End If
If Kn = 2 Then
   Schau = 1
   Goto Menu2
End If
If Kn = 3 Then
   Schau = 2
   Goto Menu2
End If
If Kn = 4 Then
   Goto Priem:
End If
Loop

Menu2:

Kn = 0
Gosub Tire:

If Schau = 0 Then
   Chdir "BIN"
   File = "SCH-102.bin"
End If

If Schau = 1 Then
   Chdir "BIN"
   File = "SCH-128.bin"
End If

If Schau = 2 Then
   File = "PROGRAMM.txt"
'   File = "TEMP.TXT"
End If

Locate 1 , 1 : Lcd Space(20)
Locate 1 , 1 : Lcd "CMOTPET" ; Chr(6) ; ":" ; Left(file , 11)
Locate 2 , 1 : Lcd "OT" ; Chr(0) ; "PAB" ; Chr(3) ; "T" ; Chr(6) ; " BCE"
Locate 3 , 1 : Lcd "HA" ; Chr(3) ; "T" ; Chr(3) ; " Hy" ; Chr(2) ; "HOE"
Locate 4 , 1 : Lcd "<-HA3A" ; Chr(4)
Gosub Sbrkn

Do
   Gosub Kn0
   If Kn > 0 And Kn < 10 Then
      If Kn = 1 Then Goto Prosmotr
      If Kn = 2 Then
         Dlinan = 0
         Goto Otpravka:
      End If
      If Kn = 3 Then Goto Menu3
      If Kn = 4 Then Goto Menu1
   End If
Loop

Menu3:
If Schau = 2 Then Vibor = 1 Else Vibor = 0

Kn = 0
Gosub Tire:
Open File For Binary As #1
Locate 1 , 1 : Lcd Space(20)
Locate 1 , 1 : Lcd Chr(0) ; "PO" ; Chr(1) ; ":"
Locate 2 , 1 : Lcd "OT" ; Chr(0) ; "PAB" ; Chr(3) ; "T" ; Chr(6) ; ">>>"
Locate 3 , 1 : Lcd Chr(0) ; "O" ; Chr(3) ; "CK " ; Chr(4) ; "A" ; Chr(5) ; "EE >>>"
Locate 4 , 1 : Lcd "<-HA3A" ; Chr(4)
Dlinafile = 0
Dlinan = 0
Dlinak = 0

Tx = ""
Rx = 0
Rx1 = ""
Gosub Sbrkn
Tm1 = 0
Tm2 = 0
Do
If Eof(1) <> 0 Then
   Close #1
   Open File For Binary As #1
   Dlinafile = 0
   Dlinan = 0
   Tx = ""
   Rx = 0
End If

Incr Tm1
If Tm1 = 255 Then Incr Tm2
   If Rx < 2 Then
      Get #1 , B
      B.7 = 0
      If B > 96 And B < 123 Then B = B - 32
      If B = 37 Then Rx = 1
      If Rx = 1 Then
         L = Len(tx)
         If L < 7 And B > 32 Then Tx = Tx + Chr(b)
      End If

      If B = 10 And Rx < 2 Then
         If Rx = 1 Then
            Rx = 2
            Locate 1 , 6 : Lcd Space(14)
            Locate 1 , 6 : Lcd Tx ; " CT:" ; Dlinafile
         End If
         Dlinafile = Dlinafile + 1
      End If
   End If

If Rx = 2 Or Tm2 = 255 Then Gosub Kn0
If Kn > 0 And Kn < 10 Then

   If Kn = 2 Then
      Dlinan = Dlinafile - 1
      Close #1
      Goto Otpravka
   End If

   If Kn = 3 And Rx = 2 Then
      Rx = 0
      Tx = ""
      Waitms 500
      Gosub Sbrkn
   End If

   If Kn = 4 Then
      Close #1
      Goto Menu1
   End If
End If
Loop
Close #1

Disable Interrupts








'================================================================= ПРИЁМ


Priem:

Cls
Locate 1 , 1
Lcd Chr(0) ; "P" ; Chr(3) ; "EM:"


Locate 2 , 1
If Dsr1 = 1 And Ok = 0 Then
   Lcd "HE B" ; Chr(3) ; Chr(2) ; "y CTAHKA!"
End If
Gosub Sbrkn
Do
   Gosub Kn0
   If Kn > 0 Then Goto Prog1:
   If Kn > 0 Then Exit Do
   If Dsr1 = 0 Then Exit Do
Loop
Locate 2 , 1
Lcd "HA" ; Chr(2) ; "M" ; Chr(3) ; "TE CTAPT"               ' НАЖМИТЕ СТАРТ

Rts1 = 0
Dtr1 = 0


'=============================== Приём


'Open File For Input As #2

File = "TEMP.bin"
Kill File
Open File For Output As #1
Close #1
L = 0
Dlinafile = 0
Dlinak = 0
Prob = 0
Stroka = 0
Ok = 0
P = 0
O = 0
Tx = ""
Rx1 = ""
Tm1 = 0
Tm2 = 0
Dlinak = 0
Open File For Binary As #1

File = "PROGRAMM.txt"
Open File For Binary As #2

Clear Serialin1
Enable Serial
Enable Urxc1
Enable Interrupts
Dtr1 = 0
Rts1 = 0
Vr2 = 0
B = 0
Do
Incr Tm1

If Tm1 = 255 Then
   Incr Tm2
   Gosub Kn0
End If
   If Kn = 4 Then
      Close #2
      Goto Prog1:
   End If

If Ischarwaiting(#4) = 1 Then
   Tm1 = 0
   Tm2 = 0
   Do
   Rts1 = 1
   If Ischarwaiting(#4) = 0 Then Exit Do
      B = Inkey(#4)
      B.7 = 0
      If B > 0 Then

         If B > 96 And B < 123 Then B = B - 32

         If Ok = 1 And B > 47 And O < 10 And B < 127 Then
            O = O + 1
            Tx = Tx + Chr(b)
         End If

         If B = 37 And Ok = 0 Then Ok = 1

         If Ok > 1 Then


            If B = 77 And Ok = 2 Then
               Ok = 3
               Vr2 = 0
               Rx1 = ""
            End If

            If B > 47 And B < 58 And Ok = 3 Then
               Rx1 = Rx1 + Chr(b)
               Vr2 = Vr2 + 1
            End If

            If Vr2 = 2 Or Ok = 4 Then
                  Vr2 = Val(rx1)
                  If Vr2 = 2 Or Vr2 = 17 Or Vr2 = 30 Then
                     Ok = 0
                     Else
                     Ok = 2
                  End If
                  Rx1 = ""
                  Vr2 = 0
            End If
         End If

         If B = 10 And Stroka = 0 Then

            If Ok = 1 Then
               O = 0
               P = P + 1
               Ok = 2
               Locate 1 , 7 : Lcd Tx
               Tx = ""
            End If

            If Ok > 1 Then
               Ok = 4
            End If

            L = 0
            Stroka = 1
            B = 10
            Put #1 , B
            Dlinak = Dlinak + 1
            Locate 3 , 1 : Lcd Space(20)
            Locate 2 , 1 : Lcd Chr(0) ; "PO" ; Chr(1) ; ":" ; P ; " CTP:" ; Dlinak ; " "
            Else
            If B <> 13 Then Stroka = 0
         End If

          If B = 32 And Prob = 0 Then
            Prob = 1
         End If

        If B > 32 Or Prob = 1 Then
               Prob = 0
               Put #1 , B
               L = L + 1
               If L < 21 Then
                  Locate 3 , L : Lcd Chr(b)
               End If
        End If
      End If
   Loop
   Else
End If

If Ischarwaiting(#4) = 0 Then Rts1 = 0

If Dlinak > 1 And Tm2 = 255 Then
   If Ok > 0 Then
      Cls
      Locate 1 , 1
      Lcd "ERROR! " ; Chr(0) ; "P" ; Chr(3) ; "EM ";
      Locate 2 , 1
      Lcd Chr(0) ; "PO" ; Chr(1) ; "PAMM OCTAHOB" ; Chr(5) ; "EH"
      Locate 3 , 1
      Lcd "HET M2 M17 M30"
      Kill "TEMP.BIN"
      Close #2
      Close #1
      Goto Konec
   End If
   Exit Do
End If

Loop
Rts1 = 1
Disable Interrupts


L = 0
Do
B = 0
Get #2 , B
B.7 = 0
If B = 10 Then L = 0
If B > 31 And L < 20 Then
   L = L + 1
   Locate 3 , L : Lcd Chr(b)
End If
Put #1 , B
'Waitms 1
Loop Until Eof(2) <> 0
Close #2
Close #1

Ok = 0
Rx1 = ""
Rx = 0
Tx = ""
P = 0
Prob = 0
O = 0
Stroka = 0
File = "TEMP.bin"
Open File For Binary As #1

Do
   Get #1 , B
   B.7 = 0

   If B = 37 And Ok = 0 Then Ok = 1

   If L < 10 And Ok = 1 Then
      If B > 47 And B < 58 Then Rx1 = Rx1 + Chr(b)
      L = Len(rx1)
   End If

   If B = 10 Then Stroka = Stroka + 1

   If B = 10 And Ok = 1 Then
      Ok = 0
      File = "PROGRAMM.txt"
      Open File For Binary As #2
      O = 0
      Tx = ""
      Do
         Get #2 , B
         B.7 = 0
         If B = 37 And O = 0 Then O = 1
         If L < 10 And O = 1 Then
            If B > 47 And B < 58 Then Tx = Tx + Chr(b)
            L = Len(tx)
         End If
         If B = 10 And O = 1 Then
            O = 0
            Vr2 = Val(rx1)
            Prob = Val(tx)
            If Vr2 = Prob Then P = P + 1
            Tx = ""
         End If
      Loop Until Eof(2) <> 0
      Close #2
      Rx1 = ""
   End If

   If Stroka = Dlinak Then Exit Do

Loop Until Eof(1) <> 0

Close #1
If P = 0 Then Goto Sostav:

Cls
Locate 1 , 1 : Lcd "COB" ; Chr(0) ; "A" ; Chr(4) ; "EH" ; Chr(3) ; Chr(3) ; " HA" ; Chr(3) ; Chr(4) ; "EHO:" ; P
Locate 2 , 12 : Lcd "3AMEH" ; Chr(3) ; "T" ; Chr(6) ; ">"
Locate 3 , 11 : Lcd Chr(4) ; "O" ; Chr(0) ; "O" ; Chr(5) ; "H" ; Chr(3) ; "T" ; Chr(6) ; ">"
Locate 4 , 14 : Lcd "OTMEHA>"

Gosub Sbrkn
Do
   Gosub Kn0
   If Kn = 2 Then
      Exit Do
   End If
   If Kn = 3 Then
      Programm = 0
      Goto Zamena:
   End If
   If Kn = 4 Then
      Goto Prog:
   End If
Loop
Cls
Locate 1 , 1 : Lcd Chr(0) ; "POBO" ; Chr(2) ; "y 3AMEHy"
Procent = Dlinak
Do
   Dlinan = 0
   Dlinak = 0
   File = "TEMP.bin"
   Open File For Binary As #1
   Dlinafile = 0
   Stroka = 0
   Ok = 0
   Rx1 = ""
   Vr3 = 0
   Do
      Get #1 , B
      B.7 = 0

      Dlinafile = Dlinafile + 1

      If B = 37 And Ok = 0 Then
         'Dlinan = Dlinafile
         Ok = 1
         Rx1 = ""
      End If

      If Ok = 1 Or Ok = 3 Then
         L = Len(rx1)
         If B > 47 And B < 58 And L < 6 Then Rx1 = Rx1 + Chr(b)
      End If

      If B = 10 Then
         Stroka = Stroka + 1
         If Ok = 1 Then
            Ok = 2
            Vr3 = Val(rx1)
            Rx1 = ""
         End If

         If Ok = 3 Then
            P = Val(rx1)
            If P = 2 Or P = 17 Or P = 30 Then
                  Ok = 4
                  Rx1 = ""
                  'Dlinak = Dlinafile
                  Else
                  Ok = 2
                  Rx1 = ""
            End If
         End If
      End If


      If B > 64 And Ok = 3 Then
         P = Val(rx1)
         If P = 2 Or P = 17 Or P = 30 Then
              Ok = 4
              Rx1 = ""
              Else
              Ok = 2
              Rx1 = ""
         End If
      End If


      If B = 77 And Ok = 2 Then
         Rx1 = ""
         L = 0
         Ok = 3
      End If

      If B = 37 And Ok = 4 And Stroka => Procent Then
         Dlinan = Dlinafile - 1
         Ok = 5
         Rx1 = ""
      End If

      If Ok = 5 Or Ok = 7 Then
         L = Len(rx1)
         If L < 6 And B > 47 And B < 58 Then Rx1 = Rx1 + Chr(b)
      End If

      If B = 10 And Ok = 5 Then
            P = Val(rx1)
            If Vr3 = P Then
               Rx1 = ""
               Ok = 6
               Else
                  Ok = 0
                  Exit Do
            End If
      End If

      If B = 10 And Ok = 7 Then
            P = Val(rx1)
            If P = 2 Or P = 17 Or P = 30 Or Ok = 8 Then
               Dlinak = Dlinafile - 1
               Ok = 8
               Else
               Ok = 6
            End If
           If Ok = 8 Then Exit Do
      End If

      If B > 64 And Ok = 7 Then
         P = Val(rx1)
         If P = 2 Or P = 17 Or P = 30 Then
               Ok = 8
               Else
               Ok = 6
         End If
      End If


      If B = 77 And Ok = 6 Then
         Rx1 = ""
         Ok = 7
         L = 0
      End If


   Loop Until Eof(1) <> 0

   Locate 2 , 1 : Lcd "CTP %:" ; Dlinan ; "   "
   Locate 3 , 1 : Lcd "CTP M2:" ; Dlinak ; "   "
   Locate 4 , 1 : Lcd "OK:" ; Ok
   Wait 1
   If Ok < 6 Then
         Ok = 10
   End If

   Close #1
      If Ok = 8 And Dlinak > Dlinan Then

         Open File For Binary As #1
         Dlinafile = 0
         Do
            If Dlinafile < Dlinan Or Dlinafile > Dlinak Then
               Get #1 , B
               Else
                  B = 0
                  Put #1 , B
            End If
            Dlinafile = Dlinafile + 1
            If Dlinafile > Dlinak Then Exit Do

         Loop Until Eof(1) <> 0
         Close #1
      End If
      If Ok = 10 Then Exit Do
Loop
Dlinak = Procent
Goto Sostav

Zamena:
Cls
Locate 1 , 1 : Lcd "3AMEHA " ; Chr(3) ; "MEH"
Dlinafile = 0
Ok = 0
Maxx = 0
Rx1 = ""
File = "TEMP.bin"
Vr3 = 0
Open File For Binary As #1
Do
   Get #1 , B
   B.7 = 0
   If B = 10 Then Dlinafile = Dlinafile + 1
   If Dlinafile => Dlinak Then
      If B = 37 And Ok = 0 Then Ok = 1
      If Ok = 1 Then
         If B > 47 And B < 58 Then
            L = Len(rx1)
            If L < 6 Then Rx1 = Rx1 + Chr(b)
         End If
         If B = 10 Then
            Vr3 = Val(rx1)
            If Maxx < Vr3 Then Maxx = Vr3
            Ok = 0
            Rx1 = ""
         End If
      End If
   End If
Loop Until Eof(1) <> 0
Close #1

Tm1 = 0
Ok = 0
Rx1 = ""
L = 0
Dlinafile = 0

Open File For Binary As #1
Dlinafile = 0
   Do
      Get #1 , B
      B.7 = 0
      If B = 37 And Ok = 0 Then
         Ok = 1
         Tm1 = 0
      End If
      If B = 77 And Ok = 1 Then Ok = 2
      If B = 80 And Ok = 2 Then
         Ok = 3
         Rx1 = ""
      End If

      If Ok > 0 Then Tm1 = Tm1 + 1
      If Ok = 3 Then
         L = Len(rx1)
         If B > 47 And B < 58 And L < 6 Then Rx1 = Rx1 + Chr(b)
      End If

      If B = 10 And Ok = 3 And Dlinafile < Dlinak Then
            Ok = 0
            Vr3 = Val(rx1)
            Rx1 = ""
            Vr2 = Maxx + Programm
            If Vr3 <= Maxx Or Vr3 > Vr2 Then
               Close #1
               Open File For Binary As #1
               Tx = ""
               Stroka = 0
               Ok = 0
               Do
                  Get #1 , B
                  B.7 = 0
                  If B = 10 Then Stroka = Stroka + 1
                  If B = 37 And Stroka = Dlinafile And Stroka < Dlinak Then
                     B = 77
                     Put #1 , B
                     B = 80
                     Put #1 , B
                     B = 70
                     Put #1 , B
                     Programm = Programm + 1
                     Locate 2 , 1 : Lcd Chr(0) ; "PO" ; Chr(1) ; "PAMMy %" ; Vr3 ; "B   "
                     Vr3 = Maxx + Programm
                     Tx = Str(vr3)
                     Locate 3 , 1 : Lcd Chr(0) ; "PO" ; Chr(1) ; "PAMMy %" ; Vr3 ; "   "
                     Wait 1
                     P = Len(tx)
                     Vr2 = P + 6
                     If Tm1 > Vr2 Then
                        Vr2 = Tm1 - Vr2
                        For O = 0 To Vr2
                        Tx = Tx + Chr(32)
                        Next O
                     End If
                     P = Len(tx)
                     For O = 1 To P
                        Rx1 = Mid(tx , O , 1)
                        B = Asc(rx1)
                        B.7 = 0
                        Put #1 , B
                     Next O
                     B = 10
                     Put #1 , B
                     Close #1
                     Goto Zamena:
                  End If
                  If Stroka = Dlinak Then Exit Do
                Loop Until Eof(1) <> 0
               Close #1

               Goto Zamena:
            End If

      End If
      If B = 10 Then
         Tm1 = 0
         Dlinafile = Dlinafile + 1
         Ok = 0
         Rx1 = ""
      End If
If Dlinafile >= Dlinak Then Exit Do
Loop Until Eof(1) <> 0
Close #1


Sostav:
Rx1 = ""
Ok = 0
L = 0
Vr3 = 0
File = "TEMP.bin"
Maxx = 0
Dlinafile = 0
Cls
Locate 1 , 1 : Lcd Chr(0) ; "POBO" ; Chr(2) ; "y 3A" ; Chr(0) ; Chr(3) ; "C" ; Chr(6) ; ":"
Open File For Binary As #2
Do
   Get #2 , B
   B.7 = 0
   If B = 37 And Ok = 0 Then Ok = 1
   If Ok = 1 Then
      If B > 47 And B < 58 Then
         L = Len(rx1)
         If L < 6 Then Rx1 = Rx1 + Chr(b)
      End If
      If B = 10 Then
         Vr3 = Val(rx1)
         If Maxx < Vr3 Then Maxx = Vr3
         Ok = 0
         Rx1 = ""
      End If
   End If
Loop Until Eof(2) <> 0
Close #2

P = 0
Vr2 = 1
Stroka = 0
Ok = 0
L = 0
Rx1 = ""
File = "PROGRAMM.txt"
Kill File
Open File For Output As #2
Close #2
Open File For Binary As #1
File = "TEMP.bin"
Do
   Open File For Binary As #2
   Vr2 = 1
   Rx = ""
   Ok = 0
   L = 0
   Stroka = 0
   A = 0
   Do
      Get #2 , B
      B.7 = 0
      If B = 37 And Ok = 0 Then Ok = 1
      If Ok = 1 Then
         If B > 47 And B < 58 And L < 6 Then Rx1 = Rx1 + Chr(b)
         L = Len(rx1)
      End If

      If B = 10 And Ok = 1 Then
         Ok = 0
         O = Val(rx1)
         If O = P Then
            If Vr > 0 Then Stroka = Vr2 - 1
            A = 1
            Exit Do
         End If
      End If

      If B = 10 Then
         Vr2 = Vr2 + 1
         Tx = ""
         Rx1 = ""
         Ok = 0
      End If
   Loop Until Eof(2) <> 0
   Close #2

  If A = 1 Then
    Open File For Binary As #2
    Vr2 = 0
    Ok = 0
    Rx1 = ""
    Tm1 = 0
    Tm2 = 2
    Do
       Get #2 , B
       B.7 = 0
       If B = 10 Then Vr2 = Vr2 + 1

       If Vr2 >= Stroka Then

          If B > 31 Then
             Put #1 , B
             Tm1 = Tm1 + 1
             Locate Tm2 , Tm1
             If Tm1 < 20 Then Lcd Chr(b)
          End If

          If B > 64 And Ok = 1 Then
            Ok = 0
            Else
            If B > 47 And B < 58 And Ok = 1 Then Ok = 2
          End If

          If B = 77 And Ok = 0 Then
             Ok = 1
             Rx1 = ""
          End If

          If Ok = 2 Then
             L = Len(rx1)
             If B > 47 And B < 58 And L < 3 Then
                Rx1 = Rx1 + Chr(b)
             End If
          End If

          If B = 10 Then
             Put #1 , B
             Tm2 = Tm2 + 1
             Tm1 = 0

             If Tm2 = 4 Then
                Tm2 = 2
                Locate 2 , 1 : Lcd Space(20)
                Locate 3 , 1 : Lcd Space(20)
                Locate 4 , 1 : Lcd Space(20)
             End If

             O = Val(rx1)
             Rx1 = ""
             Ok = 0

             If O = 2 Or O = 17 Or O = 30 Then
                B = 10
                Put #1 , B
                B = 10
                Put #1 , B
                B = 10
                Put #1 , B
                B = 10
                Put #1 , B
                B = 10
                Put #1 , B
                Exit Do
             End If
       End If
     End If
    Loop Until Eof(2) <> 0
    Close #2
   End If
  If P = Maxx Then Exit Do
  P = P + 1
Loop
Close #1


Cls
Locate 1 , 1 : Lcd Chr(1) ; "OTOBO!!!"
Locate 4 , 4 : Lcd Chr(1) ; "HA" ; Chr(2) ; "M" ; Chr(3) ; "TE KHO" ; Chr(0) ; "y >"
File = "TEMP.bin"
Kill File
Goto Konec



























'========================================================= ОТПРАВКА


Otpravka:

Cls
Locate 1 , 1 : Lcd Chr(0) ; "POBEPKA FILE"
Dlinafile = 0
Ok = 0
Rx = 0
Rx1 = ""
Tx = ""
P = 0
L = 0
Dlinafile = 0
Open File For Binary As #1

If Dlinan > 0 Then
   Do
      Get #1 , B
      B.7 = 0
      If B = 10 Then Dlinafile = Dlinafile + 1
   Loop Until Dlinafile = Dlinan
End If
Vr = 0

Do

  Get #1 , B
  B.7 = 0
  If B > 96 And B < 123 Then B = B - 32

  If B = 10 Then
     Dlinafile = Dlinafile + 1
     If Ok = 1 Then Ok = 2
     If Rx = 1 Then Rx = 2
  End If

  If Ok = 1 And L < 11 Then
      If B > 32 Then
         Tx = Tx + Chr(b)
         L = Len(tx)
      End If
   End If



  If Ok = 3 And Rx < 3 And B > 31 Then
       Rx1 = Rx1 + Chr(b)
       Rx = Rx + 1
  End If

  If B = 37 And Ok = 2 Then Ok = 10

  If B = 77 Then
      If Ok = 2 Then
         Ok = 3
         Else
            If Ok = 3 Then
               Rx = 2
            End If
      End If

  End If

  If B = 37 And Ok = 0 Then
   Ok = 1
   Rx1 = ""
   Tx = ""
   Rx = 0
  End If


If Rx = 2 And Ok = 3 Then
       Vr2 = Val(rx1)
       If Vr2 = 30 Or Vr2 = 17 Or Vr2 = 2 Then
            Ok = 0
            Rx1 = ""
            Rx = 0
            P = P + 1
            Tx = ""
            If Vibor = 1 Then
               Dlinak = Dlinafile + 1
               Exit Do
            End If
            Else
                Rx1 = ""
                Rx = 0
                Ok = 2
       End If

End If

Loop Until Eof(1) <> 0

Close #1




If Vibor = 0 Then Dlinak = Dlinafile

Dlinafile = 0

Locate 2 , 1
If Ok = 0 Then
   Lcd Chr(0) ; "PO" ; Chr(1) ; "PAMM:" ; P
   Else
   Lcd "HE XBATAET M2,17,30"
End If

Locate 3 , 1
If Dsr1 = 1 And Ok = 0 Then
   Lcd "HE B" ; Chr(3) ; Chr(2) ; "y CTAHKA!"
   Else
      If Ok > 0 Then Lcd "3AKPO" ; Chr(3) ; "TE:" ; Tx ; ">" ; Rx1 ; ">" ; Dlinafile
End If

Locate 4 , 1
If Ok > 0 Then
   Lcd "BAXO" ; Chr(4) ; "------------->"
   Else
   Lcd "O" ; Chr(2) ; Chr(3) ; Chr(4) ; "AH" ; Chr(3) ; "E " ; Chr(0) ; "O" ; Chr(4) ; "K" ; Chr(5) ; "."
End If

Gosub Sbrkn
Do
   Gosub Kn0
   If Kn > 0 And Ok > 0 Then Goto Prog1:
   If Kn > 0 And Ok = 0 Then Exit Do
   If Dsr1 = 0 And Ok = 0 Then Exit Do
Loop
Wait 2


Ok = 0
Rx = 0
Rx1 = ""
Tx = ""
P = 0
Stroka = 0
Tr1 = 0
O = 0


Cls

Gosub Sbrkn
Rts1 = 0
Dtr1 = 0

Open File For Binary As #1

Locate 2 , 1 : Lcd Chr(0) ; "EPE" ; Chr(4) ; "AHO:0%"
If Dlinan > 0 Then
   Do
      Get #1 , B
      B.7 = 0
      If B = 10 Then Dlinafile = Dlinafile + 1
   Loop Until Dlinafile = Dlinan
End If

Do
   Tm1 = Tm1 + 1
   Gosub Kn0
   If Kn = 4 Then
      Close #1
      Goto Prog1:
   End If


   If Tm1 = 255 Then Tm2 = Tm2 + 1



   If Cts1 = 0 Then
      Svetlcd = 0

      If Tr1 = 1 Then
         Locate 1 , 1 : Lcd "OT" ; Chr(0) ; "PABKA >>> "
         Tr1 = 0
      End If
      Get #1 , B
         B.7 = 0
      If B > 96 And B < 123 Then B = B - 32

      If B = 37 And Ok = 1 Then
         Ok = 20
          Close #1
         Goto Error
      End If
         If B = 37 And Ok = 0 Then
            Ok = 1
            Rx = 0
            Rx1 = ""
         End If
      If Rx = 1 And B < 48 Then Rx = 2
      If B > 31 Then
            Printbin #4 , B
            If Rx = 1 And B > 57 Then Rx = 2


            Stroka = Stroka + 1
           If Ok = 1 And B = 77 Then
                Rx1 = ""
                Rx = 0
                Ok = 2
            End If

            If Ok = 2 And Rx < 2 And B > 47 And B < 58 Then
               Rx1 = Rx1 + Chr(b)
               Rx = Rx + 1
            End If

            If Stroka = 0 Then
               Locate 3 , 1
               Lcd Space(20)
            End If

            If Stroka < 21 Then
              Locate 3 , Stroka
              Lcd Chr(b)
            End If

      End If



   If B = 10 Then
      Dlinafile = Dlinafile + 1

      Procent = Dlinafile - Dlinan
      Vr = Dlinak - Dlinan
      Vr = Procent \ Vr
      Vr = Vr * 100
      Procent = Vr
      If Procent > 100 Then Procent = 100
      Locate 2 , 10 : Lcd Procent ; "%"
      Printbin #4 , 10
      Printbin #4 , 13
      Printbin #4 , 13
      Tx = ""
      Stroka = 0
      Locate 3 , 1 : Lcd Space(20)
      Rx = 0
   End If

   If Ok = 2 Or Cts1 = 1 Then
               If Rx = 2 Then
                     Vr2 = Val(rx1)
                     If Vr2 = 30 Or Vr2 = 17 Or Vr2 = 2 Then
                        Ok = 0
                        Rx = 0
                        Rx = ""
                        Else
                           Ok = 1
                           Rx = 0
                           Rx1 = ""
                     End If
               End If

    End If



End If


If Cts1 = 1 Then

   If Dlinafile = Dlinak Then Exit Do
   Vr1 = Dlinak - 1
   If Dlinafile = Vr1 And Vibor = 1 Then Exit Do
'   If Ok = 2 Then Ok = 0
   If Tr1 = 0 Then
      If Dlinafile > 0 Then
         Locate 3 , 1
         Lcd "M" ; Vr2 ; "          "
'         If Vr2 = 2 Or Vr2 = 17 Or Vr2 = 30 Then Ok = 0
      End If

      Tm1 = 0
      Tm2 = 0
      Tr1 = 1
      Locate 1 , 1 : Lcd "HA" ; Chr(2) ; "M" ; Chr(3) ; "TE CTAPT"       ' НАЖМИТЕ СТАРТ
   End If
   If Dlinafile > Dlinan Then
      Svetlcd = Not Svetlcd
      If Svetlcd = 1 Then Waitms 200 Else Waitms 800
   End If

   If Tr1 = 1 And Cts1 = 1 And Ok <> 0 And Tm1 = 2 Then

      Close #1
      Goto Error:
   End If
End If
Loop Until Eof(1) <> 0

Close #1
Print #4 , "M02" ; Chr(10) ; Chr(13) ; Chr(13);
Locate 1 , 1
Lcd "!!!!" ; Chr(1) ; "OTOBO!"
Locate 2 , 10 : Lcd "100% OK"

Goto Konec
Error:
Cls
For P = 1 To 10
   Waitms 50
   Svetlcd = 1
   Waitms 50
   Svetlcd = 0
Next P

Locate 1 , 1 : Lcd "ERROR!"
If Ok = 1 Then
   Locate 2 , 1 : Lcd "CTAHOK HE " ; Chr(0) ; "P" ; Chr(3) ; "H" ; Chr(7) ; Chr(5)
   Locate 3 , 1 : Lcd Chr(0) ; "PO" ; Chr(1) ; "AMMy " ; Chr(4) ; "O M2,17,30"
End If

If Ok = 20 Then
   Locate 2 , 1 : Lcd "CTAHOK 3AB" ; Chr(3) ; "C! " ; Chr(3) ; Chr(5) ; Chr(3)
   Locate 3 , 1 : Lcd "OTCyTCTByET M2,17,30"
End If


Konec:
Gosub Sbrkn
Do
   Gosub Kn0
   If Kn > 0 And Kn < 10 Then Exit Do
Loop
Goto Prog1


Prosmotr:
Cls
Dlinafile = 0
Procent = 0
Tm1 = 0
Dlinak = 0
Open File For Binary As #1
Do
Get #1 , B
B.7 = 0
If B = 10 Then Dlinak = Dlinak + 1
Loop Until Eof(1) <> 0
Close #1

P = 0
O = 0
Procent = 0
Do
Open File For Binary As #1
Tm2 = 0
'Cls
Dlinafile = 0
P = 1
O = 0
Ok = 0
'Vr3 = Dlinak - 4
'If Procent < 4 Or Procent = Vr3 Then Cls
   Do

      Get #1 , B
      B.7 = 0

      If Dlinafile >= Procent Then

            If Tm1 = 0 Then
               Tm2 = 21
               Else
               If Tm2 < 21 And B > 31 Then Tm2 = Tm2 + 1
            End If

            If O < 20 And B > 31 And Tm2 = 21 Then
               O = O + 1
               If O > 0 And O < 21 Then
                  Locate P , O
                  Lcd Chr(b)
               End If
            End If

         If B = 10 Then
            If O < 20 Then
                  Vr2 = O + 1
                  Locate P , Vr2
                  Vr2 = 20 - O
                  Lcd Space(vr2)
            End If

            If P = 5 Then Exit Do
               O = 0
               Tm2 = 0
               P = P + 1
         End If

      End If

      If B = 10 Then
         Dlinafile = Dlinafile + 1

         If P => 5 Then
             'If Dlinafile = Dlinak Then
             Exit Do
             'End If
         End If
      End If

   Loop Until Eof(1) <> 0
   Close #1
'   Gosub Sbrkn
   'Locate 1 , 10 : Lcd ">" ; Procent ; " - " ; Dlinafile
   Do
      Gosub Kn0
      If Kn = 30 Then
         If Procent = 0 Then Procent = Dlinak - 5
         Procent = Procent - 1
         Exit Do
      End If
      If Kn = 10 Then
         Vr3 = Dlinak - 4
         Procent = Procent + 1
         If Procent >= Vr3 Then Procent = 0
         Exit Do
      End If
      If Kn = 2 Then
         Tm1 = Not Tm1
         Cls
         Exit Do
      End If
      If Kn = 4 Then
         Goto Menu1
      End If

   Loop
Loop



Servmenu:

Rts1 = 1
Dtr1 = 1
Disable Urxc1
Disable Interrupts
Start Adc
Vibor = 0:
Chdir "\"
Kn = 0
File = ""
Cls


'Locate 2 , 3 : Lcd "MHO" ; Chr(2) ; " UART=" ; Fusing(delitel2 , "#.####")
'Locate 3 , 3 : Lcd "MIN BAT=" ; Fusing(vbatin , "#.##")
'Locate 4 , 3 : Lcd "MIN UART=" ; Fusing(vbatout , "#.##")
Gosub Sbrkn
P = 1
Tm1 = 255
Tm2 = 0
Servic = 1
Do
Gosub Kn0
If Tm1 = 255 Then

   If P = 1 Then
      Locate 1 , 1 : Lcd "CTP:1 BX. HA" ; Chr(0) ; "P" ; Chr(7) ; Chr(2) ; "."
      Vout = Getadc(3)
      Vr = Vout * Delitel1
      Locate 2 , 1 : Lcd Vout ; "x" ; Fusing(delitel1 , "#.####") ; "=" ; Fusing(vr , "#.#") ; "v "
      Locate 3 , 1 : Lcd "MHO" ; Chr(2) ; ".=" ; Fusing(delitel1 , "#.####") ; " "
      Locate 2 , 19 : Lcd "+>"
      Locate 3 , 19 : Lcd "->"
      'Waitms 200
   End If

   If P = 2 Then
      Locate 1 , 1 : Lcd "CTP:2 UART HA" ; Chr(0) ; "P" ; Chr(7) ; Chr(2) ; "."
      Vout = Getadc(7)
      Vr = Vout * Delitel2
      Locate 2 , 1 : Lcd Vout ; "x" ; Fusing(delitel2 , "#.####") ; "=" ; Fusing(vr , "#.#") ; "v "
      Locate 3 , 1 : Lcd "MHO" ; Chr(2) ; ".=" ; Fusing(delitel2 , "#.####") ; " "
      Locate 2 , 19 : Lcd "+>"
      Locate 3 , 19 : Lcd "->"
      'Waitms 10
   End If

   If P = 3 Then
      Locate 1 , 1 : Lcd "CTP:3 M" ; Chr(3) ; "H.BX.HA" ; Chr(0) ; "P" ; Chr(7) ; Chr(2) ; "."
      Locate 2 , 1 : Lcd Chr(0) ; "OPO" ; Chr(1) ; "=" ; Fusing(vbatin , "#.##") ; "v. "
      Locate 2 , 19 : Lcd "+>"
      Locate 3 , 19 : Lcd "->"
 '     Waitms 10
   End If

   If P = 4 Then
      Locate 1 , 1 : Lcd "CTP:4 M" ; Chr(3) ; "H.UART.HA" ; Chr(0) ; "P."
      Locate 2 , 1 : Lcd Chr(0) ; "OPO" ; Chr(1) ; "=" ; Fusing(vbatout , "#.##") ; "v. "
      Locate 2 , 19 : Lcd "+>"
      Locate 3 , 19 : Lcd "->"
'      Waitms 10
   End If

   If P = 5 Then
      Locate 1 , 1 : Lcd "CTP:5 HA" ; Chr(0) ; "P. 3AP" ; Chr(7) ; "-" ; Chr(1) ; "O."
      Locate 2 , 1 : Lcd "3AP" ; Chr(7) ; Chr(2) ; "EH.=" ; Fusing(vbatok , "#.##") ; "v. "
      Locate 2 , 19 : Lcd "+>"
      Locate 3 , 19 : Lcd "->"
'      Waitms 10
   End If

End If

Incr Tm1

Waitms 1

   If Kn = 20 And Tm2 < 55 Then
      Tm2 = Tm2 + 1
      If Tm2 = 55 Then Kn = 21
   End If

   If Kn = 30 And Tm2 < 55 Then
      Tm2 = Tm2 + 1
      If Tm2 = 55 Then Kn = 31
   End If

   If Kn = 0 Then Tm2 = 0
   If Kn1 = 1 And Kn2 = 1 And Kn3 = 1 And Kn4 = 1 Then
      If Kn = 21 Or Kn = 31 Then
         Kn = 0
         Tm1 = 255
      End If
      Tm2 = 0
      Vr = Rm1
      If Vr <> Delitel1 Then Rm1 = Delitel1
      Vr = Rm2
      If Vr <> Delitel2 Then Rm2 = Delitel2
      Vr = Rm4
      If Vr <> Vbatin Then Rm4 = Vbatin
      Vr = Rm5
      If Vr <> Vbatout Then Rm5 = Vbatout
      Vr = Rm6
      If Vr <> Vbatok Then Rm6 = Vbatok



   End If


   If P = 1 Then
      If Kn = 2 Or Kn = 21 Then
         Delitel1 = Delitel1 + 0.0001
         Locate 3 , 7 : Lcd Fusing(delitel1 , "#.####") ; " "
         'Tm1 = 255
      End If


      If Kn = 3 Or Kn = 31 Then
         If Delitel1 > 0.0002 Then Delitel1 = Delitel1 - 0.0001
         Locate 3 , 7 : Lcd Fusing(delitel1 , "#.####") ; " "
         'Tm1 = 255
      End If
   End If


   If P = 2 Then
      If Kn = 2 Or Kn = 21 Then
         Delitel2 = Delitel2 + 0.0001
         Locate 3 , 7 : Lcd Fusing(delitel2 , "#.####") ; " "
      End If


      If Kn = 3 Or Kn = 31 Then
         If Delitel2 > 0.0002 Then Delitel2 = Delitel2 - 0.0001
         Locate 3 , 7 : Lcd Fusing(delitel2 , "#.####") ; " "
         'Tm1 = 255
      End If
   End If


   If P = 3 Then
      If Kn = 2 Or Kn = 21 Then
         Vbatin = Vbatin + 0.01
         Tm1 = 255
      End If


      If Kn = 3 Or Kn = 31 Then
         If Vbatin > 0.01 Then Vbatin = Vbatin - 0.01
         Tm1 = 255
      End If
   End If

   If P = 4 Then
      If Kn = 2 Or Kn = 21 Then
         Vbatout = Vbatout + 0.01
         Tm1 = 255
      End If

      If Kn = 3 Or Kn = 31 Then
         If Vbatout > 0.01 Then Vbatout = Vbatout - 0.01
         Tm1 = 255
      End If
   End If

   If P = 5 Then
      If Kn = 2 Or Kn = 21 Then
         Vbatok = Vbatok + 0.01
         Tm1 = 255
      End If

      If Kn = 3 Or Kn = 31 Then
         If Vbatok > 1 Then Vbatok = Vbatok - 0.01
         Tm1 = 255
      End If
   End If


If Kn = 2 Or Kn = 3 Then Tm1 = 255


If Kn = 1 Then
   Cls
   Tm1 = 255
   Tm2 = 0
   Kn = 0
   P = P + 1
   If P = 6 Then P = 1

End If
If Kn = 4 Then
   Cls
   Tm2 = 0
   Kn = 0
   Tm1 = 255
   P = P - 1
   If P = 0 Then P = 5
End If

Loop

End

http://cs626221.vk.me/v626221961/2ae8/q-pdaP_Jod0.jpg

Отредактировано Ev3658 (2016-04-14 18:01:38)

+1

14

Ты бы хоть сказал, что за чудо это...ворда у меня нет.

0

15

RDW написал(а):

Ты бы хоть сказал, что за чудо это...ворда у меня нет.

По ссылке можно онлайн глянуть.
https://pp.vk.me/c626817/v626817961/2c00/4p72kFcPse0.jpg

Это устройство предназначено восстанавливать параметры станка. В станке есть блок ЧПУ, в нём есть батарейки, эти батарейки когда сажаются, стирается всё.
Пол года назад восстанавливали всё с помощью перфоленты, точней пол года назад восстановить уже с перфоленты не смогли, тогда я дурак полез с компом оцифровывать рваную перфоленту и кое-как оцифровал и даже удалось с глюками восстанавливать эти станки с компа. Но глючило всё, что можно.
В итоге надоело бить бубен каждый месяц, решил создать устройство, которое настроено на стандартные настройки передачи данных этого блока после сброса.
Сделал так, чтоб пьяный электромеханик смог восстановить всё с минимум манипуляций.
Сперва сделал на Arduino Nano, первый прототип показал пригодность, но не хватало выводов на LCD и кнопки.

Требования стояли такие:
-компактность
-аккумулятор
-полноценный UART порт с ±12 вольтовым логическим выходом
-простота в использовании
-зарядка
-возможность приёма и отправки программ для операторов

Конечный прототип собирал на Atmega128, импульсный преобразователь из одного транзистора, посадил на Timer1, там частота около 32кГц.
Устройство проверяет UART напряжение, напряжение АКБ, имеет сервисное меню для настройки АЦП и пороговых значений напряжения.
Работает с AVR DOS, перед отправкой проверяет синтаксис, следит за правильностью передоваемой информацией, дополняет спец символы/пробелы, строки, чтоб не надо было в текстовом блокноте писать лишнее.
Особенно вынесла мозг возможность заменять в текстовом файле программы или дополнять их. В одном файле хранятся прогарммы, которые начинаются с % и заканчиваются М2 или М17 или М30, нужно было определить совпадение после приёма, найти, удалить, заменить, переименовть или дополнить.
Вообщем, если ещё постараться, можно по душам разговаривать с ним  :D

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

В начале темы писал про перфофлешку для ЧПУ станка ГФ, так её уже собрали двое и работает без глюков. Это уже по сложнее, тут ЛУТ сложный.

Отредактировано Ev3658 (2016-04-14 22:08:38)

+3

16

Объём большой?

0

17

RDW написал(а):

Объём большой?

Флешка 2Гб. Данных всего на 50кб., прошивка 33кб.

0

18

А макс.жатый архив раром?

0

19

Всё выложил тут - http://www.chipmaker.ru/files/file/12724/
Ну и видео обзора:

0

20

Чуток под музыку:

Отредактировано Ev3658 (2016-04-18 22:50:45)

0


Вы здесь » Программирование ATMEL в BASCOM. » Разное » Руки чешуться - ПЕРФОФЛЕШКА!!!