PureBasic - форум

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

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

Вы здесь » PureBasic - форум » OpenSource » Modbus RTU/ASCII

Modbus RTU/ASCII

Страница: 1

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

1

  • Автор: Владимир
  • Активный участник
  • Зарегистрирован: 09.06.2015
  • Приглашений: 0
  • Сообщений: 30
  • Уважение: [+0/-0]
  • Позитив: [+4/-0]
  • Провел на форуме:
    14 часов 8 минут
  • Последний визит:
    24.05.2026 14:52:08
Код:
Global Baud.l,Data_bit.l,Stop_bit.f,Parity_status.l,Dim DataRTU.a(7),StringASCII.s,Block.a,Text_In.s="",
ResponseTimeInt.a,Port.s,Ctr1.LARGE_INTEGER,Ctr2.LARGE_INTEGER,Freq.LARGE_INTEGER

Procedure LRC16()
  Protected lrc.a, i.a, Dim DataASCII.a(7)
  ;создаём массив данных для передачи:
  DataASCII(0) = Val("$" + GetGadgetText(11))   ;адрес
  DataASCII(1) = Val("$" + GetGadgetText(12))   ;команда 
  DataASCII(2) = Val("$" + GetGadgetText(13))   ;старший байт начального регистра 
  DataASCII(3) = Val("$" + GetGadgetText(14))   ;младший байт начального регистра
  DataASCII(4) = Val("$" + GetGadgetText(15))   ;старший байт количества регистров
  DataASCII(5) = Val("$" + GetGadgetText(16))   ;младший байт количества регистров  
    lrc = 0   ;подсчитываем LRC
  For i = 0 To 5     
    lrc = lrc + DataASCII(i)
  Next i
     lrc = 255 - lrc + 1
     StringASCII.s=""
  For i = 11 To 16 
    If (Len(GetGadgetText(i))=2)
      StringASCII = StringASCII + GetGadgetText(i)
    Else 
      StringASCII =  StringASCII + "0" + GetGadgetText(i)
    EndIf
  Next i  
     StringASCII = Chr(58) + StringASCII + Hex(lrc) + Chr(13) + Chr(10)
EndProcedure

Procedure CRC16()
  Protected crc.u, i.a, j.a 
  ;создаём массив данных для передачи:
  DataRTU(0) = Val("$" + GetGadgetText(11))   ;адрес
  DataRTU(1) = Val("$" + GetGadgetText(12))   ;команда 
  DataRTU(2) = Val("$" + GetGadgetText(13))   ;старший байт начального регистра
  DataRTU(3) = Val("$" + GetGadgetText(14))   ;младший байт начального регистра
  DataRTU(4) = Val("$" + GetGadgetText(15))   ;старший байт количества регистров
  DataRTU(5) = Val("$" + GetGadgetText(16))   ;младший байт количества регистров
    crc = 65535    ;подсчитываем CRC
  For i = 0 To 5
    crc = crc ! DataRTU(i)
    For j = 1 To 8
      If ((crc & 1) <> 0) 
        crc = (crc / 2)
        crc = (crc ! 40961)
      Else
        crc = (crc / 2)
      EndIf
    Next j
  Next i
  crc = crc & 65535
  DataRTU(7) = crc / 256              ;старший байт CRC
  DataRTU(6) = crc - (DataRTU(7) * 256) ;младший байт CRC
EndProcedure

