[RESOLVED] No Mscomm receive USB 16 Channel Relay Module - RS232 Controlled

[planethax]

This will be a tough one.
Mainly due to the fact not many people have this hardware

http://cgi.ebay.ca/ws/eBayISAPI.dll?...m=180537743599

I have made a simple app to control relays, this part works,
sending 01+// turns relay 1 ON 01-// turns relay 1 OFF

my problems is sending
ask// should send me a 2 byte reply
Example:

* answer 1: 00 -> relays from 1 to 16 are OFF.
* answer 2: 255(dec) 255(dec) -> relays from 1 to 16 are ON.
* answer 3: 81(dec) 81(dec) -> Relays 1,8,9,16 - ON, the rest are OFF.
But no matter what I try I can not get the reply.

I attach my app, hopefully (probably) a simple error I have overlooked.

Code is a bit messy as I have been cutting and chopping to get it too work.

here is the info on commands (from the ebay page)

    * Communication parameters - 8 Data, 1 Stop, No Parity, Baud Rate - 9600 bps
    * Command for receiving the relays status:
          o Send "ask//".
          o The answer is two bytes - byte 1 and byte 2. Byte 1 represents relays from 1 to 8. MSB of byte 1 is Relay 1 and LSB of byte 1 is Relay 8. Byte 2 represents relays from 9 to 16. MSB of byte 2 is Relay 10 and LSB of byte 2 is Relay 16.
          o Example:
                + answer 1: 00 -> relays from 1 to 16 are OFF.
                + answer 2: 255(dec) 255(dec) -> relays from 1 to 16 are ON.
                + answer 3: 81(dec) 81(dec) -> Relays 1,8,9,16 - ON, the rest are OFF.
    * Commands for single relay setting:
          o "01+//" - Relay 1 is switched ON
          o "01-//" - Relay 1 is switched OFF
          o "02+//" - Relay 2 is switched ON
          o "02-//" - Relay 2 is switched OFF
          o ......
          o ......
          o "16+//" - Relay 16 is switched ON
          o "16-//" - Relay 16 is switched OFF
    * Commands for all relays setting:
          o "on//" - All relays are switched ON
          o "off//" - All relays are switched OFF
    * Command for many relays setting
      Send sequentially:
      "x" - as a char
      a - as HEX number. a[0;FF]. This number correspondends with relays from 1 to 8. The MSB is relay 1.
      b - as HEX number. b[0;FF]. This number correspondends with relays from 9 to 16. The MSB is relay 9.
      "/" - as a char. This is the first part of the delimiter
      "/" - as a char. This is the second part of the delimiter
      Example (a=1A(hex) and b= 05(hex) )
      "x" 1A 05 "/" "/"
      1A(hex)=00011010(bin)
      05(hex)=00000101(bin)
      Relays 1,2,3,6,8,9,10,11,12,13,15 - switched OFF
      Relays 4,5,7,14,16 - switched ON

      Note that there must be minimum 5ms interval between each two commands !

Any thing I missed please ask.

[planethax]

Oh, this is basically what my form looks like ATM
( I added a timer and pause to see if it helped but didnt )
There is also a ModCom module that listed the available comports
(not using at this particular point, thought it may be causing an issue)

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim MyStrg As String

Private Sub cmdAsk_Click()
MSComm1.Output = "ask//" & vbCrLf
If (MSComm1.CommEvent = comEvReceive) Then

    Attente (10)
        
           MyStrg = MSComm1.Input
            MsgBox MyStrg
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf

End If
End Sub

Private Sub cmdConect_Click()
MSComm1.CommPort = cboComm
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    'set the badurate,parity,databits,stopbits for the connection
    MSComm1.Settings = "9600,N,8,1"
    'set the DRT and RTS flags
    MSComm1.DTREnable = True
    MSComm1.RTSEnable = True
        MSComm1.InputLen = 0 ' Read entire buffer when Input
    'enable the oncomm event for every reveived character
    MSComm1.RThreshold = 1
    'disable the oncomm event for send characters
    MSComm1.SThreshold = 0
    MSComm1.PortOpen = True ' Open port
End Sub



Private Sub cmdRelay1_Click()
MSComm1.Output = "01+//" & vbCrLf
If (MSComm1.CommEvent = comEvReceive) Then
 

        
           MyStrg = MSComm1.Input
            
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf

End If


End Sub

Private Sub Command2_Click()
MSComm1.Output = "01-//" & vbCrLf
If (MSComm1.CommEvent = comEvReceive) Then
 

        
           MyStrg = MSComm1.Input
            
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
End If
End Sub

Private Sub cmdOff_Click()
MSComm1.Output = "off//" ' & vbCrLf
If (MSComm1.CommEvent = comEvReceive) Then
 
      ' Attente (50)
        
           MyStrg = MSComm1.Input
            
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf

End If
End Sub


Private Sub cmdOn_Click()
MSComm1.Output = "on//" ' & vbCrLf
If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (5)
        
           MyStrg = MSComm1.Input
            
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf

End If

End Sub



Private Sub Command3_Click()
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False

End Sub

Private Sub Form_Load()
' ListComPorts
cboComm.Text = "7"
End Sub

Private Sub ListComPorts()
Dim i As Integer

cboComm.Clear
For i = 1 To 16
If COMAvailable(i) Then
cboComm.AddItem i
End If
Next
If cboComm.ListCount > 0 Then
cboComm.ListIndex = 0

Else
MsgBox "No Com Ports Installed on this computer"

End If


End Sub
Public Sub Attente(ByVal MilsecToWait As Long)
    Dim lngEndingTime As Long
    lngEndingTime = GetTickCount() + (MilsecToWait)
    Do While GetTickCount() < lngEndingTime
        DoEvents
    Loop
End Sub

[OLA Steve]

Hello,
In the past I've had to use a timer object to 'pull' the data from the Input buffer periodically as the OnComm event may not fire especially if certain flags aren't set on the comm port.

Using a timer, try reading the Input buffer over and over, outputting any data to a text box or string that you desire.

Hope this helps,

[planethax]

Hello,
In the past I've had to use a timer object to 'pull' the data from the Input buffer periodically as the OnComm event may not fire especially if certain flags aren't set on the comm port.

Using a timer, try reading the Input buffer over and over, outputting any data to a text box or string that you desire.

Hope this helps,

I think your right, as for first time I started getting some receive, but it was a jumbled mix up previous commands.

Can you should me an example of what you mean?
Not quite sure how to go about it.

[OLA Steve]

I'm going to try this from memory, so this could be wrong, but try this.

