Attribute VB_Name = "dmxusbpro"
' Enttec DMX Usb Pro Driver for Visual Basic. (http://www.enttec.com/)
' GPL (c) hippy (rowanmac@optusnet.com.au)

Option Explicit

' utility prototypes
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSrc As Any, ByVal dwSize&)
Private Declare Sub CopyString Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal strSrc As String, ByVal dwSize&)


' Widget message types
' ====================

' firmware flashing
Private Const FLASH_FIRMWARE = 1   ' enter flash mode
Private Const FLASH_PAGE_WRITE = 2 ' flash a page
Private Const FLASH_PAGE_REPLY = 2 ' flash page success status
Private Const FLASH_PAGE_SUCCESS = "TRUE" ' recieved if last flash page write was OK
Private Const FLASH_PAGE_FAIL = "FALS" ' recieved if last flash page write failed
Private Const FLASH_PAGES = 96
Private Const FLASH_PAGE_SIZE = 64


' configuration
Public Const GET_WIDGET_CFG = 3 ' request the widgets config data
Public Const GET_WIDGET_CFG_REPLY = 3 ' returned config
Public Const SET_WIDGET_CFG = 4 ' send new config

' dmx
Public Const DMX_INPUT = 5  ' auto sent by widget apon arival of a dmx packet
Public Const DMX_OUTPUT = 6 ' sent to widget to update buffers, stay in send mode
Public Const RDM_OUTPUT = 7 ' sent to widget, send a dmx packet, then enter recieve mode

' misc packet constants
Const SOM = &H7E ' Start Of Message Marker
Const EOM = &HE7 ' End Of Message Marker


' driver error codes
' ==================
Const ERR_OK = 0               ' no error, all is good
Const ERR_WIDGET_NOT_INITIALIZED = 255 ' widget is not connected/responding
Const ERR_NOT_VALID_PACKET = 1 ' packet format seems invalid
Const ERR_PACKET_TOO_SHORT = 2 ' packet data length is not valid
Const ERR_DATA_LENGTH_INVALID = 3 ' packet specified an invalid data field length
Const ERR_FLASH_FAILED = 4 ' Failed to write last firmware page
Const ERR_DATA_LENGTH_MISMATCH = 5 ' the data length did not match the actual size in the packet


' widget structures
' =================

' message header
Type Struct_Header
 Delim As Byte ' should be equal to SOM StartOfMessage
 Label As Byte ' message type
 Length As Integer ' data field length (two bytes) 0..600
End Type


' configuration info
Type Struct_GET_CFG
  Delim As Byte ' should be equal to SOM StartOfMessage
  Label As Byte ' message type
  Length As Integer ' data field length (two bytes) 0..600
  Firmware_VersionL As Byte
  Firmware_VersionH As Byte '
  BreakTime As Byte ' 9..127 in 10.67us units
  MarkAfterBreak As Byte ' 1..127 in 10.67us units
  FrameRate As Byte ' frames sent per second, 1..40
  UserData(0 To 507) As Byte
    
    ' user data area...
End Type

'dmx out structure
Type Struct_REQUEST_CFG
 Delim As Byte ' should be equal to SOM StartOfMessage
 Label As Byte ' message type
 Length As Integer ' data field length (two bytes) 0..600
 UserDataLength As Integer ' length of user data to return
End Type

' returned
Type Struct_SET_CFG
  Head As Struct_Header ' packet head
  DataLength As Integer ' set length of data area, two bytes, LSB first 0..508
  BreakTime As Byte ' 9..127 in 10.67us units
  MarkAfterBreak As Byte ' 1..127 in 10.67us units
  FrameRate As Byte ' frames sent per second, 1..40
End Type

' recieved dmx structure
Type Struct_RECV_DMX
  Head As Struct_Header ' packet head
  Status As Byte ' 0 = OK, otherwise Bit 0 = queue overflow, Bit 1 = overrun occured
  data(0 To 512) As Byte  ' recieved dmx, including startcode
End Type

'dmx out structure
Type Struct_SEND_DMX
 Delim As Byte ' should be equal to SOM StartOfMessage
 Label As Byte ' message type
 Length As Integer 'Byte ' data field length (two bytes) 0..600
' LengthH As Byte ' data field length (two bytes) 0..600
 data(0 To 512) As Byte ' dmx data, including the startcode
End Type


'firmware page structure
Type Struct_SEND_Firmware_Page
 Delim As Byte ' should be equal to SOM StartOfMessage
 Label As Byte ' message type
 Length As Integer 'Byte ' data field length (two bytes) 0..600
' LengthH As Byte ' data field length (two bytes) 0..600
 data(0 To 63) As Byte ' firmware page data