Procedure Select_ComPort()      
  Port = GetGadgetText(3)
      If IsSerialPort(2)   ; Если с таким ИД уже открыт порт.      
           CloseSerialPort(2) ; то закрываем его.
           SetGadgetColor(5,#PB_Gadget_BackColor, $0000FF)
           SetGadgetText(17,"Открыть порт")
           AddGadgetItem(4, -1, "Порт закрыт.")
      Else
           OpenSerialPort(2, Port, Baud, Parity_status, Data_bit, Stop_bit, #PB_SerialPort_NoHandshake, 1, 1) 
           If IsSerialPort(2)
               SetGadgetColor(5,#PB_Gadget_BackColor, $00FF00)
               SetGadgetText(17,"Закрыть порт")
               AddGadgetItem(4, -1, "Порт открыт.")             
           Else
               MessageRequester("Ошибка","Выбранный порт недоступен!",16);Выводим сообщение об ошибке. 
           EndIf 
      EndIf           
EndProcedure      

Procedure InData() ; Прием данных.      
  Protected InBytes.a, Temp_Text.s
   If IsSerialPort(2)   ; если с таким ИД порт открыт.      
    InBytes = AvailableSerialPortInput(2) ;получаем число принятых байт     
    If InBytes>0                          ; если получены данные 
        Protected Dim InBuffer.a(InBytes); создаём массив соотв. размера
      RealInBytes = ReadSerialPortData(2, @InBuffer(), InBytes);переписываем в него
       If RealInBytes>0 
         If AddWindowTimer(0,20,100); если 0,1 сек таймер был запущен
           RemoveWindowTimer(0,20)  ; то обнуляем его
         EndIf
           AddWindowTimer(0,20,100);  запускаем 0,1 сек таймер
            If QueryPerformanceFrequency_(Freq)
              QueryPerformanceCounter_(Ctr2)    ;окончание отсчёта времени ответа
              ResponseTime.f=(Ctr2\lowpart - Ctr1\lowpart )*1000/ Freq\lowpart  ;измеренное время в миллисекундах
              ResponseTimeInt=Round(ResponseTime,#PB_Round_Up)
            EndIf
            For i=0 To (InBytes-1);составляем строку для записи в окно
             Temp_Text = Hex(InBuffer(i))
               If Len(Temp_Text) = 2
               Else 
                 Temp_Text = "0" + Temp_Text
               EndIf
             Text_In = Text_In + Temp_Text + " "
            Next i      
       EndIf 
    EndIf      
   EndIf      
EndProcedure      
  
Procedure Out_RTU()  ; Передача данных в порт
  Protected Text_Out.s="", Temp_Text.s  
     If IsSerialPort(2) ;если порт открыт          
         WriteSerialPortData(2,@DataRTU(),8) ;передаём 
           For i=0 To 7          ;составляем строку для записи в окно
             Temp_Text=Hex((DataRTU(i)))       
              If Len(Temp_Text)=2
              Else 
                Temp_Text="0" + Temp_Text
              EndIf
             Text_Out.s=Text_Out.s + Temp_Text + " "
           Next i  
         AddGadgetItem(4, -1, "Отправлен запрос:")
         AddGadgetItem(4, -1, Text_Out)    ;переписываем в окно        
     Else  
         MessageRequester("Ошибка","Текущий порт недоступен!",16);Выводим сообщение об ошибке. 
     EndIf 
EndProcedure   
   
 Procedure Out_ASCII()      ; Передача данных в порт
  Protected Text_Out.s="", Temp_Text.s  
     If IsSerialPort(2)     ;если порт открыт          
       WriteSerialPortString(2,StringASCII,1)  ;передаём
         For i=1 To 17      
           Temp_Text=Hex(Asc(Mid(StringASCII,i,1))) 
              If Len(Temp_Text) = 2
              Else 
                 Temp_Text = "0" + Temp_Text
              EndIf
                 Text_Out=Text_Out+Temp_Text+" "
         Next i 
       AddGadgetItem(4, -1, "Отправлен запрос:")
       AddGadgetItem(4, -1, Text_Out)         
     Else  
       MessageRequester("Ошибка","Текущий порт недоступен!",16);Выводим сообщение об ошибке. 
     EndIf 
EndProcedure 

 Procedure IsMouseOver(wnd) ;Определяем,находится ли курсор мышки в пределах данного окна  
   GetWindowRect_(wnd,re.RECT)  
   GetCursorPos_(pt.POINT)  
   ProcedureReturn PtInRect_(@re, pt\x|(pt\y<<32))  
 EndProcedure 

If OpenWindow(0, 0, 0, 720, 400, "Modbus Tester.  Бесплатное ПО.", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
     ButtonGadget(1, 240, 180, 80, 20, "Запрос")  
     ComboBoxGadget(2, 30, 40, 70, 20) 
         AddGadgetItem(2,-1,"RTU")
         AddGadgetItem(2,-1,"ASCII")
         SetGadgetState(2,0)
         GadgetToolTip(2,"Протокол");  
     ComboBoxGadget(3, 40, 180, 70, 20) ;Выбор СОМ порта       
           For i=1 To 99          
             AddGadgetItem(3,-1,"COM" + Str(i))          
           Next i              
        SetGadgetState(3,0); Делаем активным нулевой пункт выпадающего списка.                       
     EditorGadget(4, 350, 40, 360, 350)  ;окно сообщений 
         GadgetToolTip(4,"Используется .hex формат представления чисел")
     TextGadget(5,110, 180, 20, 20, "  ")     ;Здесь будет отображаться результат открытия порта        
     ButtonGadget(6, 90, 250, 90, 20, "Очистить окно")  ;очистить окно сообщений         
     ComboBoxGadget(7, 110, 40, 65, 20) 
         AddGadgetItem(7,-1,"1200")
         AddGadgetItem(7,-1,"1800")
         AddGadgetItem(7,-1,"2400")
         AddGadgetItem(7,-1,"4800")
         AddGadgetItem(7,-1,"7200")  
         AddGadgetItem(7,-1,"9600")
         AddGadgetItem(7,-1,"14400")
         AddGadgetItem(7,-1,"19200")
         AddGadgetItem(7,-1,"38400")
         AddGadgetItem(7,-1,"57600")
         AddGadgetItem(7,-1,"115200")
         AddGadgetItem(7,-1,"128000") 
         SetGadgetState(7,5);
         GadgetToolTip(7,"Скорость");
     ComboBoxGadget(8, 190, 40, 40, 20, #PB_String_UpperCase)
         AddGadgetItem(8,-1,"N")
         AddGadgetItem(8,-1,"E")
         AddGadgetItem(8,-1,"M")
         AddGadgetItem(8,-1,"O")
         AddGadgetItem(8,-1,"S")
         SetGadgetState(8,0);
         GadgetToolTip(8,"Чётность");
     ComboBoxGadget(9, 240, 40, 40, 20)
         AddGadgetItem(9,-1,"5")
         AddGadgetItem(9,-1,"6")
         AddGadgetItem(9,-1,"7")
         AddGadgetItem(9,-1,"8") 
         SetGadgetState(9,3);
         GadgetToolTip(9,"Количество бит данных");
     ComboBoxGadget(10, 290, 40, 40, 20) 
         AddGadgetItem(10,-1,"1")
         AddGadgetItem(10,-1,"1.5")
         AddGadgetItem(10,-1,"2")        
         SetGadgetState(10,0); 
         GadgetToolTip(10,"Количество стоповых бит")
     StringGadget(11, 90, 110, 30, 20, "00", #PB_String_UpperCase) 
         GadgetToolTip(11,"Адрес.hex")         
     StringGadget(12, 120, 110, 30, 20, "00", #PB_String_UpperCase)
         GadgetToolTip(12,"Команда.hex")
     StringGadget(13, 150, 110, 30, 20, "00", #PB_String_UpperCase)
         GadgetToolTip(13,"Старший байт начального регистра.hex")
     StringGadget(14, 180, 110, 30, 20, "00", #PB_String_UpperCase)
         GadgetToolTip(14,"Младший байт начального регистра.hex")
     StringGadget(15, 210, 110, 30, 20, "00", #PB_String_UpperCase)
         GadgetToolTip(15,"Старший байт количества регистров.hex")
     StringGadget(16, 240, 110, 30, 20, "00", #PB_String_UpperCase)    
         GadgetToolTip(16,"Младший байт количества регистров.hex")
     ButtonGadget(17, 130, 180, 90, 20, "Открыть порт") 
     TextGadget(18,270, 118, 30, 20, ".HEX  ")
     ButtonGadget(19, 200, 250, 80, 20, "Справка")
     
   If CreatePopupMenu(1)  
     MenuItem(1,"Отменить")  
     MenuItem(2,"Повторить")  
     MenuBar()  
     MenuItem(3,"Вырезать")  
     MenuItem(4,"Копировать")  
     MenuItem(5,"Вставить")  
     MenuBar()  
     MenuItem(6,"Выделить всё")  
  EndIf    
     
  Repeat 

          Baud=Val(GetGadgetText(7))      ;выбираем скорость передачи
          Data_bit=Val(GetGadgetText(9))  ;выбираем число бит данных
          Stop_bit=Val(GetGadgetText(10)) ;выбираем число стоповых бит
       
          If ((GetGadgetText(8))="N")     
            Parity_status=0
          ElseIf ((GetGadgetText(8))="E")
            Parity_status=2
          ElseIf ((GetGadgetText(8))="M")
           Parity_status=3
          ElseIf ((GetGadgetText(8))="O")
           Parity_status=1 
          ElseIf ((GetGadgetText(8))="S")
           Parity_status=4 
          EndIf          
          
       InData() ;принимаем данные из UART
          
       Event=WaitWindowEvent()  
       
       If Event=#PB_Event_Timer And EventTimer()=20
         RemoveWindowTimer(0,20)        ; выключаем 0,1с таймер        
         AddGadgetItem(4, -1, ("Через "+Str(ResponseTimeInt)+" миллисекунд получен ответ:"))
         AddGadgetItem(4, -1, Text_In)    ;переписываем в окно
         Text_In=""
         RemoveWindowTimer(0,21)       ; выключаем 1с таймер          
         Block=0                                       ; разблокируем кнопку "Запрос" 
         SetGadgetText(1,"Запрос")          
       EndIf
          
       If Event=#PB_Event_Timer And EventTimer()=21
         RemoveWindowTimer(0,21)                   ; выключаем 1с таймер 
         AddGadgetItem(4, -1, "Ответа нет.")    ;переписываем в окно
         Block=0                                                   ; разблокируем кнопку "Запрос"
         SetGadgetText(1,"Запрос")             
       EndIf 
          
       If Event=#PB_Event_Gadget        
         Gadget=EventGadget ( )       ;узнаём,какой гаджет был активирован        
         If Gadget=1                    ;если нажата кнопка "Запрос"
           If Block                  
           Else                         ;если разблокирована кнопка "Запрос"
              Protocol.s=GetGadgetText(2)
                 Select Protocol    ;выбираем протокол передачи
                    Case "RTU"
                        CRC16()  
                        Out_RTU()      
                    Case "ASCII"
                        LRC16()       
                        Out_ASCII()
                 EndSelect 
                    If QueryPerformanceFrequency_(Freq)
                        QueryPerformanceCounter_(Ctr1)    ;начало отсчёта времени ответа 
                    EndIf 
                      If IsSerialPort(2)
                        AddWindowTimer(0,21,1000); включить 1с таймер
                        AddGadgetItem(4, -1, "Ждём одну секунду.")    ;переписываем в окно                 
                        Block=1; блокируем кнопку "Запрос"
                        SetGadgetText(1,"Ждём...") 
                      EndIf 
                    EndIf 
         ElseIf (Gadget=7 Or  Gadget=8 Or  Gadget=9 Or  Gadget=10);если изменены параметры порта
            If IsSerialPort(2)          
              CloseSerialPort(2) 
              OpenSerialPort(2, Port, Baud, Parity_status, Data_bit, Stop_bit, #PB_SerialPort_NoHandshake, 1, 1) 
            EndIf
         ElseIf Gadget=17                    ;если был активирован выпадающий список          
           ComboBox.s=GetGadgetText(3) ;считываем текст из текущего пункта выпадающего списка.                
           Select_ComPort()                          
         ElseIf Gadget=6        ;если нажата кнопка очистки      
           ClearGadgetItems(4)  ;удаляем содержимое окна с данными
         ElseIf Gadget=19       ;нажата кнопка "Справка"
           MessageRequester("О программе","Данное программное обеспечение распространяется бесплатно, "+Chr(34)+"как есть"+Chr(34)+". "+Chr(13)+"По открытии порта тестер начинает слушать линию. "+Chr(13)+"Принятые данные показываются в окошке. "+Chr(13)+"При передаче в запрос сама добавляется контрольная сумма."+Chr(13)+"Поддерживаются команды 01, 02, 03, 04, 05, 06. "+Chr(13)+"Программа написана на языке Purebasic. "+Chr(13)+"Успехов!   Сёмин ВМ   САРАТОВ   2016")
         EndIf        
       EndIf 
       
       If Event=#WM_RBUTTONUP  
         If IsMouseOver(GadgetID(4))  
           DisplayPopupMenu(1,WindowID(0))  
         EndIf  
       EndIf  
   
       If Event=#PB_Event_Menu  
         Menu=EventMenu()  
         Select Menu  
         Case 1  
           SendMessage_(GadgetID(4), #EM_UNDO, #Null, #Null)  
         Case 2  
           SendMessage_(GadgetID(4), #EM_REDO, #Null, #Null)  
         Case 3, 4  
           SendMessage_(GadgetID(4), #EM_GETSEL, @Min,@Max)  
   
          If Min<>Max  
            If Min<Max  
              xx=Max-Min  
            Else  
              xx=Min-Max  
            EndIf  
   
           lpText.s=Space(xx)  
           SendMessage_(GadgetID(4), #EM_GETSELTEXT, #Null, @lpText)  
           SetClipboardText(lpText)  
   
           If Menu=3  
             SendMessage_(GadgetID(4),#EM_REPLACESEL,0,@"")  
           EndIf  
   
          EndIf  
   
         Case 5  
           Text.s=GetClipboardText()  
           SendMessage_(GadgetID(4),#EM_REPLACESEL,0,@Text)  
         Case 6  
           SendMessage_(GadgetID(4),#EM_SETSEL,0,-1)  
         EndSelect  
       EndIf

     Until Event=#PB_Event_CloseWindow 
     
EndIf          
End

0

2

  • Автор: newmayer
  • Активный участник
  • Зарегистрирован: 07.01.2015
  • Приглашений: 0
  • Сообщений: 34
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    16 часов 13 минут
  • Последний визит:
    06.03.2025 23:23:58

Не компилируется, жалуется на lowpart
Направьте пожалуйста в нужном направлении

0

3

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3188
  • Уважение: [+105/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 14 дней
  • Последний визит:
    Вчера 17:48:46
Код:
ResponseTime.f=(Ctr2\LongPart\lowpart - Ctr1\LongPart\lowpart ) * 1000 / Freq\LongPart\lowpart  ; Измеренное время в миллисекундах.

0

4

  • Автор: newmayer
  • Активный участник
  • Зарегистрирован: 07.01.2015
  • Приглашений: 0
  • Сообщений: 34
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    16 часов 13 минут
  • Последний визит:
    06.03.2025 23:23:58

Что за переменная такая? lowpart
Компилятор на нее жалуется
В тексте программы она больше нигде не встречается

0

5

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3188
  • Уважение: [+105/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 14 дней
  • Последний визит:
    Вчера 17:48:46

https://w32api.narod.ru/structures/LARGE_INTEGER.html

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

Компилятор на нее жалуется

Что пишет?
В сообщении выше исправленная строка.

0

6

  • Автор: newmayer
  • Активный участник
  • Зарегистрирован: 07.01.2015
  • Приглашений: 0
  • Сообщений: 34
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Провел на форуме:
    16 часов 13 минут
  • Последний визит:
    06.03.2025 23:23:58

Спасибо всем!!! Заработало

0

7

  • Автор: Ev3658
  • Активный участник
  • Ev3658
  • Зарегистрирован: 11.10.2020
  • Приглашений: 0
  • Сообщений: 50
  • Уважение: [+0/-0]
  • Позитив: [+7/-0]
  • Провел на форуме:
    10 часов 45 минут
  • Последний визит:
    25.04.2026 19:39:57

Спасибо за хороший пример.
Столкнулся с остановкой QueryPerformanceFrequency_

Код:
If QueryPerformanceFrequency_(Freq)
              QueryPerformanceCounter_(Ctr2)    ;окончание отсчёта времени ответа
              ResponseTime.f=(Ctr2\lowpart - Ctr1\lowpart )*1000/ Freq\lowpart  ;измеренное время в миллисекундах
              ResponseTimeInt=Round(ResponseTime,#PB_Round_Up)
            EndIf

Решил зациклить её чтоб уйти от оконных таймеров, а она берёт и встаёт через некоторое время.

Код:
Global Freq.LARGE_INTEGER,Ctr1.LARGE_INTEGER,Ctr2.LARGE_INTEGER
Global Protc_F.l,Protc_Ctr1.l,Protc_Ctr2.l
.....
If QueryPerformanceFrequency_(Freq)
  QueryPerformanceCounter_(Ctr1)    ;начало отсчёта времени
EndIf
.....
QueryPerformanceCounter_(Ctr2)
  Protc_Ctr1=Ctr1\LongPart\lowpart
  Protc_Ctr2=Ctr2\LongPart\lowpart
  Protc_F=Freq\LongPart\lowpart
 If (Protc_Ctr2-Protc_Ctr1)*1000/Protc_F>=1 
   QueryPerformanceCounter_(Ctr1) 
   TM_SYS+1
endif
......

Сталкивались с этим?
Можно как реализовать независимый таймер отдельно от окон и всего с точностью до 1мс?

Отредактировано Ev3658 (11.04.2026 18:11:29)

0

8

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3188
  • Уважение: [+105/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 14 дней
  • Последний визит:
    Вчера 17:48:46

У переменных типа Long диапазон хранения чисел от -2147483648 до +2147483647 и дело может быть в этом.

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

Можно как реализовать независимый таймер отдельно от окон и всего с точностью до 1мс?

Нужно именно выполнение кода через определенные промежутки времени, или отсчет промежутков времени.
В последнем случае функция ElapsedMilliseconds() возвращает время с момента запуска приложения с разрешающей способностью 1 мс.

Код:
t.q=ElapsedMilliseconds()
Delay(20)
Debug ElapsedMilliseconds()-t

t=ElapsedMilliseconds()
Delay(400)
Debug ElapsedMilliseconds()-t

0

9

  • Автор: Ev3658
  • Активный участник
  • Ev3658
  • Зарегистрирован: 11.10.2020
  • Приглашений: 0
  • Сообщений: 50
  • Уважение: [+0/-0]
  • Позитив: [+7/-0]
  • Провел на форуме:
    10 часов 45 минут
  • Последний визит:
    25.04.2026 19:39:57
Пётр написал(а):

У переменных типа Long диапазон хранения чисел от -2147483648 до +2147483647 и дело может быть в этом.

Нужно именно выполнение кода через определенные промежутки времени, или отсчет промежутков времени.
В последнем случае функция ElapsedMilliseconds() возвращает время с момента запуска приложения с разрешающей способностью 1 мс.

Спасибо Пётр! Выручили! Действительно стабильней работает.

Код:
 TM=ElapsedMilliseconds()
  Delay(1)
Repeat
  If ElapsedMilliseconds()-TM=>1
   TM=ElapsedMilliseconds()

0

10

  • Автор: Ev3658
  • Активный участник
  • Ev3658
  • Зарегистрирован: 11.10.2020
  • Приглашений: 0
  • Сообщений: 50
  • Уважение: [+0/-0]
  • Позитив: [+7/-0]
  • Провел на форуме:
    10 часов 45 минут
  • Последний визит:
    25.04.2026 19:39:57

Вообщем проблема такта системы актуальна.

Дополню код, без это будет сложней с COM портом RS232:

Код:
If IsSerialPort(#com_port)   ; если с таким ИД порт открыт и в режиме полуения данных.  

Shared TM_RX_BYTE

  Protected p.u,byte.a,tm.u

    ....
    ....
    ....

    ;InBytes = AvailableSerialPortInput(#com_port) ;получаем число принятых байт     
    While AvailableSerialPortInput(#com_port)
      If ReadSerialPortData(#com_port, @byte, 1)
        InBuffer(TM_RX_BYTE)=byte
        If InBuffer(0)=RTU\ADRS_RTU
          TM_RX_BYTE+1
          If TM_RX_BYTE>250
            TM_RX_BYTE=0
            InBuffer(0)=0
            EndIf
        Else
          TM_RX_BYTE=0
          InBuffer(0)=0
        EndIf
      EndIf
    Wend
    RealInBytes=TM_RX_BYTE
    InBytes=TM_RX_BYTE

   If RealInBytes>0......

Угощайтесь набросками TCP RTU  :blush Мини Сервер на NewList():
В коде учтите все переменные связанные с ID соединения. Как оказалось, ID клиента сервера QUAD переменная в x64. В коде учтите разрядность системы.

Код:
;
; ------------------------------------------------------------
;
;   PureBasic - Network (Server) example file
;
;    (c) Fantaisie Software
;
; ------------------------------------------------------------
;
; Note: run the NetworkClient.pb file to send some data to this server
;

EnableExplicit
Enumeration
  #TCP_PORT
  
EndEnumeration

Global Dim DataTCP_IN.a(1000);Буфер данных TCP RTU
Global Dim DataTCP_OUT.a(1000);Буфер данных TCP RTU
Global LEN_TCP_BYTE.l,*buffer,LEGHT_TCP.l
Structure TCP
  FLAG_READ.a;Флаг необходимости обработать
  POTC.u
  ClientID.q;ID клиента
  ClientIP.s[16]
  ID_TCP.u;Идентификатор транзакции 0001
  IND_TCP.U;Идентификатор протокола 0000
  LEGHT_TCP.u;Длина TCP 0006
  UNIT_TCP.a ;Адрес устройства 11
  Function_TCP.a;Функциональный код  03
  ADRS_TCP_OUT.u;Адрес первого регистра 006B
  LEGHT_TCP_OUT.u;Количество требуемых регистров 0003
  
 
  ADRS_RTU_IN.a;	Адрес устройства SlaveID 11
  INSTRUKCIA_IN.a;Функциональный код - инструкция 03
  ADRS_IN.u; Адрес первого регистра 006B
  LEGHT_IN.u;Количество требуемых регистров 0003
  WORD_IN.u
  LONG_IN.u
  CRC_IN.u      ;Контрольная сумма CRC 7687
  
  ADRS_RTU_OUT.a;	Адрес устройства SlaveID 11
  INSTRUKCIA_OUT.a;Функциональный код - инструкция 03
  ADRS_OUT.u; Адрес первого регистра 006B
  LEGHT_OUT.u;Количество требуемых регистров 0003
  CRC_OUT.u      ;Контрольная сумма CRC 7687
EndStructure

NewList TCP_RTU.TCP()
Global TCP_IP_SERVER.s, TCP_IP_PORT.u
TCP_IP_SERver="127.0.0.1"
TCP_IP_PORT=502


;TCP памятка
; 0001	Идентификатор транзакции	Transaction Identifier
; 0000	Идентификатор протокола	Protocol Identifier
; 0009	Длина (9 байтов идут следом)	Message Length
; 11	Адрес устройства (17 = 11 hex)	Unit Identifier
; 03	Функциональный код (читаем Analog Output Holding Registers)	Function Code
; 06	Количество байт далее (6 байтов идут следом)	Byte Count
; 02	Значение старшего разряда регистра (02 hex)	Register value Hi (AO0)
; 2B	Значение младшего разряда регистра (2B hex)	Register value Lo (AO0)
; 00	Значение старшего разряда регистра (00 hex)	Register value Hi (AO1)
; 64	Значение младшего разряда регистра (64 hex)	Register value Lo (AO1)
; 00	Значение старшего разряда регистра (00 hex)	Register value Hi (AO2)
; 7F	Значение младшего разряда регистра (7F hex)	Register value Lo (AO2)
  
;RTU памятка
; 11	Адрес устройства SlaveID (17 = 11 hex)
; 03	Функциональный код Function Code (читаем Analog Output Holding Registers)
; 006B	Адрес первого регистра (40108-40001 = 107 =6B hex)
; 0003	Количество требуемых регистров (чтение 3-х регистров с 40108 по 40110)
; 7687	Контрольная сумма CRC


Procedure CRC16_TCP_TX(dl.a)
  Protected crc.u, i.a, j.a 
  ;Shared DataTCP_IN()
  Shared DataTCP_OUT(),TCP_RTU()

  crc = 65535    ;подсчитываем CRC
  For i = 0 To dl
    crc = crc ! DataTCP_OUT(i)
    For j = 1 To 8
      If ((crc & 1) <> 0) 
        crc = (crc / 2)
        crc = (crc ! 40961)
      Else
        crc = (crc / 2)
      EndIf
    Next j
  Next i
  crc = crc & 65535
  DataTCP_OUT(dl+2) = crc / 256              ;старший байт CRC
  DataTCP_OUT(dl+1) = crc - (DataTCP_IN(dl+2) * 256) ;младший байт CRC
  TCP_RTU()\LEGHT_OUT=dl+2
EndProcedure     


Global ServerTCPEvent.l,Client_TCP_ID.q,adrs.a=4

Procedure TCP_SERVER()
  Protected p.l,o.l,crc.u
  Shared TCP_RTU(),ServerTCPEvent,TCP_IP_SERVER,*buffer,adrs
 


*Buffer = AllocateMemory(1000)



  ;MessageRequester("PureBasic - Server", "Server created (Port "+Port+").", 0)
  
 ;Debug ServerID(#TCP_PORT)
 If ServerID(#TCP_PORT)=0
   If CreateNetworkServer(#TCP_PORT, TCP_IP_PORT, #PB_Network_IPv4 | #PB_Network_TCP, TCP_IP_SERVER)
     Debug "OPEN SERVER"
  EndIf
  Else
   
   
 ;Debug "OK SERVER"

  ServerTCPEvent = NetworkServerEvent(#TCP_PORT);События сервера
    If ServerTCPEvent
        Debug "EVENT"
      Client_TCP_ID = EventClient();События клиента
            
      Select ServerTCPEvent ;-Обработчик TCP RTU
          
          
        Case #PB_NetworkEvent_Connect
          Debug "ККЛИЕНТ ID>"+Str(Client_TCP_ID)
          LEN_TCP_BYTE=0
          
        Case #PB_NetworkEvent_Data
          ;If ListSize(TCP_RTU())>0
           
          LEGHT_TCP=ReceiveNetworkData(Client_TCP_ID, *Buffer, 1000)
          If LEGHT_TCP>100
            While ReceiveNetworkData(Client_TCP_ID, *Buffer, 1000)
            Wend
            LEN_TCP_BYTE=0
          Else
            
      
          
            Debug "Принято>"+Str(LEGHT_TCP)
            For p=LEN_TCP_BYTE To LEGHT_TCP
              DataTCP_IN(p)=PeekB(*buffer+p)
              Debug Str(p)+"-"+Str(DataTCP_IN(p))
            Next p
            
            If DataTCP_IN(0)=adrs
                    LEN_TCP_BYTE=p
                    If LEN_TCP_BYTE>7 And LEGHT_TCP<>-1
        
                             crc = 65535    ;подсчитываем CRC
                             
                             For p = 0 To LEN_TCP_BYTE-3
                                crc = crc ! DataTCP_IN(p)
                                For o = 1 To 8
                                  If ((crc & 1) <> 0) 
                                    crc = (crc / 2)
                                    crc = (crc ! 40961)
                                  Else
                                    crc = (crc / 2)
                                  EndIf
                                Next o
                              Next p
                              crc = crc & 65535
                              ;Debug "Str(crc)
                              If DataTCP_IN(LEN_TCP_BYTE-1) = crc / 256  And DataTCP_IN(LEN_TCP_BYTE-2) = crc - (DataTCP_IN(LEN_TCP_BYTE-1) * 256)      ;старший байт CRC           ;младший байт CRC
                                Debug "OK"
                                AddElement(TCP_RTU())
                                TCP_RTU()\FLAG_READ=1
                                 TCP_RTU()\ClientID=Client_TCP_ID
                                 TCP_RTU()\ADRS_RTU_IN=DataTCP_IN(0);adrs
                                 TCP_RTU()\INSTRUKCIA_IN=DataTCP_IN(1);instr
                                 Select TCP_RTU()\INSTRUKCIA_IN
                                   Case 3;Ответ на запрос адреса
                                     PokeB(@TCP_RTU()\ADRS_IN,DataTCP_IN(3))
                                     PokeB(@TCP_RTU()\ADRS_IN+1,DataTCP_IN(2))
                                     
                                     PokeB(@TCP_RTU()\LEGHT_IN,DataTCP_IN(5))
                                     PokeB(@TCP_RTU()\LEGHT_IN+1,DataTCP_IN(4))
                                     Debug "ADRS REG>"+Str(TCP_RTU()\ADRS_IN)
                                     Debug "LEGT>"+Str(TCP_RTU()\LEGHT_IN)
                                       LEN_TCP_BYTE=0
         
                                   Default 
                                     Debug "X/#3"
                                     End
                                 EndSelect 
                               Else
                                  LEN_TCP_BYTE=0
        
                                 
                               EndIf
                              
                   
                               ;DataTCP_OUT(0)=TCP_RTU()\ADRS_RTU_IN
                                ; 0-4
                                ; 1-6
                                ; 2-0
                                ; 3-0
                                ; 4-0
                                ; 5-127
                                ; 6-200
                                ; 7-127
                                ; 8-0
                               
        
                                ; 0-4 ;adrs
                                ; 1-3 ;instr
                                ; 2-0 ;Hi adres
                                ; 3-0 ;Lo adres
                                ; 4-0 ;Hi_leght
                                ; 5-14 ;Lo_leght
                                ; 6-196 ;crc
                                ; 7-91 ;crs
                                ; 8-0
        
                               
                             EndIf    
                             
                           Else
                             LEGHT_TCP=0
                           EndIf
                         EndIf ; If LEGHT_TCP>100
                         
                  Case #PB_NetworkEvent_Disconnect
                    ResetList(TCP_RTU()) ;Сбрасывает текущий элемент списка так, чтобы он находился перед первым элементом. Это означает, что ни один элемент фактически не является допустимым. Однако это очень полезно, поскольку позволяет обрабатывать все элементы с помощью метода NextElement()
                    While NextElement(TCP_RTU()) ;Перемещает элемент от текущего элемента к следующему элементу в списке или к первому элементу, если вы ранее вызывали
                      If Client_TCP_ID=TCP_RTU()\ClientID;Находим клиента и удаляем всё что с ним связано в списке пакетов
                        DeleteElement(TCP_RTU(),1)       ;сли этот параметр установлен на 1 и первый элемент удален, новым текущим элементом будет второй. Этот флаг гарантирует, что после удаления всегда будет существовать действительный текущий элемент, пока в списке еще есть элементы
                      EndIf
                    Wend
                    LEN_TCP_BYTE=0
                      ;EndIf
                      

                EndSelect
                
             
EndIf   
                
    EndIf

EndProcedure

Global adrs.a=4
Global INSTR.U
Global WORD.U
Global LONG.L
Global Byte.a
Global p.a
 Repeat
TCP_SERVER() 
;Delay(1)
If ListSize(TCP_RTU())>0
  ;Debug ListSize(TCP_RTU())
  ;DisableDebugger
  ;Обработчик очереди ответа
  ResetList(TCP_RTU())
  While NextElement(TCP_RTU())
    If TCP_RTU()\FLAG_READ=1 
       Debug "OK READ"
       ;ResetList(TCP_RTU())
       ;TCP_RTU()\FLAG_READ=0 ; сбрасываем флаг обрабочтки чтения
       ;TCP_RTU()\ClientID ;ID Клиента
       TCP_RTU()\ADRS_RTU_OUT=TCP_RTU()\ADRS_RTU_IN
       TCP_RTU()\INSTRUKCIA_OUT=TCP_RTU()\INSTRUKCIA_IN
       TCP_RTU()\FLAG_READ=0 ; сбрасываем флаг обрабочтки чтения
       Select TCP_RTU()\INSTRUKCIA_IN
         Case 3
           ;кол-во байт
           TCP_RTU()\LEGHT_OUT=TCP_RTU()\LEGHT_IN
           DataTCP_OUT(0)=TCP_RTU()\ADRS_IN
           DataTCP_OUT(1)=TCP_RTU()\INSTRUKCIA_IN
          ; DataTCP_OUT(2)=PeekB(@TCP_RTU()\ADRS_OUT)
           
           
           Global TM
           TM=3 ;Начальный байт +2 каждый цикл в TM
                ;Блоки данных
           ;Word=0;word*TCP_RTU()\LEGHT_IN
           For p=0 To TCP_RTU()\LEGHT_IN
             Word+1
             DataTCP_OUT(TM+1)=PeekB(@word)
             DataTCP_OUT(TM)=PeekB(@word+1)
             TM+2
           Next p
           TCP_RTU()\LEGHT_OUT=TM-2
            Debug "LEGT OUT>"+Str(TCP_RTU()\LEGHT_OUT-3)
           CRC16_TCP_TX(TCP_RTU()\LEGHT_OUT+2)
           Debug "SEND ОТВЕТ"
          
           Debug "ADRS REG OUT>"+Str(TCP_RTU()\ADRS_OUT)
           
           
           SendNetworkData(TCP_RTU()\ClientID,@DataTCP_OUT(),TCP_RTU()\LEGHT_OUT+2)
           For p=0 To 1000
             DataTCP_OUT(p)=0
             Next p
           
           DeleteElement(TCP_RTU())
           ResetList(TCP_RTU())
           LEN_TCP_BYTE=0
       EndSelect 
     EndIf
     
     Wend                     
   EndIf
   
              ; 0-4 ;adrs
          ; 1-3 ;instr
          ; 2-0 ;Hi adres
          ; 3-0 ;Lo adres
          ; 4-0 ;Hi_leght
          ; 5-14 ;Lo_leght
          ; 6-196 ;crc
          ; 7-91 ;crs
          ; 8-0
       Delay(1)
  ForEver
End

Отредактировано Ev3658 (20.04.2026 22:18:56)

0

11

  • Автор: Пётр
  • Активный участник
  • Зарегистрирован: 14.06.2009
  • Приглашений: 0
  • Сообщений: 3188
  • Уважение: [+105/-5]
  • Позитив: [+1/-0]
  • Пол: Мужской
  • Провел на форуме:
    2 месяца 14 дней
  • Последний визит:
    Вчера 17:48:46
Ev3658 написал(а):

Как оказалось, ID клиента сервера QUAD переменная в x64.

Это указатель или integer переменная.

0

Страница: 1

Вы здесь » PureBasic - форум » OpenSource » Modbus RTU/ASCII