Private Sub tmrGetData_Timer()
    
    Dim strData As String
    
    '// See if there is anything in the input buffer
    If MSComm1.InputLen > 0 Then
    
        '// Pull the data out of the Input buffer
        strData = MSComm1.Input
        
        '// Put the data down to the text box
        Text1.Text = Text1.Text & strData
        
    End If
    
End Sub

Place in a timer at 100ms or 500ms and start there. You may be able to decrease the Interval even lower if you need to.

[planethax]

I must be overlooking something.
Maybe not set the com control correctly?
This should be a simple 5 minute app lol but been at it for 15 hours

This is the actual company for board.
I am not getting any reply from them yet
http://denkovi.com/product/31/usb-16...12v-ver-1.html

Latest project, have it 90% finish except for this checking, I need to make sure relay is on or off.
Hope its not cheap buggy firmware

[Doogle]

For some reason I can't read your attachments in VB6 (EDIT: Resolved - finger trouble)

I think your problem stems from the way you are attempting to read the input from the device. I would use the OnComm event which will trigger when at least 1 byte has been received (since RThreshold = 1). This will simplify your code and do away with the need for any timers. From what I can see, you will also need to 'decode' the data received to determine the state of each relay.

The code below contains some code to service the OnComm event (comEvReceive) and includes a decode subroutine. It's not fully tested so there may be a few bugs

Option Explicit

Private Sub cmdAsk_Click()
MSComm1.Output = "ask//" & vbCrLf
End Sub

Private Sub cmdConect_Click()
MSComm1.CommPort = cboComm
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    'set the badurate,parity,databits,stopbits for the connection
    MSComm1.Settings = "9600,N,8,1"
    'set the DRT and RTS flags
    MSComm1.DTREnable = True
    MSComm1.RTSEnable = True
        MSComm1.InputLen = 0 ' Read entire buffer when Input
    'enable the oncomm event for every reveived character
    MSComm1.RThreshold = 1
    'disable the oncomm event for send characters
    MSComm1.SThreshold = 0
    MSComm1.PortOpen = True ' Open port
End Sub

Private Sub cmdRelay1_Click()
MSComm1.Output = "01+//" & vbCrLf
End Sub

Private Sub Command2_Click()
MSComm1.Output = "01-//" & vbCrLf
End Sub

Private Sub cmdOff_Click()
MSComm1.Output = "off//" ' & vbCrLf
End Sub


Private Sub cmdOn_Click()
MSComm1.Output = "on//" ' & vbCrLf
End Sub

Private Sub Command3_Click()
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub

Private Sub Form_Load()
' ListComPorts
cboComm.Text = "7"
End Sub

Private Sub ListComPorts()
Dim i As Integer
cboComm.Clear
For i = 1 To 16
    If COMAvailable(i) Then
        cboComm.AddItem i
    End If
Next
If cboComm.ListCount > 0 Then
    cboComm.ListIndex = 0
Else
    MsgBox "No Com Ports Installed on this computer"
End If
End Sub

Private Sub MSComm1_OnComm()
Static strBuffer As String
Dim strData As String
Dim strReceived As String
Dim intPos As Integer
Dim boComplete As Boolean
Select Case MSComm1.CommEvent
    Case comEvReceive
    '
    ' Something has been received
    ' Read it and add it to the Buffer
    '
        strData = MSComm1.Input
        strBuffer = strBuffer & strData
        Do
            '
            ' Has a complete record been received yet ?
            '
            intPos = InStr(strBuffer, "//")
            If intPos > 0 Then
                '
                ' Yes, unblock and decode
                '
                strReceived = Mid$(strBuffer, 1, intPos + 1)
                Call DeCode(strReceived)
                '
                ' Is there anything else in the Buffer ?
                '
                If intPos + 2 < Len(strBuffer) Then
                    '
                    ' Yes, move it to the front and go round the loop
                    '
                    strBuffer = Mid$(strBuffer, intPos + 2)
                Else
                    '
                    ' No, flush the buffer and signal to exit the loop
                    '
                    strBuffer = ""
                    boComplete = True
                End If
            Else
                '
                ' Not received a complete record yet
                ' exit and wait for the next comEvReceive event
                '
                boComplete = True
            End If
        Loop Until boComplete = True
End Select
End Sub

Private Sub DeCode(strData As String)
'
' Decode the first two bytes
' and output the state of each Relay
'
Dim bytRelay As Byte
Dim intI As Integer
Dim intJ As Integer
Dim intK As Integer
lstconnection.Text = ""
intK = 1
For intI = 1 To 2
    bytRelay = Asc(Mid$(strData, intI, 1))
    For intJ = 7 To 0 Step -1
        If (bytRelay And CByte(2 ^ intJ)) = CByte(2 ^ intJ) Then
            lstconnection.Text = lstconnection.Text & _
                "Relay " & CStr(intK) & " is ON" & vbCrLf
        Else
            lstconnection.Text = lstconnection.Text & _
                "Relay " & CStr(intK) & " is OFF" & vbCrLf
        End If
        intK = intK + 1
    Next intJ
Next intI
End Sub

EDIT: I am assuming that lstconnection is a multi-line TextBox and that the device is not sending a trailing vbCrLf pair.

[planethax]

Thanx, I have tried that, just seems I am am not receiving anything,
I have even put msgbox all over the place to try and catch some data.
I am able to send fine, can turn all or 1 relay on and off, just not receiving.

From what I have read I beleive my mscomm settings are correct.

On chip manuf site I did find a .bas module, not sure if it is usefull for me or not?

Option Explicit
 
Public fMainForm As DEMO_EEPROM
'===========================
'CLASSIC INTERFACE
'===========================
Public Declare Function FT_ListDevices Lib "FTD2XX.DLL" (ByVal arg1 As Long, ByVal arg2 As String, ByVal dwFlags As Long) As Long
Public Declare Function FT_GetNumDevices Lib "FTD2XX.DLL" Alias "FT_ListDevices" (ByRef arg1 As Long, ByVal arg2 As String, ByVal dwFlags As Long) As Long
 