End Type

'firmware page structure
Type Struct_Firmware_Page_Success
 Delim As Byte ' should be equal to SOM StartOfMessage
 Label As Byte ' message type
 Length As Integer 'Byte ' data field length (two bytes) 0..600
' LengthH As Byte ' data field length (two bytes) 0..600
 data(0 To 3) As Byte ' TRUE or FALS
End Type

' contains the packet type
Public HEADER As Struct_Header

' contains recieved config info
Public GET_CFG As Struct_GET_CFG
' contains setting to send to widget
Public SET_CFG As Struct_SET_CFG
' config request packet
Public REQ_CFG As Struct_REQUEST_CFG

' contains recieved dmx
Public DMX_IN As Struct_RECV_DMX
' contains dmx to send
Public DMX_OUT As Struct_SEND_DMX

' for firmware re-programming
Public FIRMWARE_PAGE As Struct_SEND_Firmware_Page
Public FIRMWARE_PAGE_REPLY As Struct_Firmware_Page_Success


' the last error to occur, see driver error constants
Public DMX_LASTERROR As Byte






' Initialize Variables
Public Sub Initialize()
 DMX_ERROR (ERR_WIDGET_NOT_INITIALIZED)
 
 Setup_DMX_OUT_Packet (DMX_OUTPUT) ' default to send dmx mode
 Setup_CFG_Request_Packet (0) ' default to read 0 bytes user config data
 Setup_CFG_Set_Packet (0)

End Sub




Public Sub SetRecieveMode()
 Setup_DMX_OUT_Packet (RDM_OUTPUT) ' rdm dmx mode
End Sub

Public Sub SetSendMode()
 Setup_DMX_OUT_Packet (DMX_OUTPUT) ' send dmx mode
End Sub




' declare an error has occured
Public Sub DMX_ERROR(errnum As Byte)
 DMX_LASTERROR = errnum
End Sub





' returns a string description of the error number specified
Public Function DMX_ErrorToString(errnum As Byte) As String
Dim e As String
 Select Case errnum
   
  Case ERR_NOT_VALID_PACKET
   e = "Not Valid Packet, Recieved data seems invalid"
  Case ERR_PACKET_TOO_SHORT
   e = "Packet length is too short"
  Case ERR_DATA_LENGTH_INVALID
   e = "The packet specified an invalid data field length"
  Case ERR_FLASH_FAILED
   e = "Failed to flash firmware page"
  Case ERR_DATA_LENGTH_MISMATCH
   e = "The data length did not match the actual size in the packet"
  Case ERR_WIDGET_NOT_INITIALIZED
   e = "Waiting..."
   
  Case ERR_OK
   e = "Ready"
   
  Case Else
   e = "Unknown Error"
 End Select
 DMX_ErrorToString = e
End Function






' purpose: accept a dmx array from an application
' if the data is different from that which is stored,
' then send a new packet to the widget
'
' input: a byte array of exactly 513 bytes, ie: dim dmxout(0 to 512), 0 is startcode, 1 = channel 1...
'
Public Sub set_dmx(DMXData() As Byte)
Dim tmp As Long

On Error GoTo setdmxerr
 
 'compare with allready buffered values
 For tmp = 0 To 512
  If DMX_OUT.data(tmp) <> DMXData(tmp) Then tmp = 1000 ' if data is different, set tmp to 1000
 Next tmp
  
 If tmp = 512 Then Exit Sub ' data has not changed! no update required.
 
 ' copy the new dmxarray into the dmx_out structure
 CopyMemory DMX_OUT.data(0), DMXData(0), 512
 
 Call Send_DMX_Packet ' send the new dmx packet
  
Exit Sub
setdmxerr:
 MsgBox Err.Description
End Sub












 
' input: string containing data sent from the widget (buf)
' output: if recieved dmx, copy it to DMX_IN,
'         if recieved config setting, copy them to GET_CFG
'         if recieved flash firmware page ack, send next page or fail.
Public Function Recieve_Packet(buf As String) As Long
Dim tmpstr As String
Dim tmpsom As Long
Dim tmpeom As Long

On Error GoTo rxerror

Recieve_Packet = 0 ' no packet recieved..

DMX_ERROR (ERR_OK)

'MsgBox buf

'If buf = FLASH_PAGE_SUCCESS Then
' Recieve_Packet = 254
' Exit Function
'Else
' If buf = FLASH_PAGE_FAIL Then
' Recieve_Packet = 255
' Exit Function
' End If
 
'End If


' TESTING!!1
For tmpsom = 1 To Len(buf)
 If Mid(buf, tmpsom, 1) = SOM Then
   buf = Mid(buf, tmpsom)
  GoTo FoundSOM
 End If
