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