Public Declare Function FT_Open Lib "FTD2XX.DLL" (ByVal intDeviceNumber As Integer, ByRef lngHandle As Long) As Long
Public Declare Function FT_OpenEx Lib "FTD2XX.DLL" (ByVal arg1 As String, ByVal arg2 As Long, ByRef lngHandle As Long) As Long
Public Declare Function FT_Close Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_Read Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lpszBuffer As String, ByVal lngBufferSize As Long, ByRef lngBytesReturned As Long) As Long
Public Declare Function FT_Write Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lpszBuffer As String, ByVal lngBufferSize As Long, ByRef lngBytesWritten As Long) As Long
Public Declare Function FT_WriteByte Lib "FTD2XX.DLL" Alias "FT_Write" (ByVal lngHandle As Long, ByRef lpszBuffer As Any, ByVal lngBufferSize As Long, ByRef lngBytesWritten As Long) As Long
Public Declare Function FT_SetBaudRate Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lngBaudRate As Long) As Long
Public Declare Function FT_SetDataCharacteristics Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal byWordLength As Byte, ByVal byStopBits As Byte, ByVal byParity As Byte) As Long
Public Declare Function FT_SetFlowControl Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal intFlowControl As Integer, ByVal byXonChar As Byte, ByVal byXoffChar As Byte) As Long
Public Declare Function FT_SetDtr Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_ClrDtr Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_SetRts Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_ClrRts Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_GetModemStatus Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lngModemStatus As Long) As Long
Public Declare Function FT_SetChars Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal byEventChar As Byte, ByVal byEventCharEnabled As Byte, ByVal byErrorChar As Byte, ByVal byErrorCharEnabled As Byte) As Long
Public Declare Function FT_Purge Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lngMask As Long) As Long
Public Declare Function FT_SetTimeouts Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lngReadTimeout As Long, ByVal lngWriteTimeout As Long) As Long
Public Declare Function FT_GetQueueStatus Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lngRxBytes As Long) As Long
Public Declare Function FT_SetBreakOn Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_SetBreakOff Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
Public Declare Function FT_GetStatus Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lngRxBytes As Long, ByRef lngTxBytes As Long, ByRef lngEventsDWord As Long) As Long
Public Declare Function FT_SetEventNotification Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal dwEventMask As Long, ByVal pVoid As Long) As Long
Public Declare Function FT_ResetDevice Lib "FTD2XX.DLL" (ByVal lngHandle As Long) As Long
'Public Declare Function FT_SetDivisor Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal shDivisor) As Short
 
'Public Declare Function FT_GetEventStatus Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lngEventsDWord As Long) As Long
 
 Public Declare Function FT_GetBitMode Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef intData As Any) As Long
 Public Declare Function FT_SetBitMode Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal intMask As Byte, ByVal intMode As Byte) As Long
 
Public Declare Function FT_SetLatencyTimer Lib "FTD2XX.DLL" (ByVal Handle As Long, ByVal pucTimer As Byte) As Long
Public Declare Function FT_GetLatencyTimer Lib "FTD2XX.DLL" (ByVal Handle As Long, ByRef ucTimer As Long) As Long
 
 
'=============================
'FT_W32 API
'=============================
 
Public Declare Function FT_W32_CreateFile Lib "FTD2XX.DLL" (ByVal lpszName As String, ByVal dwAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As LPSECURITY_ATTRIBUTES, ByVal dwCreate As Long, ByVal dwAttrsAndFlags As Long, ByVal hTemplate As Long) As Long
Public Declare Function FT_W32_CloseHandle Lib "FTD2XX.DLL" (ByVal ftHandle As Long) As Long
Public Declare Function FT_W32_ReadFile Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lpszBuffer As String, ByVal lngBufferSize As Long, ByRef lngBytesReturned As Long, ByRef lpftOverlapped As lpOverlapped) As Long
Public Declare Function FT_W32_WriteFile Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal lpszBuffer As String, ByVal lngBufferSize As Long, ByRef lngBytesWritten As Long, ByRef lpftOverlapped As lpOverlapped) As Long
Public Declare Function FT_W32_GetOverlappedResult Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lpftOverlapped As lpOverlapped, ByRef lpdwBytesTransferred As Long, ByVal bWait As Boolean) As Long
Public Declare Function FT_W32_GetCommState Lib "FTD2XX.DLL" (ByVal lngHandle, ByRef lpftDCB As FTDCB) As Long
Public Declare Function FT_W32_SetCommState Lib "FTD2XX.DLL" (ByVal lngHandle, ByRef lpftDCB As FTDCB) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Public Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function SetEvent Lib "kernel32" (ByVal hHandle As Long) As Long
Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
'====================================================================
'APIGID32.DLL by DESAWARE Inc. (www.desaware.com), see Dan Appleman's
'"Visual Basic Programmer's Guide to the WIN32-API"; here used to get
'the addresses of the VB-bytearrays:
'====================================================================
Public Declare Function agGetAddressForObject& Lib "apigid32.dll" (object As Any)

first half of module

[planethax]

second half of module

'==============================================================
'Declarations for the EEPROM-accessing functions in FTD2XX.dll:
'==============================================================
Public Declare Function FT_EE_Program Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lpData As FT_PROGRAM_DATA) As Long
Public Declare Function FT_EE_Read Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lpData As FT_PROGRAM_DATA) As Long
Public Declare Function FT_EE_UASize Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByRef lpdwSize As Long) As Long
Public Declare Function FT_EE_UAWrite Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal pucData As String, ByVal dwDataLen As Long) As Long
Public Declare Function FT_EE_UARead Lib "FTD2XX.DLL" (ByVal lngHandle As Long, ByVal pucData As String, ByVal dwDataLen As Long, ByRef lpdwBytesRead As Long) As Long
 
Public Type LPSECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
 
Public Type lpOverlapped
  Internal As Long
  InternalHigh As Long
  Offset As Long
  OffsetHigh As Long
  hEvent As Long
End Type
 
Public Type FTDCB
    DCBlength As Long                   'sizeof (FTDCB)
    BaudRate As Long                    '9600
'    fBinary As Long                     '= 1 Binary mode (skip EOF check)
'    fParity As Long                     '= 1 Enable parity checking
'    fOutxCtsFlow As Long                '= 1 CTS handshaking on output
'    fOutxDsrFlow As Long                '= 1 DSR handshaking on output
'    fDtrControl As Long                 '= 2 DTR flow control
'    fDsrSensitivity As Long             '= 1 DSR Sensitivity
'    fTXContinueOnXoff As Long           '= 1 Continue TX when Xoff sent
'    fOutX As Long                       '= 1 Enable output X-on/X-off
'    fInX As Long                        '= 1 Enable input X-on/X-off
'    fErrorChar As Long                  '= 1 Enable error replacement
'    fNull As Long                       '= 1 Enable null stripping
'    fRtsControl As Long                 '= 2 RTS flow control
'    fAbortOnError As Long               '= 1 Abort all reads and writes on error
'    fDummy2 As Long                     '= 17 Reserved
'    wReserved As Integer                'Not currently used
'    XonLim As Integer                   'Transmit X-on threshold
'    XoffLim As Integer                  'Transmit X-off threshold
'    ByteSize As Byte                    'Number of bits/ byte, 7-8
'    Parity As Byte                      '0-4= None, Odd, Even, Mark, Space
'    StopBits As Byte                    '0, 2 = 1, 2
'    XonChar As Byte                     'TX and RX X-ON character
'    XoffChar As Byte                    'TX and RX X-OFF character
'    ErrorChar As Byte                   'Eror replacement char
'    EofChar As Byte                     'End of input Character
'    EvtChar As Byte                     'Received event character
'    wReserved1 As Integer               'BCD (0x0200 => USB2)
End Type
 
 
 
