frmmain.frm

PLC RS232通讯软体,

        For iY = 0 To iX
            If sResult <> "" Then                                               'Ignore Padding on First Byte
                If iY Mod 4 Then                                                'Pad Between Bytes
                    sResult = "    " & sResult
                Else
                    sResult = vbCrLf & sResult                                  'Start New Line After 4 Bytes
                End If
            End If
            bytElement = bytInput(iY)                                           'Get Single Byte Element
            sData = Chr$(bytElement)                                            'and Its Character
            For iL = 1 To 8                                                     'Iterate Each Bit of the Byte
                Select Case iL
                    Case 4                                                      'Comma Deliminate Each Digit
                        sSpace = " , "
                    Case Else
                        sSpace = ""
                End Select
                sResult = sSpace & Abs(CInt(BitOn(CLng(bytElement), iL))) & sResult
            Next
            If sResult <> "" Then
                If Asc(sData) = 0 Then                                          'Check and Replace Null
                    sData = "~"                                                 '~ Replaces Null, Change If Desired
                End If
                sResult = "(" & sData & ")> " & sResult
            End If
        Next
        txtRead.Text = sResult & vbCrLf
        cmdRead.Enabled = False
        lstHistory.AddItem ("Read " & sDataBits & " Bits" & " As " & sMode)     'Write Line To The History List
        Do While Len(sResult)                                                   'Parse Thru Result And Create History
            iP = InStrRev(sResult, "(", , vbBinaryCompare)
            sHistory = Replace(Trim(Mid$(sResult, iP)), vbCrLf, "", , , vbBinaryCompare)
            sResult = Left(sResult, (iP - 1))
            lstHistory.AddItem (sHistory & " :ASCII " & CStr(Asc(Mid$(sHistory, 2, 1))))
        Loop
        txtSend.SetFocus                                                        'Select Text In txtSnd Box
        txtSend.SelStart = 0
        txtSend.SelLength = Len(txtSend.Text)
        cmdClearHistory.Enabled = True                                          'Enable Clear History Button
    Exit Sub

ErrTrap:
        MsgBox Err.Number & " " & Err.Description & vbCr & " Error Generated By " & Err.Source, vbCritical, _
"System Error Trap !"
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Send Data That Is Displayed In The txtSend Box
'---------------------------------------------------------START---------------------------------------------------------
Private Sub cmdSend_Click()

On Error GoTo ErrTrap

        If comSerial.PortOpen = False Then
            comSerial.PortOpen = True
        End If
        comSerial.Output = txtSend.Text                                         'Write Line To The History List
        cmdRead.Enabled = True
        lstHistory.AddItem ("Send " & sDataBits & " Bits" & " As " & sMode)
        lstHistory.AddItem txtSend.Text
    Exit Sub

ErrTrap:
        MsgBox Err.Number & " " & Err.Description & vbCr & " Error Generated By " & Err.Source, vbCritical, _
"System Error Trap !"
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Get & Display Port Settings, Enable Option Button Click After Loaded(bLoaded = True)
'---------------------------------------------------------START---------------------------------------------------------
Private Sub Form_Load()
    Dim iX As Long
    Dim iY As Long
    Dim sTmp As String
    Dim sPort As String
    Dim sSelectedPort As String
    Dim bFlag As Boolean
    Dim opt As OptionButton

        VerifyPorts
        VerifySettings
        sSettings = comSerial.Settings
        sSelectedPort = comSerial.CommPort
        Select Case comSerial.InputMode
            Case comInputModeBinary
                optBinary.Value = True
                sMode = "Binary"
            Case comInputModeText
                optString.Value = True
                sMode = "String"
        End Select
        For iX = 0 To UBound(BaudRate())
            cmbBaudRate.AddItem BaudRate(iX)
        Next
        sTmp = Left$(sSettings, (InStr(1, sSettings, ",", vbBinaryCompare) - 1))
        sDataBits = Left$(Right$(sSettings, 3), 1)
        optDataBits(CInt(sDataBits)).Value = True
        cmbBaudRate.Text = sTmp
        
        iY = UBound(Ports)
        For iX = 0 To iY                                                        'Enable The Approriate Option Buttons
            sPort = Ports(iX)
            optPort(iX).Visible = True
            optPort(iX).Caption = sPort
            If sPort = sSelectedPort Then
                bFlag = True
                optPort(iX).Value = True
            End If
        Next
        If Not bFlag Then                                                       ' If Port Doesn't Exist Use 1st One
            comSerial.CommPort = CInt(optPort(0).Caption)
            optPort(0).Value = True
        End If
        bLoaded = True
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Switch Port Mode To Binary
'---------------------------------------------------------START---------------------------------------------------------
Private Sub optBinary_Click()
        If bLoaded Then
            comSerial.InputMode = comInputModeBinary
            sMode = "Binary"
        End If
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Switch Port Data Bits To Selected Option
'---------------------------------------------------------START---------------------------------------------------------
Private Sub optDataBits_Click(Index As Integer)
    Dim sTmp As String

