ÿþImports System.IO.Ports Public Class Ez_Slo_Bus_Tester_Form1 ' ########################################################### ' ########################################################### Dim strPublicAddress As String = String.Empty Dim strPublicCommand As String = String.Empty Dim strActiveAddress As String Dim I_Count_Index As Integer Dim I_Delay_Flag As Integer Dim intPosition(3) As Integer Dim str_SerPortBuffer As String Dim str_ModuleSearchBuffer(31) As String Dim I_ExpectedBlockLength As Integer = 0 Dim str_Defghi As String Public I_EzBusBusyFlag As Integer = 0 Public str_EzSloBusInfo As String = String.Empty Public strCommunicationFlag As String = "Default" Public strCOM_Interface As String = String.Empty Public strBaudrate As String = "19200" ' Baud Public str_BUS_Time_Out_Flag As String = "Clear" Dim CurrentAppOriginal As Process Dim str_Efghij As String Dim str_Klmnop As String Dim str_DoubleAddress(3) As String Dim str_DoubleCommand(3) As String Dim i_DoubleTriggerCounter As Integer ' ########################################################### ' ########################################################### Public Sub New() 'Dim iDelta As Integer = 0 ' This call is required by the designer. InitializeComponent() ' Add any initialization after the InitializeComponent() call. txt_Interface.BackColor = Color.Green txt_Interface.ForeColor = Color.Yellow 'str_Defghi = strfctn_MonitorPriorityLevel() ' 04.03.2013 08.03.2013 10.04.2014 lblGetPriority.Visible = False End Sub ' ########################################################### ' ########################################################### ' Load the form1 and set up parameters from the default serial port. ' Open the port and prepare it for IO. Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load Control.CheckForIllegalCrossThreadCalls = False ' added 23. Nov. 2010 ' this seems to be very important !!! 'Me.Text &= " Version 12406a" 'Me.Text &= " Version 12708a" ' removed > strFileInfo = Fetch_Info(strInitFolderName, "Config_11914.txt")< 'Me.Text &= " Version 12711a" ' changed >Delay_Time< 'Me.Text &= " Version 12725a" ' removed >Delay_Time< 'Me.Text &= " Version 12728a" ' Repeat LED works 'Me.Text &= " Version 12804a" ' removed: ' Do ' My.Application.DoEvents() ' Loop While (I_EzBusBusyFlag = 1) 'Me.Text &= " Version 12827a" ' added >'My.Application.DoEvents() ' 27. Aug. 2012 < '' after(txt_Received_Data.Text) 'Me.Text &= " Version 12b05b" ' removing some comments around MessageBox.Show '' adding >I_RS232OpenFlag< 'Me.Text &= " Version 12b06b" ' opening RS232Port only once '' and closing when closing the form 'Me.Text &= " Version 12b09a" ' adding >I_RS232OpenFlag< and testing for it. '' 'Me.Text &= " Version 12b11b" ' adding SerialPortWorkAround '' 'Me.Text &= " Version 12b12a" ' moving >WaitSendTimer.Interval = 100< to >Manual_Send()< '' 'Me.Text &= " Version 12b13a" ' checking >SerialPort1.Inbuffer< in event handler '' 'Me.Text &= " Version 12b14a" ' rewriting Event handler for Serial Port data reception '' 'Me.Text &= " Version 12b16a" ' more: rewriting Event handler for Serial Port data reception 'Me.Text &= " Version 12b16b" ' removing SerialPortWorkAround 'Me.Text &= " Version 12b17a" ' moving >str_SerPortBuffer = String.Empty< to Sub Send_Message(....) ' 'Me.Text &= " Version 13202a" ' making sure two strings are received when sending an inquiry 'Me.Text &= " Version 13204b" ' adding >str_EzSloBusInfo< 'Me.Text &= " Version 13205a" ' clearing >str_SerPortBuffer< 'Me.Text &= " Version 13222a" ' Priority level 'Me.Text &= " Version 13224a" ' more Priority level 'Me.Text &= " Version 13228a" ' clearing >strCommunicationFlag< 'Me.Text &= " Version 13304a" ' changing subroutine to function 'Me.Text &= " Version 13308a" ' removing Priority level 'Me.Text &= " Version 13309a" ' adding more >str_EzSloBusInfo< 'Me.Text &= " Version 13311a" ' reactivating Priority level 'Me.Text &= " Version 13412a" ' adding >strfctn_SendDoubleMessage< 'Me.Text &= " Version 13415a" ' more adding >strfctn_SendDoubleMessage< 'Me.Text &= " Version 13416a" ' improving >strfctn_SendDoubleMessage< 'Me.Text &= " Version 13512a" ' increasing >Timer_Search.Interval< 'Me.Text &= " Version 13513a" ' decreasing >Timer_Search.Interval< again error somewhere else 'Me.Text &= " Version 13a30b" ' allowing address "I" and "O" (no command) to turn Bus Power ON and OFF 'Me.Text &= " Version 13a31a" ' added Bus_Time_Out_Flag 'Me.Text &= " Version 14401a" ' Switch to Visual Studio Express 2013 'Me.Text &= " Version 14410b" ' attempting to find memory leak Me.Text &= " Version 14429a" ' removed all >My.Application.DoEvents()< 'MessageBox.Show("Start", "Here we begin") ' ############################################################ 'Timer_Indicator.Interval = 1000 ' Milliseconds 'Timer_Indicator.Enabled = True 'IndicatorTimer.Enabled = False strCommunicationFlag = "Default" ' ############################################################ pgbSearch.Visible = False pgbSearch.Maximum = 31 ' ############################################################ txt_Baud_Rate.Text = strBaudrate txt_Interface.Text = strfctn_GetSerialPortNames() 'Call Instance_SerPort_Correction.SerialPortFixer.Execute(strCOM_Interface) str_Defghi = strfctn_OpenCOMInterface() End Sub 'end >Form1_Load< ' ########################################################### ' ########################################################### Private Sub btn_Exit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btn_Exit.Click Dim i_LenRXD As Integer If SerialPort1.IsOpen = True Then Try i_LenRXD = SerialPort1.BytesToRead Catch ex As Exception MessageBox.Show(ex.Message, "123") End Try If i_LenRXD <> 0 Then Do Until i_LenRXD = 0 Try str_SerPortBuffer &= Chr(SerialPort1.ReadChar) Catch ex As Exception MessageBox.Show(ex.Message, "1234") End Try Try i_LenRXD = SerialPort1.BytesToRead Catch ex As Exception MessageBox.Show(ex.Message, "345") End Try Loop End If ' end of >i_LenRXD <> 0< Try ' remove the event handler for data reception RemoveHandler SerialPort1.DataReceived, AddressOf SerialPort1_DataReceived Catch ex As System.Exception MessageBox.Show(ex.Message, "999") End Try End If ' end of >SerialPort1.IsOpen = True< ' Ends the program and closes the form Try ' Close the serial port Call SerialPort1.Close() MyBase.Dispose() Me.Close() Catch ex As System.Exception MessageBox.Show(ex.Message, "aaa") End Try End Sub ' ########################################################### ' ########################################################### Public Function strfctn_GetSerialPortNames() As String Dim I_Xxxx As Integer strfctn_GetSerialPortNames = String.Empty Try I_Xxxx = My.Computer.Ports.SerialPortNames.Count Catch ex As Exception MessageBox.Show(ex.Message, "SerialPortNames.Count") End Try If I_Xxxx > 0 Then ' Show all available COM ports. Try For Each sp As String In My.Computer.Ports.SerialPortNames ListBox1.Items.Add(sp) strCOM_Interface = sp Next Catch ex As Exception MessageBox.Show(ex.Message, "SerialPortNames") End Try strfctn_GetSerialPortNames = strCOM_Interface txt_Received_Data.Text = strCOM_Interface & " found" txt_Received_Data.BackColor = Color.White txt_Received_Data.ForeColor = Color.Black Else txt_Received_Data.Text = "COM Interface missing" txt_Received_Data.BackColor = Color.Red txt_Received_Data.ForeColor = Color.Yellow End If 'My.Application.DoEvents() ' 27. Aug. 2012 off 04.03.2013 End Function ' ########################################################### ' ########################################################### ' ########################################################### ' ########################################################### Public Function strfctn_OpenCOMInterface() As String strfctn_OpenCOMInterface = "COM closed" 'Try ' 14410b ' ' Close the serial port ' Call SerialPort1.Close() 'Catch ex As System.Exception ' MessageBox.Show(ex.Message, "Close COM") 'End Try If strCOM_Interface <> String.Empty Then SerialPort1.PortName = strCOM_Interface SerialPort1.BaudRate = strBaudrate SerialPort1.RtsEnable = 0 SerialPort1.DataBits = 8 SerialPort1.RtsEnable = False Try ' Open the serial port SerialPort1.Open() strfctn_OpenCOMInterface = "COM opened" Catch ex As System.Exception MessageBox.Show(ex.Message, "in >Open_COMInterface()<") End Try 'strfctn_OpenCOMInterface = "COM opened" ' moved to "Try" Try ' Set the event handler for data reception AddHandler SerialPort1.DataReceived, AddressOf SerialPort1_DataReceived Catch ex As System.Exception MessageBox.Show(ex.Message, "addhandler in >Open_COMInterface()<") End Try ' Done after interface is opened! SerialPort1.StopBits = &H1 ' one Stop Bit SerialPort1.Parity = 0 ' No Parity Else MessageBox.Show("NO COMInterface found", "Warning") End If End Function ' ########################################################### ' ########################################################### ' ########################################################### ' ########################################################### ' **************************************************************************************** ' **************************************************************************************** ' call: strInformation = Fetch_Info("Measurement_Data", "Data_24. Jan. 2011.txt") ' Folder File name ' **************************************************************************************** 'Public Function Fetch_Info(ByVal strFolder As String, _ ' ByVal strFileName As String) ' Dim strFilePathName As String ' Dim strfileContents As String ' strFilePathName = My.Computer.FileSystem.CurrentDirectory ' My.Computer.FileSystem.CreateDirectory(strFilePathName & "\" & strFolder) ' strFilePathName = My.Computer.FileSystem.CurrentDirectory ' strFilePathName = strFilePathName & "\" & strFolder & "\" & strFileName ' strfileContents = String.Empty ' Try ' strfileContents = My.Computer.FileSystem.ReadAllText(strFilePathName) ' Catch ex As Exception ' MessageBox.Show(ex.Message, My.Application.Info.Title, _ ' MessageBoxButtons.OK, MessageBoxIcon.Error) ' End Try ' Return strfileContents 'End Function ' **************************************************************************************** ' ########################################################### ' ########################################################### ' Event handler for data reception ' Public Sub SerialPort1_DataReceived(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs) Dim strAddress As String Dim I_Posi_BUS As Integer Dim I_Posi_Time As Integer Dim I_Posi_out As Integer 'str_Efghij = strfctn_SetPriorityLevel("RealTime") ' 04.03.2013 'str_Defghi = strfctn_MonitorPriorityLevel() ' 04.03.2013 If SerialPort1.IsOpen = True Then Do Until I_ExpectedBlockLength = 0 Try str_SerPortBuffer &= SerialPort1.ReadLine Catch ex As Exception MessageBox.Show(ex.Message, "2345") End Try I_ExpectedBlockLength -= 1 Loop Try SerialPort1.DiscardInBuffer() Catch ex As System.Exception MessageBox.Show(ex.Message, "hhh") End Try Try SerialPort1.DiscardOutBuffer() Catch ex As System.Exception MessageBox.Show(ex.Message, "iii") End Try End If ' My.Application.DoEvents() '14429 ' 27. Aug. 2012 If I_ExpectedBlockLength = 0 Then ' i.e. all characters have been received Select Case strCommunicationFlag Case "Search" ' ################ strCommunicationFlag = "Default" ' 28.02.2013 str_ModuleSearchBuffer(I_Count_Index - 33) = str_SerPortBuffer strAddress = String.Empty Case "Send" ' ################ strCommunicationFlag = "Default" ' 28.02.2013 str_EzSloBusInfo = str_SerPortBuffer ' 04.02.2103 txt_Received_Data.Text = str_SerPortBuffer I_EzBusBusyFlag = 0 txt_Interface.BackColor = Color.Green I_Posi_BUS = InStr(str_SerPortBuffer, "BUS") ' added 31.10.2013 I_Posi_Time = InStr(str_SerPortBuffer, "Time") I_Posi_out = InStr(str_SerPortBuffer, "out") If I_Posi_BUS = 0 And I_Posi_Time = 0 And I_Posi_out = 0 Then ' do nothing; everything is Okay ' >str_BUS_Time_Out_Flag< must be cleared in external application Else str_BUS_Time_Out_Flag = "Set" ' indicated atleast one module is not answering properly! 'txt_CommandOne.Text = str_BUS_Time_Out_Flag End If str_SerPortBuffer = String.Empty ' 05.02.2013 'strCommunicationFlag = "Default" ' 05.02.2013 ' 28.02.2013 Case "Default" ' ################ ' nothing happens when an unknown character is received! End Select ' Select Case strCommunicationFlag End If ' end of >If I_ExpectedBlockLength = 0 Then< 'str_Efghij = strfctn_SetPriorityLevel("Normal") ' 04.03.2013 'str_Defghi = strfctn_MonitorPriorityLevel() ' 04.03.2013 ' My.Application.DoEvents() '14429 ' 27. Aug. 2012 End Sub ' ########################################################### ' ########################################################### 'Private stopBits, parity As Array ' arrays to access the enumerations in System.IO.Ports 'Private validStopBits As New ArrayList() ' ArrayLists hold the valid values for this machine 'Private validParity As New ArrayList() ' ************************************************************************ ' Send the text in the text box to the serial port. ' The data should stay in the buffer until received by the event handler. Public Sub btn_Send_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btn_Send.Click str_Klmnop = strfctn_SingleSend() End Sub 'SendButton_Click ' ########################################################### ' ########################################################### Public Function strfctn_SingleSend() As String Dim str_Abcdef As String strfctn_SingleSend = "sending" I_EzBusBusyFlag = 1 txt_Interface.BackColor = Color.Red strCommunicationFlag = "Send" txt_Received_Data.BackColor = Color.White txt_Received_Data.ForeColor = Color.Black str_Abcdef = strfctn_ManualSend() strfctn_SingleSend = "finished sending" End Function ' ########################################################### ' ########################################################### ' ########################################################### ' ########################################################### Public Function strfctn_ManualSend() As String Dim str_Bcdefg As String 'If SerialPort1.IsOpen = False Then ' str_Defghi = strfctn_OpenCOMInterface() 'Else Try SerialPort1.DiscardInBuffer() Catch ex As System.Exception MessageBox.Show(ex.Message, "jjj") End Try Try SerialPort1.DiscardOutBuffer() Catch ex As System.Exception MessageBox.Show(ex.Message, "kkk") End Try 'Try ' 14410a ' ' Set the event handler for data reception ' AddHandler SerialPort1.DataReceived, AddressOf SerialPort1_DataReceived 'Catch ex As System.Exception ' MessageBox.Show(ex.Message, "addhandler in >Manual_Send()<") 'End Try 'End If 'Try ' 14410a ' SerialPort1.DiscardInBuffer() 'Catch ex As System.Exception ' MessageBox.Show(ex.Message, "111") 'End Try If Cbx_SingleDouble.Checked = True Then 'MessageBox.Show("Not yet", "Warning") str_Bcdefg = strfctn_SendDoubleMessage(txt_AddressOne.Text, txt_CommandOne.Text, txt_AddressTwo.Text, txt_CommandTwo.Text) Else str_Bcdefg = strfctn_SendSingleMessage(txt_AddressOne.Text, txt_CommandOne.Text) End If strfctn_ManualSend = "Finished" End Function ' ########################################################### ' ########################################################### ' ########################################################### ' ########################################################### Public Function strfctn_SendSingleMessage(ByVal strAddress As String, ByVal strCommand As String) As String Dim I_ErrorFlag As Integer = 0 Dim I_Equivalent As Integer = 0 'str_Efghij = strfctn_SetPriorityLevel("RealTime") ' 04.03.2013 'str_Defghi = strfctn_MonitorPriorityLevel() ' 04.03.2013 str_SerPortBuffer = String.Empty strPublicAddress = Mid(strAddress, 1, 1) ' makes sure there is only one strAddress = strPublicAddress ' ASCII character in the address strPublicCommand = strCommand If strCommand <> String.Empty Then I_Equivalent = Asc(strCommand) Select Case I_Equivalent Case 64 To 95 ' 64 = ASCII "@" ....A-Z.... 95 = ASCII "_" I_ExpectedBlockLength = 1 Case 96 To 127 ' 96 = ASCII "`" ....a-z.... 127 = ASCII "^" I_ExpectedBlockLength = 2 Case Else I_ExpectedBlockLength = 9 ' default End Select Else Select Case strAddress Case "?" I_ExpectedBlockLength = 3 Case "I", "O" ' "I" turns Bus Power ON, "O" turns Bus Power OFF I_ExpectedBlockLength = 2 ' Echo plus Reply Case Else I_ExpectedBlockLength = 0 End Select End If I_ErrorFlag = 0 ' My.Application.DoEvents() '14429 If Len(strAddress) = 1 Then If Len(strCommand) > 0 Then Try ' Write a line to the serial port SerialPort1.Write(strAddress & strCommand & Chr(13) & Chr(10)) ' CR LF Catch ex As System.Exception MessageBox.Show(ex.Message, "222") End Try Else ' i.e. strCommand = "" (Null) Select Case strAddress Case "?", "I", "O" ' "I" turns Bus Power ON, "O" turns Bus Power OFF txt_Received_Data.Text = String.Empty str_EzSloBusInfo = String.Empty ' 09.03.2013 Try SerialPort1.DiscardInBuffer() Catch ex As Exception MessageBox.Show(ex.Message, "333") End Try Try ' Write a line to the serial port SerialPort1.Write(strAddress & Chr(13) & Chr(10)) ' CR LF Catch ex As System.Exception MessageBox.Show(ex.Message, "444") End Try Case Else txt_Received_Data.Text = "Command Error" str_EzSloBusInfo = "Command Error" ' 09.03.2013 I_ErrorFlag = 1 I_EzBusBusyFlag = 0 txt_Interface.BackColor = Color.Green End Select End If Else I_ErrorFlag = 1 txt_Received_Data.Text = "Address Error" str_EzSloBusInfo = "Address Error" ' 09.03.2013 I_EzBusBusyFlag = 0 txt_Interface.BackColor = Color.Green End If If strAddress = "?" And str_SerPortBuffer = String.Empty And I_ErrorFlag = 1 Then txt_Received_Data.Text = "RS232-Transmission Error" str_EzSloBusInfo = "RS232-Transmission Error" ' 09.03.2013 Else End If 'My.Application.DoEvents() ' 27. Aug. 2012 off 04.032013 strfctn_SendSingleMessage = "SendSingleMessage_Done" End Function ' ########################################################### ' ########################################################### Public Function strfctn_SendDoubleMessage(ByVal strAddrOne As String, ByVal strComOne As String, _ ByVal strAddrTwo As String, ByVal strComTwo As String) As String i_DoubleTriggerCounter = 1 str_DoubleAddress(1) = strAddrOne str_DoubleCommand(1) = strComOne str_DoubleAddress(2) = strAddrTwo str_DoubleCommand(2) = strComTwo strfctn_SendDoubleMessage = strfctn_SendSingleMessage(str_DoubleAddress(i_DoubleTriggerCounter), str_DoubleCommand(i_DoubleTriggerCounter)) i_DoubleTriggerCounter += 1 ' My.Application.DoEvents() '14429 ' 16.04.2013 Timer_DoubleTrigger.Interval = 300 Timer_DoubleTrigger.Enabled = True 'strfctn_SendDoubleMessage = "Done" End Function ' ########################################################### ' ########################################################### ' ########################################################### ' ########################################################### ' ########################################################### ' ########################################################### Public Function strfctn_SearchModules() As String strfctn_SearchModules = "Busy" 'If SerialPort1.IsOpen = False Then ' str_Defghi = strfctn_OpenCOMInterface() 'Else 'End If I_EzBusBusyFlag = 1 Me.Cursor = Cursors.WaitCursor Me.I_Count_Index = 33 ' to 63 in SearchTimer_Tick (&H21 ASCII "!" to &H3F ASCII "?" ) pgbSearch.Visible = True strActiveAddress = String.Empty txt_CommandOne.Text = "~" 'SearchTimer.Interval = 70 ' Milliseconds ' Could be shorter; 50 mSec is still okay 'Timer_Search.Interval = 100 ' Milliseconds ' 16. Nov. 2012 Timer_Search.Interval = 100 ' again Milliseconds ' 13.05.2013 Timer_Search.Enabled = True strfctn_SearchModules = "Searching done" End Function ' ########################################################### ' ########################################################### ' ########################################################### Private Sub btnSearch_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSearch.Click Dim str_qwertz As String txt_Received_Data.BackColor = Color.White txt_Received_Data.ForeColor = Color.Black Cbx_SingleDouble.Visible = False lbl_Send_Data.Visible = False btn_Send.Visible = False lblRepeat.Visible = False ledTwo.Visible = False txt_Interface.BackColor = Color.Red txt_Received_Data.Text = "Searching" str_EzSloBusInfo = "Busy" ' 04.02.2013 str_qwertz = strfctn_SearchModules() 'Cbx_SingleDouble.Visible = True End Sub ' ########################################################### ' ########################################################### ' ########################################################### ' ########################################################### Private Sub lbl_Command_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl_Command.Click txt_CommandOne.Text = String.Empty End Sub ' ########################################################### ' ########################################################### Private Sub lbl_Address_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl_Address.Click txt_AddressOne.Text = "?" End Sub ' ########################################################### ' ########################################################### Private Sub ledTwo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ledTwo.Click If ledTwo.FillColor = Color.Lime Then ledTwo.FillColor = Color.Red btnSearch.Visible = False lblRepeat.Text = " Stop Send" btnSearch.Visible = False lbl_Send_Data.Visible = False btn_Exit.Visible = False Cbx_SingleDouble.Visible = False btn_Send.Visible = False Timer_Repeat.Interval = 1000 ' Milliseconds 14.Nov. 2012 Timer_Repeat.Enabled = True Else ledTwo.FillColor = Color.Lime btnSearch.Visible = True lblRepeat.Text = "Repeat Send" Timer_Repeat.Enabled = False btn_Exit.Visible = True Cbx_SingleDouble.Visible = True btn_Send.Visible = True btnSearch.Visible = True lbl_Send_Data.Visible = True txt_Received_Data.ForeColor = Color.Black End If End Sub ' ########################################################### ' ########################################################### Private Sub txt_AddressOne_Click(sender As Object, e As System.EventArgs) Handles txt_AddressOne.Click txt_AddressOne.Text = String.Empty End Sub ' ########################################################### ' ########################################################### Private Sub txt_CommandOne_Click(sender As Object, e As System.EventArgs) Handles txt_CommandOne.Click txt_CommandOne.Text = String.Empty End Sub ' ########################################################### ' ########################################################### Private Sub txt_AddressTwo_Click(sender As System.Object, e As System.EventArgs) Handles txt_AddressTwo.Click txt_AddressTwo.Text = String.Empty End Sub '' ########################################################### ' ########################################################### Private Sub txt_CommandTwo_Click(sender As System.Object, e As System.EventArgs) Handles txt_CommandTwo.Click txt_CommandTwo.Text = String.Empty End Sub '' ########################################################### ' ########################################################### Private Sub Timer_Search_Tick(sender As System.Object, e As System.EventArgs) Handles Timer_Search.Tick Dim strAddress As String Dim strTextTemp As String Dim i_LoopCounter As Integer Dim str_Cdefgh As String ' My.Application.DoEvents() '14429 If btnSearch.BackColor = Color.Yellow Then btnSearch.BackColor = Color.DarkOrchid ' Ready to send Data on RS232 Port btnSearch.ForeColor = Color.Yellow pgbSearch.Value = (I_Count_Index - 33 + 1) strCommunicationFlag = "Search" str_SerPortBuffer = String.Empty 'Call Send_Message(Chr(I_Count_Index), txt_Command.Text) str_Cdefgh = strfctn_SendSingleMessage(Chr(I_Count_Index), txt_CommandOne.Text) txt_AddressOne.Text = Chr(I_Count_Index) Else btnSearch.BackColor = Color.Yellow btnSearch.ForeColor = Color.Black ' RS232 Data should be available at this phase I_Count_Index += 1 If I_Count_Index > 63 Then ' i.e. all Modules have been interrogated ' Me.I_Count_Index = 33 ' to 63 in SearchTimer_Tick (&H21 ASCII "!" to &H3F ASCII "?" ) Timer_Search.Enabled = False Me.Cursor = Cursors.Default pgbSearch.Value = 0 ' ProgressBar empty str_EzSloBusInfo = String.Empty ' 04.02.2103 txt_Received_Data.Text = String.Empty pgbSearch.Visible = False txt_CommandOne.Text = String.Empty ' Analyzing all the replies ...... For i_LoopCounter = 0 To 31 Step 1 strAddress = Mid(str_ModuleSearchBuffer(i_LoopCounter), 1, 1) strTextTemp = Mid(str_ModuleSearchBuffer(i_LoopCounter), 4, 16) If (strTextTemp = ("Client " & strAddress & " Active" & Chr(&HD))) Then str_EzSloBusInfo &= strAddress ' 04.02.2103 txt_Received_Data.Text &= strAddress Else End If Next i_LoopCounter If txt_Received_Data.Text = String.Empty Then txt_Received_Data.Text = "No Modules found" str_EzSloBusInfo = "No Modules found" txt_Received_Data.BackColor = Color.Red txt_Received_Data.ForeColor = Color.Yellow Else txt_Received_Data.BackColor = Color.White txt_Received_Data.ForeColor = Color.Black End If btn_Send.Visible = True lbl_Send_Data.Visible = True lblRepeat.Visible = True ledTwo.Visible = True Cbx_SingleDouble.Visible = True strCommunicationFlag = "Default" I_EzBusBusyFlag = 0 txt_Interface.BackColor = Color.Green End If End If ' My.Application.DoEvents() '14429 ' 27. Aug. 2012 End Sub ' ########################################################### Private Sub Timer_Repeat_Tick(sender As System.Object, e As System.EventArgs) Handles Timer_Repeat.Tick If txt_Received_Data.ForeColor = Color.Blue Then txt_Received_Data.ForeColor = Color.Red Else txt_Received_Data.ForeColor = Color.Blue End If ' My.Application.DoEvents() '14429 'Call Method_Send() str_Klmnop = strfctn_SingleSend() End Sub ' ########################################################### 'Private Function strfctn_SetPriorityLevel(ByVal str_Level As String) As String ' Try ' CurrentAppOriginal = Process.GetCurrentProcess ' Select Case str_Level ' Case "Idle" ' CurrentAppOriginal.PriorityClass = ProcessPriorityClass.Idle ' Case "BelowNormal" ' CurrentAppOriginal.PriorityClass = ProcessPriorityClass.BelowNormal ' Case "Normal" ' CurrentAppOriginal.PriorityClass = ProcessPriorityClass.Normal ' Case "AboveNormal" ' CurrentAppOriginal.PriorityClass = ProcessPriorityClass.AboveNormal ' Case "High" ' CurrentAppOriginal.PriorityClass = ProcessPriorityClass.High ' Case "RealTime" ' CurrentAppOriginal.PriorityClass = ProcessPriorityClass.RealTime ' Case Else ' MessageBox.Show("Error in Priority Class", "Warning") ' End Select ' Catch ex As Exception ' MsgBox(ex.Message) ' End Try ' CurrentAppOriginal = Process.GetCurrentProcess ' strfctn_SetPriorityLevel = str_Level 'End Function '' ########################################################### '' ########################################################### 'Private Function strfctn_MonitorPriorityLevel() As String ' Try ' CurrentAppOriginal = Process.GetCurrentProcess ' Select Case CurrentAppOriginal.PriorityClass ' Case ProcessPriorityClass.Idle ' lblGetPriority.Text = "STATUS: Priority = " & ProcessPriorityClass.Idle.ToString ' Case ProcessPriorityClass.BelowNormal ' lblGetPriority.Text = "STATUS: Priority = " & ProcessPriorityClass.BelowNormal.ToString ' Case ProcessPriorityClass.Normal ' lblGetPriority.Text = "STATUS: Priority = " & ProcessPriorityClass.Normal.ToString ' Case ProcessPriorityClass.AboveNormal ' lblGetPriority.Text = "STATUS: Priority = " & ProcessPriorityClass.AboveNormal.ToString ' Case ProcessPriorityClass.High ' lblGetPriority.Text = "STATUS: Priority = " & ProcessPriorityClass.High.ToString ' Case ProcessPriorityClass.RealTime ' lblGetPriority.Text = "STATUS: Priority = " & ProcessPriorityClass.RealTime.ToString ' End Select ' Catch ex As Exception ' MsgBox(ex.Message) ' End Try ' strfctn_MonitorPriorityLevel = lblGetPriority.Text 'End Function '' ########################################################### ' ########################################################### Private Sub Cbx_SingleDouble_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles Cbx_SingleDouble.CheckedChanged If Cbx_SingleDouble.Checked = True Then Cbx_SingleDouble.Text = "Double" btn_Send.Text = "Send Double" txt_AddressTwo.Visible = True txt_CommandTwo.Visible = True btnSearch.Visible = False ledTwo.Visible = False lblRepeat.Visible = False Else Cbx_SingleDouble.Text = "Single" btn_Send.Text = "Send Single" txt_AddressTwo.Visible = False txt_CommandTwo.Visible = False btnSearch.Visible = True ledTwo.Visible = True lblRepeat.Visible = True End If End Sub '' ########################################################### ' ########################################################### Private Sub Timer_DoubleTrigger_Tick(sender As System.Object, e As System.EventArgs) Handles Timer_DoubleTrigger.Tick Dim str_Cdefgh As String str_Cdefgh = strfctn_SendSingleMessage(str_DoubleAddress(i_DoubleTriggerCounter), str_DoubleCommand(i_DoubleTriggerCounter)) Timer_DoubleTrigger.Enabled = False End Sub '' ########################################################### ' ########################################################### End Class