'====================================================================
'Type definition as equivalent for C-structure "ft_program_data" used
'in FT_EE_READ and FT_EE_WRITE;
'ATTENTION! The variables "Manufacturer", "ManufacturerID",
'"Description" and "SerialNumber" are passed as POINTERS to
'locations of Bytearrays. Each Byte in these arrays will be
'filled with one character of the whole string.
'(See below, calls to "agGetAddressForObject")
'=====================================================================
 
 
Public Type FT_PROGRAM_DATA
 
    signature1 As Long                  '0x00000000
    signature2 As Long                  '0xFFFFFFFF
    version As Long                     '0
 
    VendorId As Integer                 '0x0403
    ProductId As Integer                '0x6001
    Manufacturer As Long                '32 "FTDI"
    ManufacturerId As Long              '16 "FT"
    Description As Long                 '64 "USB HS Serial Converter"
    SerialNumber As Long                '16 "FT000001" if fixed, or NULL
    MaxPower As Integer                 ' // 0 < MaxPower <= 500
    PnP As Integer                      ' // 0 = disabled, 1 = enabled
    SelfPowered As Integer              ' // 0 = bus powered, 1 = self powered
    RemoteWakeup As Integer             ' // 0 = not capable, 1 = capable
     'Rev4 extensions:
    Rev4 As Byte                        ' // true if Rev4 chip, false otherwise
    IsoIn As Byte                       ' // true if in endpoint is isochronous
    IsoOut As Byte                      ' // true if out endpoint is isochronous
    PullDownEnable As Byte              ' // true if pull down enabled
    SerNumEnable As Byte                ' // true if serial number to be used
    USBVersionEnable As Byte            ' // true if chip uses USBVersion
    USBVersion As Integer               ' // BCD (0x0200 => USB2)
    'FT2232C extensions:
    Rev5 As Byte                        'non-zero if Rev5 chip, zero otherwise
    IsoInA As Byte                      'non-zero if in endpoint is isochronous
    IsoInB As Byte                      'non-zero if in endpoint is isochronous
    IsoOutA As Byte                     'non-zero if out endpoint is isochronous
    IsoOutB As Byte                     'non-zero if out endpoint is isochronous
    PullDownEnable5 As Byte             'non-zero if pull down enabled
    SerNumEnable5 As Byte               'non-zero if serial number to be used
    USBVersionEnable5 As Byte           'non-zero if chip uses USBVersion
    USBVersion5 As Integer              'BCD 0x110 = USB 1.1, BCD 0x200 = USB 2.0
    AlsHighCurrent As Byte              'non-zero if interface is high current
    BlsHighCurrent As Byte              'non-zero if interface is high current
    IFAlsFifo As Byte                   'non-zero if interface is 245 FIFO
    IFAlsFifoTar As Byte                'non-zero if interface is 245 FIFO CPU target
    IFAlsFastSer As Byte                'non-zero if interface is Fast Serial
    AlsVCP As Byte                      'non-zero if interface is to use VCP drivers
    IFBlsFifo As Byte                   'non-zero if interface is 245 FIFO
    IFBlsFifoTar As Byte                'non-zero if interface is 245 FIFO CPU target
    IFBlsFastSer As Byte                'non-zero if interface is Fast Serial
    BlsVCP As Byte                      'non-zero if interface is to use VCP drivers
    'FT232R extensions
    UseExtOSC As Byte                   'non-zero use ext osc
    HighDriveIOs As Byte                'non-zero to use High Drive IO's
    EndPointSize As Byte                '64 Do not change
    PullDownEnableR As Byte             'non-zeero if pull down enabled
    SerNumEnableR As Byte               'non-zero if pull serial number enabled
    InvertTXD As Byte                   'non-zero if invert TXD
    InvertRXD As Byte                   'non-zero if invert RXD
    InvertRTS As Byte                   'non-zero if invert RTS
    InvertCTS As Byte                   'non-zero if invert CTS
    InvertDTR As Byte                   'non-zero if invert DTR
    InvertDSR As Byte                   'non-zero if invert DSR
    InvertDCD As Byte                   'non-zero if invert DCD
    InvertRI As Byte                    'non-zero if invert RI
    Cbus0 As Byte                       'Cbus Mux control
    Cbus1 As Byte                       'Cbus Mux control
    Cbus2 As Byte                       'Cbus Mux control
    Cbus3 As Byte                       'Cbus Mux control
    Cbus4 As Byte                       'Cbus Mux control
    RIsVCP As Byte                      'non-zero if using VCP driver
    
    
End Type
 
 
 
' Return codes
Public Const FT_OK = 0
Public Const FT_INVALID_HANDLE = 1
Public Const FT_DEVICE_NOT_FOUND = 2
Public Const FT_DEVICE_NOT_OPENED = 3
Public Const FT_IO_ERROR = 4
Public Const FT_INSUFFICIENT_RESOURCES = 5
Public Const FT_INVALID_PARAMETER = 6
Public Const FT_INVALID_BAUD_RATE = 7
Public Const FT_DEVICE_NOT_OPENED_FOR_ERASE = 8
Public Const FT_DEVICE_NOT_OPENED_FOR_WRITE = 9
Public Const FT_FAILED_TO_WRITE_DEVICE = 10
Public Const FT_EEPROM_READ_FAILED = 11
Public Const FT_EEPROM_WRITE_FAILED = 12
Public Const FT_EEPROM_ERASE_FAILED = 13
Public Const FT_EEPROM_NOT_PRESENT = 14
Public Const FT_EEPROM_NOT_PROGRAMMED = 15
Public Const FT_INVALID_ARGS = 16
Public Const FT_NOT_SUPPORTED = 17
Public Const FT_OTHER_ERROR = 18
 
' Word Lengths
Public Const FT_BITS_8 = 8
Public Const FT_BITS_7 = 7
 
' Stop Bits
Public Const FT_STOP_BITS_1 = 0
Public Const FT_STOP_BITS_1_5 = 1
Public Const FT_STOP_BITS_2 = 2
 
' Parity
Public Const FT_PARITY_NONE = 0
Public Const FT_PARITY_ODD = 1
Public Const FT_PARITY_EVEN = 2
Public Const FT_PARITY_MARK = 3
Public Const FT_PARITY_SPACE = 4
 
' Flow Control
Public Const FT_FLOW_NONE = &H0
Public Const FT_FLOW_RTS_CTS = &H100
Public Const FT_FLOW_DTR_DSR = &H200
Public Const FT_FLOW_XON_XOFF = &H400
 