On Error GoTo ErrTrap

        If bLoaded Then
            sTmp = comSerial.Settings
            Mid(sTmp, (Len(sTmp) - 2), 1) = CStr(Index)
            sDataBits = CStr(Index)
            comSerial.Settings = sTmp
            UpdateSettings
        End If
    Exit Sub

ErrTrap:
        MsgBox Err.Number & " " & Err.Description & vbCr & " Error Generated By " & Err.Source, vbCritical, _
"System Error Trap !"
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Change The Comm Port
'---------------------------------------------------------START---------------------------------------------------------
Private Sub optPort_Click(Index As Integer)
        If bLoaded Then
            comSerial.CommPort = CInt(optPort(Index).Caption)
            UpdateSettings
        End If
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Switch Port Mode To String
'---------------------------------------------------------START---------------------------------------------------------
Private Sub optString_Click()
        If bLoaded Then
            comSerial.InputMode = comInputModeText
            sMode = "String"
        End If
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Disable cmdSend Button When The txtSend Box Is Empty
'---------------------------------------------------------START---------------------------------------------------------
Private Sub txtSend_Change()
    If txtSend.Text <> "" Then
        cmdSend.Enabled = True
    Else
        cmdSend.Enabled = False
    End If
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Clear History List Box
'---------------------------------------------------------START---------------------------------------------------------
Private Sub cmdClearHistory_Click()
    lstHistory.Clear
    cmdClearHistory.Enabled = False
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Select All Text in txtSend Box
'---------------------------------------------------------START---------------------------------------------------------
Private Sub txtSend_GotFocus()
        txtSend.SelStart = 0
        txtSend.SelLength = Len(txtSend.Text)
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Check The Registy For The Last Used Settings And Sets The MSComm Object Properties. If There Is No Entry It Creates
'One With The Default Setting(Com1 38400n,8,1)
'---------------------------------------------------------START---------------------------------------------------------
Private Sub VerifySettings()
Attribute VerifySettings.VB_Description = "Checks the registry for the last com port settings"
    Dim disposition As Long
    Dim sTmp As String

On Error GoTo ErrTrap

        sSettings = comSerial.Settings
        sPortNum = comSerial.CommPort
        sSubKey = "Software\Damage Inc\Com Settings"
        If RegOpenKeyEx(lMainKey, sSubKey, 0, KEY_READ, hnd) Then
            If RegCreateKeyEx(lMainKey, sSubKey, 0, 0, 0, 0, 0, hnd, disposition) Then
                Err.Raise 1001, "VerifySettings() Sub", "Could Not Create Registry Key"
            End If
        End If

'The Key Has Been Found/or Created, Now Check To See If Previous Settings Are Present