Next tmpsom
FoundSOM:
 
For tmpeom = tmpsom To Len(buf)
 If Mid(buf, tmpeom, 1) = EOM Then
   buf = Left(buf, tmpeom)
  GoTo FoundEOM
 End If
Next tmpeom
FoundEOM:
  
   
' TESTING !!

 If Len(buf) < Len(HEADER) Then ' invalid packet size
  DMX_ERROR (ERR_PACKET_TOO_SHORT)
  Recieve_Packet = -1
  Exit Function
 End If

 ' read the data into a header structure..
 CopyString HEADER, buf, Len(HEADER)
 
 ' check to see if the packet delimiter is right
 If HEADER.Delim <> SOM Then ' if is not Start Of Message byte
  'MsgBox "not start of message: " & Hex(HEADER.Delim)
'  DMX_ERROR (ERR_NOT_VALID_PACKET)
  Recieve_Packet = -2
  Exit Function ' fail
 End If

 ' check for silly values to help in error checking
 If HEADER.Length > 600 Then ' check this!!!
  DMX_ERROR (ERR_DATA_LENGTH_INVALID)
  Recieve_Packet = -3
  Exit Function ' fail
 End If
  
 Recieve_Packet = HEADER.Label
   
   ' determine what kind of packet we recieved
 Select Case HEADER.Label
 
  Case FLASH_PAGE_REPLY ' received success status of last firmware flash page sent
    CopyString FIRMWARE_PAGE_REPLY, buf, Len(buf) - 1
    
    If FIRMWARE_PAGE_REPLY.data(0) = Asc("T") Then
     If FIRMWARE_PAGE_REPLY.data(1) = Asc("R") Then
      If FIRMWARE_PAGE_REPLY.data(2) = Asc("U") Then
       If FIRMWARE_PAGE_REPLY.data(3) = Asc("E") Then
       ' last firmware page was written successfully
       ' write next page or done
       Recieve_Packet = 254 ' return if success
     End If
    End If
   End If
   Else
      DMX_ERROR (ERR_FLASH_FAILED)
      Recieve_Packet = 255 ' return if flash failed
     ' stop sending flash pages, flashing failed
    End If
    
  Case GET_WIDGET_CFG_REPLY ' recieved configuration data from the widget
    ' copy the data into the cfg structure
    CopyString GET_CFG, buf, (Len(buf) - 1)
    
  Case DMX_INPUT ' recieved a dmx packet from the widget
    ' copy the data from the buffer into the DMX_IN structure
    CopyString DMX_IN, buf, (Len(buf) - 1)

   ' If Not SendingDMX Then
     'If dmxusbpro.Port_Open Then
       
      ' Call ArtNet.Send_DMX(Form1.ArtUniv.Value, 0, 0, DMX_IN.data)
       
    ' End If
     
    'End If
    
    
    
    
      
 End Select

 

 Exit Function ' success
' serious error has occured
rxerror:
 MsgBox Err.Description
  
End Function
 
 
 
 
 
 
 
' initialize the DMX_OUT structure, used to transmit dmx to the widget
' input: mode - either DMX_OUTPUT or RDM_OUTPUT
Public Sub Setup_DMX_OUT_Packet(mode As Byte)
Dim tmp As Long
On Error GoTo packcfgerr
'  If ((mode < DMX_OUTPUT) Or (mode > RDM_OUTPUT)) Then mode = DMX_OUTPUT ' default to dmx output on bad input
  With DMX_OUT
   .Delim = SOM ' start of message
   .Label = mode ' specified as DMX_OUTPUT or RDM_OUTPUT
   If mode = RDM_OUTPUT Then .Length = 513 Else .Length = 513 ' sending 512 bytes 0..512
  ' .LengthH = 0
   For tmp = 0 To 512
    .data(tmp) = 0 ' clear the data
   Next tmp
  End With
 Exit Sub ' success
packcfgerr:
 MsgBox Err.Description ' failure
End Sub


' initialize the REQ_CFG structure, used to request configuration data from the widget
' input: user_data_length - how much user data to retrieve (0 = none, 508 = all)
Public Sub Setup_CFG_Request_Packet(user_data_length As Integer)
Dim tmp As Long
On Error GoTo packcfgerr2
 If user_data_length > 508 Then user_data_length = 508
 With REQ_CFG
  .Delim = SOM
  .Label = GET_WIDGET_CFG
  .Length = 2
  .UserDataLength = user_data_length
  End With
 Exit Sub ' success
packcfgerr2:
 MsgBox Err.Description ' failure

End Sub