' Purge rx and tx buffers
Public Const FT_PURGE_RX = 1
Public Const FT_PURGE_TX = 2
 
' Modem Status
Public Const FT_MODEM_STATUS_CTS = &H10
Public Const FT_MODEM_STATUS_DSR = &H20
Public Const FT_MODEM_STATUS_RI = &H40
Public Const FT_MODEM_STATUS_DCD = &H80
 
Public Const FT_EVENT_RXCHAR As Long = 1
Public Const FT_EVENT_MODEM_STATUS = 2
 
Const WAIT_ABANDONED As Long = &H80
Const WAIT_FAILD As Long = &HFFFFFFFF
Const WAIT_OBJECT_0 As Long = &H0
Const WAIT_TIMEOUT As Long = &H102
 
' Flags for FT_ListDevices
Public Const FT_LIST_BY_NUMBER_ONLY = &H80000000
Public Const FT_LIST_BY_INDEX = &H40000000
Public Const FT_LIST_ALL = &H20000000
 
' Flags for FT_OpenEx
Public Const FT_OPEN_BY_SERIAL_NUMBER = 1
Public Const FT_OPEN_BY_DESCRIPTION = 2
 
 
Private Const INFINITE As Long = 1000   '&HFFFFFFFF
 
Global hThread As Long
Global hThreadID As Long
Global hEvent As Long
Global EventMask As Long
 
Global lngHandle As Long
 
    
 
Sub Main()
    Set fMainForm = New DEMO_EEPROM
    fMainForm.Show
End Sub

[OLA Steve]

Just an FYI,
If you've got a budget, I would recommend Eltima's Serial Port ActiveX control, it is very easy to use in contrast to using API access.

It is here http://www.eltima.com/products/serial-activex/

[DickGrier]

Have you tried simply using HypterTerminal (or similar) to send the ask command to see if you receive anything? Perhaps there is a communications problem that has nothing to do with your code.

Your code will not work, as written. MSComm is not the problem. However, the other suggestions that you have received will get you closer. But, this sort of protocol (IMO, with lots of experience) lends itself best to using a simple loop to receive data. If you use either a Timer or OnComm receive processing, either of which will work, you add extra work. Here is what I'd do. Write a function that takes the "ask" command as an argument, sends it, then waits for a two-byte response -- or a timeout. Example (air code, so you may have to do some debugging):

Private Function SendAndWait(Command As String, ByRef Return1 As Byte, ByRef Return2 As Byte) As Boolean
    Dim Timeout As Long
    Timeout = 2 + Timer 'this is simplest, though not perfect; this is two seconds
    MSComm1.Output = Command & vbCr   'you probably do not need vbCrLf, and if it is not needed, the Lf may cause trouble.
    Do Until Timer >= Timeout
       If MSComm1.InBufferCount > 1 Then   
            Dim Data As String
            Data = MSComm1.Input
            Return1 = Cbyte(Mid(Data, 1,1))
            Return2 = Cbyte(Mid(Data, 2,1))
            SendAndWait = True
       Else
            DoEvents
       End If
End Function

If you call this function and it times out, it will return False. If it returns True, then the Return1 and Return2 parameters will carry the reply data).

Dick

[prginocx]

You've got to find out everything this board is sending back, if there is anything at all.

I've used this:

'Use the comm event comEvReceive to read data whenever one
'character is received from the com port
If MSComm1.CommEvent = comEvReceive Then
'Append the character to the data text box
tbxRecd.Text = tbxRecd.Text + MSComm1.Input
End If

I've used this inside the MSComm1_OnComm() to just dump whatever to the text box,
that way you get an idea of what is going on...

Sometimes these simple IO pcbs just have "/" and vbCrLf or something coming back after
every command to say " Hey, 10-4 bud, I did the relay thing." Imagine if you wrote the code on the receiver side, you want to be terse 'cause you don't have much brainpower to work with. It is critical to understand EXACTLY what chars you send on command, and have the ASCII table right there to decode, then everything you DID NOT send, is the reply message. Make sense ?

Also, you've got to have:

MSComm1.RThreshold = 1 'Select 'event-driven' as the default method
MSComm1.SThreshold = 1

Then the On-Comm fires every single char received. Grab those chars and make hay.

also, you can step back and look at the big picture. Is there ANY other way to tell if the comm is working ? Any other feedback from this PCB ? Any to read a relay status ? If there is, why no use that to confirm comm is working.

[Doogle]

I think Dick has a point.

Looking at the protocol spec in your first post there's nothing saying you should terminate transmission with anything other than "//". I wonder if the vbCrLf is 'confusing' the device. Perhaps just sending "ask//" may give you a result.

[planethax]

I will look through some more, I have the seller trying to help but he doesnt know VB6, I am waiting to hear back from him.

This was the C source example he had.

//Global Variables
	 
  	
HANDLE hComm = NULL;
COMMTIMEOUTS ctmoNew = {0}, ctmoOld;
DCB dcbCommPort;
char InBuff[100];
char *a="COM1";
	 
  	
//Open the COM port
	 
  	

hComm = CreateFile(a,GENERIC_READ | GENERIC_WRITE,0,0,OPEN_EXISTING,0,0);
if(hComm == INVALID_HANDLE_VALUE){
....// IF the COM port can not be opened
}

// SET THE COMM TIMEOUTS.

GetCommTimeouts(hComm,&ctmoOld);
ctmoNew.ReadTotalTimeoutConstant = 100;
ctmoNew.ReadTotalTimeoutMultiplier = 0;
ctmoNew.WriteTotalTimeoutMultiplier = 0;
ctmoNew.WriteTotalTimeoutConstant = 0;
SetCommTimeouts(hComm, &ctmoNew);

// SET BAUD RATE, PARITY, WORD SIZE, AND STOP BITS.
// THERE ARE OTHER WAYS OF DOING SETTING THESE BUT THIS IS THE EASIEST.

dcbCommPort.DCBlength = sizeof(DCB);
GetCommState(hComm, &dcbCommPort);
BuildCommDCB("14400,N,8,1", &dcbCommPort);
SetCommState(hComm, &dcbCommPort);
	 
  	
//Send commands to COM port
	 
  	

TransmitCommChar(hComm, '0');
TransmitCommChar(hComm, '1');
TransmitCommChar(hComm, '+');
TransmitCommChar(hComm, '/');
TransmitCommChar(hComm, '/');


TransmitCommChar(hComm, 'x');
TransmitCommChar(hComm, 146);
TransmitCommChar(hComm, 60);
TransmitCommChar(hComm, '/');
TransmitCommChar(hComm, '/');
	 
  	
//Read the COM port
	 
  	

