Код:
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