'Check For The Settings Subkey and Retrieve Value If Present, Then Set ComPort 'Settings' Property

        sKeyValue = Space$(lLength)                                             'Pad The sKeyValue Variable
        If RegQueryValueEx(hnd, sSettingsKey, 0, REG_SZ, ByVal sKeyValue, lLength) Then     '0 Return if Successful
            If RegOpenKeyEx(lMainKey, sSubKey, 0, KEY_WRITE, hnd) Then                      '0 Return if Successful
                Err.Raise 1001, "VerifySettings() Sub", "Could Not Open Registry Key"
            Else        'The Value Was Not Present, Set To Default Port 'Settings' Property
                If RegSetValueEx(hnd, sSettingsKey, 0, REG_SZ, ByVal sSettings, Len(sSettings)) Then
                    Err.Raise 1001, "VerifySettings() Sub", "Could Not Set Registry Key Settings Value"
                End If
            End If
        Else            'Read Value From Key And Set The Port 'Settings' Property To The Value In The Registry
            comSerial.Settings = sKeyValue
        End If

'Check For The Port Subkey and Retrieve Value If Present, Then Set ComPort 'Port' Property

        sKeyValue = Space$(lLength)                                             'Pad The sKeyValue Variable
        If RegQueryValueEx(hnd, sPortKey, 0, REG_SZ, ByVal sKeyValue, lLength) Then         '0 Return if Successful
            If RegOpenKeyEx(lMainKey, sSubKey, 0, KEY_WRITE, hnd) Then                      '0 Return if Successful
                Err.Raise 1001, "VerifySettings() Sub", "Could Not Open Registry Key"
            Else        'The Value Was Not Present, Set To Default Port 'Port' Property
                If RegSetValueEx(hnd, sPortKey, 0, REG_SZ, ByVal sPortNum, Len(sPortNum)) Then
                    Err.Raise 1001, "VerifySettings() Sub", "Could Not Set Registry Key Port Value"
                End If
            End If
        Else            'Read Value From Key And Set The Port 'Port' Property To The Value In The Registry
            comSerial.CommPort = sKeyValue
        End If

        RegCloseKey hnd
    Exit Sub

ErrTrap:
        MsgBox Err.Number & " " & Err.Description & vbCr & " Error Generated By " & Err.Source, vbCritical, _
"System Error Trap !"
End Sub
'----------------------------------------------------------END----------------------------------------------------------
'Changes The Registry Entries When The User Changes Port Settings
'---------------------------------------------------------START---------------------------------------------------------
Private Sub UpdateSettings()
Attribute UpdateSettings.VB_Description = "Updates the registry entry to the current com port settings"

On Error GoTo ErrTrap

        sSettings = comSerial.Settings
        sPortNum = comSerial.CommPort
        sSubKey = "Software\Damage Inc\Com Settings"

            If RegOpenKeyEx(lMainKey, sSubKey, 0, KEY_WRITE, hnd) Then                      '0 Return if Successful
                Err.Raise 1001, "VerifySettings() Sub", "Could Not Open Registry Key"
            Else        'The Value Was Not Present, Set To Default Port 'Settings' Property
                If RegSetValueEx(hnd, sSettingsKey, 0, REG_SZ, ByVal sSettings, Len(sSettings)) Then
                    Err.Raise 1001, "VerifySettings() Sub", "Could Not Set Registry Key Settings Value"
                End If
            End If

            If RegOpenKeyEx(lMainKey, sSubKey, 0, KEY_WRITE, hnd) Then                      '0 Return if Successful
                Err.Raise 1001, "VerifySettings() Sub", "Could Not Open Registry Key"
            Else        'The Value Was Not Present, Set To Default Port 'Port' Property
                If RegSetValueEx(hnd, sPortKey, 0, REG_SZ, ByVal sPortNum, Len(sPortNum)) Then
                    Err.Raise 1001, "VerifySettings() Sub", "Could Not Set Registry Key Port Value"
                End If
            End If

    Exit Sub

ErrTrap:
        MsgBox Err.Number & " " & Err.Description & vbCr & " Error Generated By " & Err.Source, vbCritical, _
"System Error Trap !"
End Sub
'----------------------------------------------------------END----------------------------------------------------------