ReadFile(hComm, InBuff, 50, &dwBytesRead, NULL); //InBuff contains the COM received bytes
	 
  	
//Close safety the COM port
	 
  	
// IF A PORT WAS OPENED, CLOSE IT
if(hComm) {
Sleep(250); // WAIT FOR THREAD TO FINISH
SetCommTimeouts(hComm, &ctmoOld);
CloseHandle(hComm); }

[DickGrier]

This code example does not terminate the command with a carriage return (or linefeed). Thus, modify the code that I suggested by removing the vbCr.

The equivalent command to the one above should be:

Dim Command As String
String = "01+//x" & Chr(140) & Chr(60) & "//"

Then, MSComm1.Output = Command
'wait for reply

Dick

[planethax]

I have recieved the following character

€

That was with Relay 1 ON and the rest off (according to email I just received)
That character should have been -128

1) If relay 1 is ON, you get -128 or -128+256= 128(dec) or 10000000(bin)
2) If relay 1,2 are ON, you get -64 or -64+256=192(dec) or 11000000(bin)

[DickGrier]

The way that you can decode a binary character is:

TextBox1.Text = Val(Asc(mychar))

You cannot display it directly (this isn't an ASII text character).

The character that you are seeing depends on the font used for display. For example, the font MS Sans Serif will display just what you are seeing for the character value 128.... So, you are making progress!

[DickGrier]

BTW, binary 11000000 (relay 1 and 2 on) has a value of 192. Also, you can simply display it via

Text1.Text = Asc(myChar)

You don't really need the Val function.

Dick

[planethax]

WELL SOME Progress,
1, I have removed the vbCr
2, With Relay 1 and 2 on I GET 192!!!!!!!!!!

However I get it one command behind (everytime I click a button, I get the reply from the button before)

I will clean up the code and mess I have made and then check it again.

PROGRESS though! and I thank you ALL
REP!!!!!

[Doogle]

Glad you're making progress. Perhaps if you still have problems you can post your 'cleaned up' code, it doesn't sound like a major problem.

[planethax]

Yes, It is 100% better.
Only the "ask//" command sends the Bin replies, all others just echo what was sent.
Asc(myChar) would error on all EXCEPT "ask//" so I have gone back to my original way for now, will change afterwards as I do not need to see what was sent.

The issue I am having now is I ONLY get the first Byte of the "ask//" reply.

example, if no relays on I should get
0 0
but I only get
0
Same if they were all on, I should have 255 255 but only get 255

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim MyStrg As String

Private Sub cmdAsk_Click()
MSComm1.Output = "ask//"
If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           MyStrg = Asc(MyStrg)
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If
End Sub

Private Sub cmdConect_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    MSComm1.CommPort = cboComm
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    'set the badurate,parity,databits,stopbits for the connection
    MSComm1.Settings = "9600,N,8,1"
    'set the DRT and RTS flags
  '  MSComm1.DTREnable = True
  '  MSComm1.RTSEnable = True
        MSComm1.InputLen = 0 ' Read entire buffer when Input
    'enable the oncomm event for every reveived character
    MSComm1.RThreshold = 1
    'disable the oncomm event for send characters
    MSComm1.SThreshold = 0
    MSComm1.PortOpen = True ' Open port
    MSComm1.Output = "off//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If
End Sub



Private Sub cmdRelay1_Click()
If fStatus1.BackColor = &HFF& Then
MSComm1.Output = "01+//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If

fStatus1.BackColor = &HC000&
Else
MSComm1.Output = "01-//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If

fStatus1.BackColor = &HFF&
End If
End Sub



Private Sub cmdOff_Click()
MSComm1.Output = "off//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If
fStatus1.BackColor = &HFF&
fStatus2.BackColor = &HFF&
fStatus3.BackColor = &HFF&
fStatus4.BackColor = &HFF&
fStatus5.BackColor = &HFF&
fStatus6.BackColor = &HFF&
fStatus7.BackColor = &HFF&
fStatus8.BackColor = &HFF&
fStatus9.BackColor = &HFF&
fStatus10.BackColor = &HFF&
fStatus11.BackColor = &HFF&
fStatus12.BackColor = &HFF&
fStatus13.BackColor = &HFF&
fStatus14.BackColor = &HFF&
fStatus15.BackColor = &HFF&
fStatus16.BackColor = &HFF&
End Sub


Private Sub cmdOn_Click()
MSComm1.Output = "on//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If
fStatus1.BackColor = &HC000&
fStatus2.BackColor = &HC000&
fStatus3.BackColor = &HC000&
fStatus4.BackColor = &HC000&
fStatus5.BackColor = &HC000&
fStatus6.BackColor = &HC000&
fStatus7.BackColor = &HC000&
fStatus8.BackColor = &HC000&
fStatus9.BackColor = &HC000&
fStatus10.BackColor = &HC000&
fStatus11.BackColor = &HC000&
fStatus12.BackColor = &HC000&
fStatus13.BackColor = &HC000&
fStatus14.BackColor = &HC000&
fStatus15.BackColor = &HC000&
fStatus16.BackColor = &HC000&
End Sub



Private Sub cmdExit_Click()
MSComm1.Output = "off//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
Unload Form1
End Sub

' REMOVED 5 to 16 to shorted post

Private Sub cmdRelay2_Click()
If fStatus2.BackColor = &HFF& Then
MSComm1.Output = "02+//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If

fStatus2.BackColor = &HC000&
Else
MSComm1.Output = "02-//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If

fStatus2.BackColor = &HFF&
End If
End Sub

Private Sub cmdRelay3_Click()
If fStatus3.BackColor = &HFF& Then
MSComm1.Output = "03+//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If
fStatus3.BackColor = &HC000&
Else
MSComm1.Output = "03-//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If
fStatus3.BackColor = &HFF&
End If
End Sub

Private Sub cmdRelay4_Click()
If fStatus4.BackColor = &HFF& Then
MSComm1.Output = "04+//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If
fStatus4.BackColor = &HC000&
Else
MSComm1.Output = "04-//"
    If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (150)
        
           MyStrg = MSComm1.Input
           
            lstConnection.Text = lstConnection.Text & MyStrg & vbCrLf
            End If
fStatus4.BackColor = &HFF&
End If
End Sub





Private Sub Form_Load()
 ListComPorts

cmdConect_Click
fStatus1.BackColor = &HFF&
fStatus5.BackColor = &HFF&
End Sub
Private Sub ListComPorts()
Dim i As Integer

cboComm.Clear
For i = 1 To 16
If COMAvailable(i) Then
cboComm.AddItem i
End If
Next
If cboComm.ListCount > 0 Then
cboComm.ListIndex = 0

Else
cboComm.Text = "1"
MsgBox "No Com Ports Installed on this computer"
'END
End If


End Sub
Public Sub Attente(ByVal MilsecToWait As Long)
    Dim lngEndingTime As Long
    lngEndingTime = GetTickCount() + (MilsecToWait)
    Do While GetTickCount() < lngEndingTime
        DoEvents
    Loop
End Sub

[DickGrier]

Try this,

Dim I aS Integer
For I = 1 to Len(MyString)
Debug.Print Asc(Mid(MyString, I, 1))
Next I

The Asc function returns only a single value. If you call it with a string argument, it returns only the valye of the first character. You want all values, so you have to loop through MyString to get all of them.

Dick

[planethax]

Ok Awesome!
In imediate window I got both bytes,
Now to get them both and decode to see what relays on and off

[planethax]

I have some ideas on how to do this, but how do I distinguish between the first I and Next I ?

Dim I aS Integer
For I = 1 to Len(MyStrg)
MyStrg = Asc(Mid(MyStrg, I, 1))
MyStrg= MyStrg(Mid(MyStrg, I, 1))
MyStrg= MyStrg(len(MyStrg, I, 1)) ' hmmm I am lost lol
Next I

will porbably be a case thing?
if first byte is 01001111
fStatus1 .color = &HFF& fStatus2.color = &HC000& etc, something like that.
I am still working on it.

[DickGrier]

Dim FirstByte As Byte
Dim SecondByte As Byte
   FirstByte = Asc(Mid(MyStrg, 1,1)
   SecondByte = Asc(Mid(MyStrig, 2,1)

See anything interesting? The argument for the Mid function for FirstByte is 1, while the argument for the Mid function for SecondByte is 2. It follows that...

Dick

[planethax]

Right in front of me lol!!

Thanx again!!!

[planethax]

hmmm next error

EDIT ADD: could it be because I have extra spaces before and after?
In immediate window i have this exactly

255

A space before and after the 255

Dim FirstByte As Byte
Dim SecondByte As Byte
   FirstByte = Asc(Mid(MyStrg, 1, 1))
   MsgBox FirstByte
   FirstByte = BinaryConvert(FirstByte)    <- ByRef argument type mismatch ?

My function is

Function BinaryConvert(convert As Integer)



    If convert > 255 Then
        MsgBox "Too big to convert", vbOKOnly, "Not Convertable"
        Exit Function
    End If
    
    If convert <= 255 And convert > 127 Then
        tempdata = tempdata & "1"
        convert = convert - 128
    Else
        tempdata = tempdata & "0"
    End If
    
    If convert <= 127 And convert > 63 Then
        tempdata = tempdata & "1"
        convert = convert - 64
    Else
        tempdata = tempdata & "0"
    End If
    
    If convert <= 63 And convert > 31 Then
        tempdata = tempdata & "1"
        convert = convert - 32
    Else
        tempdata = tempdata & "0"
    End If
    
    If convert <= 31 And convert > 15 Then
        tempdata = tempdata & "1"
        convert = convert - 16
    Else
        tempdata = tempdata & "0"
    End If
    
    If convert <= 15 And convert > 7 Then
        tempdata = tempdata & "1"
        convert = convert - 8
    Else
        tempdata = tempdata & "0"
    End If
    
    If convert <= 7 And convert > 3 Then
        tempdata = tempdata & "1"
        convert = convert - 4
    Else
        tempdata = tempdata & "0"
    End If
    
    If convert <= 3 And convert > 1 Then
        tempdata = tempdata & "1"
        convert = convert - 2
    Else
        tempdata = tempdata & "0"
    End If
    
    If convert <= 1 And convert > 0 Then
        tempdata = tempdata & "1"
        convert = convert - 1
    Else
        tempdata = tempdata & "0"
    End If

    
End Function

[DickGrier]

In my code fragement, I Dim'med FirstByte and SecondByte As Byte. Your code uses an Integer argument, not a Byte (is this the error?). You didn't say what the error message is that you see.

However, if I were doing this, I'd approach it differently. I'd use something like an array of Boolean values to represent the relays. For example,

Dim Relays(15) As Boolean
Dim I As Integer
    For I = 7 To 0 Step -1
       Relays(I) = FirstByte And 2^I
    Next I
    For I = 7 To 0 Step -1
       Relays(I + 8) = SecondByte And 2^i
    Next I

The array Relays, will have a True or False for each bit in the two-byte result. Note, Relay() is zero based, thus the index of 0 => the first relay, the index of 1 => the second relay, etc. You can change the code slightly to have each index represent the associated relay number (though this isn't my preference, because it complicates the code).

If you add this:

    For I = 0 To 15
      Text1.SelText = "Relay state for relay: " & CStr(I + 1) & " is  " & CStr(Relays(I)) & vbCrLf
    Next I

You should see the state of each relay in a single multiline textbox (add one named Text1 or change the name in the code fragment). You can use other ways to display this data, equally well.

Dick

[planethax]

Ok, almost home and will take another look,
I had put the error in the code section
FirstByte = BinaryConvert(FirstByte) <- ByRef argument type mismatch ?


I am hoping, instead of printing result(though may print it to a hidden text or label for debugging) I am wanting to change the background color of frame
fStatus1.color = &HFF& OFF or fStatus1.color = &HC000& On
fStatus2.color = &HFF& OFF or fStatus2.color = &HC000& On
etc etc

[planethax]

Private Sub cmdAsk_Click()
MSComm1.Output = "ask//"
If (MSComm1.CommEvent = comEvReceive) Then
 
       Attente (1000)
        
           MyStrg = MSComm1.Input
Dim I As Integer
For I = 1 To Len(MyStrg)
Dim Relays(15) As Boolean

Next I
Dim FirstByte As Byte
Dim SecondByte As Byte
   FirstByte = Asc(Mid(MyStrg, 1, 1))
   SecondByte = Asc(Mid(MyStrg, 2, 1))

    For I = 7 To 0 Step -1
       Relays(I) = FirstByte And 2 ^ I
    Next I
    For I = 7 To 0 Step -1
       Relays(I + 8) = SecondByte And 2 ^ I
    Next I
        For I = 0 To 15
      Text1.SelText = "Relay state for relay: " & CStr(I + 1) & " is  " & CStr(Relays(I)) & vbCrLf
    Next I

            lstConnection.Text = lstConnection.Text & FirstByte & SecondByte & vbCrLf
            SendMessage lstConnection.hWnd, WM_VSCROLL, SB_BOTTOM, 0
            End If
End Sub

Almost perfect, just the bytes seem to be reading backwards

If relay 1 is on, it says relay 8 is on
If relay 2 is on, it says relay 7 is on
If relay 16 is on, it says relay 9 is on
If relay 15 is on, it says relay 10 is on

etc etc

[Doogle]

The Array elements are being assigned in reverse order. Simple way of resolving is to introduce a variable going from 0 to 15 and use that as the Array element. Something like this:

Dim FirstByte As Byte
Dim SecondByte As Byte
Dim intRelay As Integer
   FirstByte = Asc(Mid(MyStrg, 1, 1))
   SecondByte = Asc(Mid(MyStrg, 2, 1))
    For I = 7 To 0 Step -1
       Relays(intRelay) = FirstByte And 2 ^ I
       intRelay = intRelay + 1
    Next I
    For I = 7 To 0 Step -1
       Relays(intRelay) = SecondByte And 2 ^ I
       intRelay = intRelay + 1
    Next I
        For I = 0 To 15
      Text1.SelText = "Relay state for relay: " & CStr(I + 1) & " is  " & CStr(Relays(I)) & vbCrLf
    Next I

[planethax]

Thanx so much!!!!
Just 2 more questions at this time lol

In order to get better, I hope to understand what the following does;
(I have commented the best I understand)

Dim I As Integer   'Dims I
For I = 1 To Len(MyStrg)  ' assigns Value to I through out length of mystrg
Dim Relays(15) As Boolean 'Dims relays
 
Next I   'goto next I  in mystrg
Dim FirstByte As Byte  ' dims
Dim SecondByte As Byte ' dims
Dim intRelay As Integer ' dims
   FirstByte = Asc(Mid(MyStrg, 1, 1))  ' assigns value to first byte
   SecondByte = Asc(Mid(MyStrg, 2, 1)) ' assigns value to second
    For I = 7 To 0 Step -1                      '  do this for every I through out first byte
       Relays(intRelay) = FirstByte And 2 ^ I   ' NOT SURE
       intRelay = intRelay + 1           ' assigns intrelay plus 1 to inrelay
    Next I                                           ' do again till done?
    For I = 7 To 0 Step -1                 ' '  do this for every I through out second byte
       Relays(intRelay) = SecondByte And 2 ^ I        ' again not sure
       intRelay = intRelay + 1    ' assigns intrelay plus 1 to inrelay
    Next I   ' do till no more I left
        For I = 0 To 15    ' do this for all 16
      Text1.SelText = "fStatus" & CStr(I + 1) & ".backcolor =" & CStr(Relays(I)) & vbCrLf   'what is CStr ?
    Next I  'do till all 16 are done

Next question,
Text1.SelText = "fstatus" & CStr(I + 1) & ".backcolor =" & CStr(Relays(I)) & vbCrLf

hoping to have that line instead of True or False
True be &HC000&
and
False be &HFF&
&HFF&
basically
fstatus1.baclcolor = &HC000& for true
fstatus1.baclcolor = &HFF& for false
any easy way to do this?

edit: worst case, I could have a Green frame on top of a red frame, then have the Green frame visible True or False ?
something like this (but this didnt work)
fStatusTrue + CStr(I + 1) & ".Visible = " & CStr(Relays(I))

[DickGrier]

Just test for True or False, then assign the color.

Dick

[planethax]

This is where I am having a problem, I am not setting the Frame color correctly

        For I = 0 To 15
    Text1.SelText = "Relay state for relay: " & CStr(I + 1) & " is  " & CStr(Relays(I)) & vbCrLf
        
       If CStr(Relays(I)) = False Then
       Frame.fStatus(CStr(I + 1)).BackColor = &HFF&
        Else
        Frame.fStatus(CStr(I + 1)).BackColor = &HC000&
        End If
    Next I

that gives me "Variable not defined" on frame and with out "Frame." I get
"Sub or function not defined on fStatus (I have 16 frames named fStatus1 to fStatus16)


edit add

Ok so I am not able to assign the Relay# to the fStatus correctly
fStatus + CStr(I + 1)

[planethax]

however this works

       If CStr(Relays(I)) = False Then
       
       MsgBox "fStatus" & CStr(I + 1) & ".BackColor = &HFF&"
        Else
      MsgBox "fStatus" & CStr(I + 1) & ".BackColor = &HC000&"
        End If
    Next I

So I am getting closer

[DickGrier]

Cstr converts a number to a String (Cstr => convert to string). A control array, like any other array, uses a numeric index, so a String is not approriate.

   If Cstr(Relays(I)) = False Then
       Frame.fStatus(I+1).BackColor = &HFF

etc.

What you need to do is to step back from you code, when you encounter an error, and try to understand what you have coded vs what you intended to code.

Of course, what I'm assuming is that Frame.fStatus is a control array (an array of Frames). Not having all of your project in front of me, I have to guess at parts of it.

Dick

[planethax]

Not arrays, just 16 frames.
I tried arrays, but as you can see I am not good at them and kept getting errors.
I need to get a better understanding of them for sure, will cut my code size in half at least I would think.


edit add:
At first I made a control array of 16 Frames - fStatus(0) to (15)
but if I coded for one it would code for all of them.
I think it was because I wasn't using Case ?
(currently reading an article on Op Radio buttons used in an Array, so hopefully this will help me understand some more)

[planethax]

Ahhh
I have tried several ways to do this, just not the right one.

Dim R As String
    R = CStr(I + 1)
   ' MsgBox R
       If CStr(Relays(I)) = False Then

      Text2.SelText = "fStatus" & R & ".BackColor = &HFF&"
        fStatus(R).BackColor = &HFF&
        Else
      Text2.SelText = "fStatus" & R & ".BackColor = &HC000&"
      fStatus(R).BackColor = &HC000&
        End If

[DickGrier]

But, what is fStatus(R)? You have defined R as a String. What is fStatus(somestring) supposed to do? Is fStatus a subroutine? Where is the code for it?

What you have posted is a mystery to me. I suspect that you are trying to use a control array, but that you don't have the concept down.

You can chage the BackColor of a frame. For example,

Frame1.BackColor = &HFF

You can change the BackColor of a control array of Frames by using the associated (Integer) index.

How do you create a control array of Frames? Drop a frame control on a form. Name that fame control fStatus. Select it. Copy it to the Clipboard. Paste a copy to the form. VB will ask you if you want to create a Control Array. Click Yes. Repeat this process 14 more times. You now have a control array of Frames that may be indexed by number (from 0 to 15, with 0 being the index of the first frame, 1, the second, etc.). You can do the same thing with most ActiveX controls.

If you do this, then you may use the For/Next loop to change the BackColor of each Frame by its index.

Dick

[planethax]

fStatus is a Frame
fStatus1
fStatus2
16 of them to
fStatus16

CStr(I + 1) holds the number 1 to 16
I need to make frames
fStatus1 to fStatus16 cange their background color according to True or False