' initialize the REQ_CFG structure, used to request configuration data from the widget
' input: user_data_length - how much user data to retrieve (0 = none, 508 = all)
Public Sub Setup_CFG_Set_Packet(user_data_length As Integer)
Dim tmp As Long
On Error GoTo packcfgerr2
 If user_data_length > 508 Then user_data_length = 508
 With SET_CFG
  .Head.Delim = SOM
  .Head.Label = SET_WIDGET_CFG
  .Head.Length = 5
  .BreakTime = 9
  .MarkAfterBreak = 1
  .FrameRate = 40
  .DataLength = user_data_length
  End With
 Exit Sub ' success
packcfgerr2:
 MsgBox Err.Description ' failure

End Sub


' purpose - sends a dmx packet to the widget from the DMX_OUT structure
Public Sub Send_DMX_Packet()
Dim buf As String
Dim byBuffer(0 To Len(DMX_OUT)) As Byte

On Error GoTo senddmxerr

 CopyMemory byBuffer(0), DMX_OUT, Len(DMX_OUT)
 buf = Left$(StrConv(byBuffer, 64), Len(DMX_OUT)) & Chr(EOM) ' packet data, plus EndOfMessage marker
 
 ' now TX buf to the widget
If Hoofdblad.MSComm1.PortOpen Then Hoofdblad.MSComm1.Output = buf '& EOM
 
 Exit Sub ' success
senddmxerr:
 MsgBox Err.Description ' fail
End Sub


 
' purpose - sends a cfg packet to the widget from the SET_CFG structure, does not write user data
Public Sub Send_CFG_Packet()
Dim buf As String
Dim byBuffer(0 To Len(SET_CFG)) As Byte

On Error GoTo sendcfgerr

 CopyMemory byBuffer(0), SET_CFG, Len(SET_CFG) ' copy the structure into a buffer
 buf = Left$(StrConv(byBuffer, 64), Len(SET_CFG)) & Chr(EOM)  ' convert to a string, place EndOfMessage marker
 
 ' now TX buf to the widget
  Hoofdblad.MSComm1.Output = buf '& EOM
  
 Exit Sub ' success
sendcfgerr:
 MsgBox Err.Description ' fail
End Sub




' purpose - sends a request config packet to the widget from the REQ_CFG structure
Public Sub Send_CFG_Request_Packet()
Dim buf As String
Dim byBuffer(0 To Len(REQ_CFG)) As Byte
On Error GoTo sendcfgreqerr

 CopyMemory byBuffer(0), REQ_CFG, Len(REQ_CFG) ' copy the structure into a buffer
 buf = Left$(StrConv(byBuffer, 64), Len(REQ_CFG)) & Chr(EOM) ' convert to a string, place EndOfMessage marker
 
 ' now TX buf to the widget
 
 Hoofdblad.MSComm1.Output = buf '& EOM
 
 Exit Sub ' success
sendcfgreqerr:
 MsgBox Err.Description ' fail
End Sub
 
 
 
 
 
 ' enter firmware flashing mode
Public Sub Send_Firmware_Flash_Mode()
Dim buf As String
Dim byBuffer(0 To Len(HEADER)) As Byte

On Error GoTo sendcfgerr

 ' prepare a packet header (with no data needed) to enter into device firmware flash mode
 HEADER.Delim = SOM
 HEADER.Label = FLASH_FIRMWARE
 HEADER.Length = 0 ' no data

 CopyMemory byBuffer(0), HEADER, Len(HEADER) ' copy the structure into a buffer
 buf = Left$(StrConv(byBuffer, 64), Len(HEADER)) & Chr(EOM)  ' convert to a string, place EndOfMessage marker
 
 ' now TX buf to the widget
  Hoofdblad.MSComm1.Output = buf '& EOM
  
 Exit Sub ' success
sendcfgerr:
 MsgBox Err.Description ' fail
End Sub





 ' enter firmware flashing mode
Public Sub Send_Firmware_Flash_Page()
Dim buf As String
Dim byBuffer(0 To Len(FIRMWARE_PAGE)) As Byte

On Error GoTo sendcfgerr
 
 CopyMemory byBuffer(0), FIRMWARE_PAGE, Len(FIRMWARE_PAGE) ' copy the structure into a buffer
 buf = Left$(StrConv(byBuffer, 64), Len(FIRMWARE_PAGE)) & Chr(EOM)  ' convert to a string, place EndOfMessage marker
 
 ' now TX buf to the widget
  Hoofdblad.MSComm1.Output = buf '& EOM
  
 Exit Sub ' success
sendcfgerr:
 MsgBox Err.Description ' fail
End Sub













