Attribute VB_Name = "D_ArtNet"
'  FullBoar Server (c) Rowan Maclachlan 2005
'  free for non-profit use
'  contact rowanmac@optusnet.com.au for commercial use


Option Explicit
' art-net 1.4 - simple, simple art-net node driver for VB6
' mods for FullBoar Server

' by hippy (rowanmac@optusnet.com.au)

Public Const OemUser = &HFF    ' Reserved for Unknown
Public Const DefaultPort = 1936
Public Const ProtocolVersion = 14
   
Public Const OpPoll = &H2000             'Poll */
Public Const OpPollReply = &H2100        'ArtPollReply */
Public Const OpPollFpReply = &H2200      'Reply from Four-Play */

Public Const OpOutput = &H5000           'Output */
Public Const OpAddress = &H6000          'Program Node Settings */
Public Const OpInput = &H7000            'Setup DMX input enables */

Public Const StyleNode = 0    ' Responder is a Node (DMX <-> Ethernet Device)
Public Const StyleServer = 1  ' Lighting console or similar

Public Const MaxNumPorts = 1 '4
Public Const MaxExNumPorts = 32
Public Const ShortNameLength = 18
Public Const LongNameLength = 64
Public Const PortNameLength = 32
Public Const MaxDataLength = 512 - 1 ' 0..511

Public Const PORT_TYPE_DMX_OUTPUT = 0 Or 128
Public Const PORT_TYPE_DMX_INPUT = 0 Or 256

Type T_Addr
     IP(1 To 4) As Byte ' IP address
     Port As Integer ' UDP port BYTE-SWAPPED MANUALLY
End Type

Type T_ArtPoll
  id(0 To 7) As Byte ' protocol ID = "Art-Net"
  OpCode As Integer ' == OpPoll
  VersionH As Byte ' 0
  Version As Byte ' protocol version, set to ProtocolVersion
  TalkToMe As Byte  ' bit 0 = not used
                    '   Prev def was bit 0 = 0 if reply is broadcast
                    '        bit 0 = 1 if reply is to server IP
                    ' All replies are noe broadcast as this feature caused too many
                    ' tech support calls
                    ' bit 1 = 0 then Node only replies when polled
                    ' bit 1 = 1 then Node sends reply when it needs to
 pad As Byte
End Type

Type T_ArtPollReply
id(0 To 7) As Byte     ' protocol ID = "Art-Net"
OpCode As Integer      ' == OpPollReply
Addr As T_Addr      ' 0 if not yet configured
VersionInfoH As Byte   ' The node's current FIRMWARE VERS hi
VersionInfo As Byte    ' The node's current FIRMWARE VERS lo
SubSwitchH As Byte     ' 0 - not used yet
subswitch As Byte      ' from switch on front panel (0-15)
Oem As Integer
UbeaVersion As Byte   ' Firmware version of UBEA
Status  As Byte
EstaMan  As Integer        ' Reserved for ESTA manufacturer id lo, zero for now
ShortName As String * ShortNameLength ' short name defaults to IP
LongName As String * LongNameLength ' long name
NodeReport As String * LongNameLength
NumPortsH  As Byte
NumPorts  As Byte               ' 4 If num i/p ports is dif to output ports, return biggest
PortTypes(1 To MaxNumPorts) As Byte
GoodInput(1 To MaxNumPorts) As Byte
GoodOutput(1 To MaxNumPorts)
Swin(1 To MaxNumPorts)  As Byte
Swout(1 To MaxNumPorts)   As Byte
SwVideo    As Byte
SwMacro  As Byte
SwRemote   As Byte
Spare1    As Byte             ' Spare, currently zero
Spare2    As Byte             ' Spare, currently zero
Spare3    As Byte              ' Spare, currently zero
Style     As Byte               ' Set to Style code to describe type of equipment
Mac(1 To 6) As Byte               ' Mac Address, zero if info not available
Filler(1 To 32)   As Byte              ' Filler bytes, currently zero.
End Type

Type T_ArtDmx
    id(0 To 7) As Byte         ' protocol ID = "Art-Net"
    OpCode As Integer     ' == OpOutput
    VersionH As Byte      ' 0
    Version  As Byte      ' protocol version, set to ProtocolVersion
    Sequence As Byte      ' 0 if not used, else 1-255 incrementing sequence number
    Physical As Byte      ' The physical i/p 0-3. For Debug only
    Universe  As Integer  ' hi nib = subnet, lo nib = wheel position
    Length As Integer     ' BYTE-SWAPPED MANUALLY
    data(MaxDataLength) As Byte
End Type


Type T_ArtHeader
  id(0 To 7) As Byte ' protocol ID = "Art-Net"
  OpCode As Integer '
  pad(8) As Byte
  
End Type

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&)

Public LocalAddr As T_Addr ' Local address info
Public ArtPoll As T_ArtPoll ' art poll packet
Public ArtPollReply As T_ArtPollReply ' art poll reply
Public ArtDMX As T_ArtDmx ' art dmx packet
Public ArtHeader As T_ArtHeader ' packet header
Public PacketsRecieved As Long ' total art-net packets recieved
Public BroadCast_Address As String ' 2.255.255.255 or 10.255.255.255

Public ArtNetDetected As Long


Public ArtUnivIN As Long
Public UniverseDetected As Boolean


'Public dmx_out(0 To 511) As Byte




Public Function ArtNet_InitNode() As Long
Dim intError As Integer
Dim lip As String
Dim IP() As String
Dim selectednetwork As String

ArtNet_InitNode = -1

' initialize Art-Net socket
On Error GoTo doh

'DetectIP

With Hoofdblad.ArtSocket
If selectednetwork <> "" Then
    .Bind &H1936, selectednetwork
Else
    .Bind &H1936
End If
 .RemotePort = &H1936
 
 lip = .LocalIP ' get local ip
End With

 'check local ip
IP() = Split(lip, ".")
If IP(0) = "10" Then
    BroadCast_Address = "10.255.255.255"
    DebugLog "Art-Net 10.x.x.x BCAST: " & BroadCast_Address
Else
    If IP(0) = "2" Then
        BroadCast_Address = "2.255.255.255"
        DebugLog "Art-Net 2.x.x.x BCAST: " & BroadCast_Address
    Else
        DebugLog "Network not configured for Art-Net"
        DebugLog "Please set IP address to 10.x.x.x or 2.x.x.x!!!!"
        BroadCast_Address = "255.255.255.255"
    End If
End If

 ArtNet_InitNode = 1
 DebugLog ("Art-Net Node Started...")
Exit Function
 
doh:
 DebugLog ("! Art-Net Init Error: " & Err.Description)
 ArtNet_InitNode = 0
End Function      'artnet_initnode



Public Sub ArtNet_NodeClose()
 DebugLog ("Art-Net Finished")
End Sub

' print error messages
Private Sub DebugLog(s As String)
 Debug.Print ("Art-Net: " & s)
End Sub



Public Sub Recieve_Packet(buf As String)
Dim a As Long
Dim tmp As String
 tmp = ""
 ' get only the packet header
 Call CopyString(ArtHeader, buf, Len(ArtHeader))
 ' copy the header bytes
 For a = 0 To 7
  tmp = tmp & Chr(ArtHeader.id(a))
 Next a
  ' test for real art-net
  If (tmp) = ("Art-Net" & Chr(0)) Then
   ' yes we have a real art-net packet
   ' packets_rx = packets_rx + 1
  Else
   ' not an art-net packet!
   Exit Sub ' don't process this packet
  End If

ArtNetDetected = True ' art-net has been recieved

' check if a poll packet
If ArtHeader.OpCode = OpPoll Then
 Call DebugLog("ArtPoll Recieved")
 CopyString ArtPoll, buf, Len(ArtPoll) ' copy the buffer into the artpoll structure
 Call ArtPoll_Reply ' reply to the artpoll packet we just recieved
 Exit Sub ' finished processing this packet
End If ' ArtPoll Packet


' check if this is a DMX packet sent to us
If ArtHeader.OpCode = OpOutput Then
 CopyString ArtDMX, buf, Len(ArtDMX) ' copy the buffer info the ArtDMX structure
 
 ' check if we want this universe
 If ArtDMX.Universe = ArtUnivIN Then
  'grab the dmx
  For a = 0 To 511
  ' DMXOUT(a) = ArtDMX.Data(a)
  Next a
  
  UniverseDetected = True ' we have detected the universe want
     
 End If '
 
 Exit Sub ' finished processing this packet
End If ' dmx packet

' unknown packet type
DebugLog ("Art-Net: NYI OpCode : 0x" & ArtHeader.OpCode)
End Sub ' recieve packet




Public Sub ArtPoll_Reply()
Dim buf As String
Dim byBuffer(Len(ArtPollReply)) As Byte
' prepare the response
Call ArtNet_ArtPollReply_Init
' copy packet structure to buffer
CopyMemory byBuffer(0), ArtPollReply, Len(ArtPollReply)
buf = Left$(StrConv(byBuffer, 64), Len(ArtPollReply))
' set to the broadcast address
If BroadCast_Address <> "" Then
    Hoofdblad.ArtSocket.RemoteHost = BroadCast_Address
    'send the buffer
    Hoofdblad.ArtSocket.SendData (buf)
'Call DebugLog("Sent Reply")
End If
End Sub






' Prepare ArtNet Poll Reply Packet
Private Sub ArtNet_ArtPollReply_Init()
Dim a As Long

' Header
ArtPollReply.id(0) = Asc("A")
ArtPollReply.id(1) = Asc("r")
ArtPollReply.id(2) = Asc("t")
ArtPollReply.id(3) = Asc("-")
ArtPollReply.id(4) = Asc("N")
ArtPollReply.id(5) = Asc("e")
ArtPollReply.id(6) = Asc("t")
ArtPollReply.id(7) = &H0
ArtPollReply.OpCode = OpPollReply      ' set packet type

ArtPollReply.Addr = LocalAddr ' our address  'NOT TRUE
ArtPollReply.VersionInfoH = 0
ArtPollReply.VersionInfo = ProtocolVersion
ArtPollReply.Oem = End16(OemUser) ' OEM
ArtPollReply.UbeaVersion = 0
ArtPollReply.EstaMan = 0
ArtPollReply.Status = 0


ArtPollReply.Style = StyleNode ' we a node
'ArtPollReply.Style = StyleServer ' we are a console / server

ArtPollReply.SubSwitchH = 0
ArtPollReply.subswitch = 0 ' sub-universe support

ArtPollReply.ShortName = App.Title
ArtPollReply.LongName = Hoofdblad.Caption

' tell server what dmx hardware we have
ArtPollReply.NodeReport = "OK"

ArtPollReply.NumPortsH = 0
ArtPollReply.NumPorts = MaxNumPorts ' number of dmx I/O ports total

'SetBit(0, 6) ' Set as input
ArtPollReply.PortTypes(1) = SetBit(0, 7) ' set as output
ArtPollReply.GoodOutput(1) = SetBit(0, 7) ' good, if dmx hardware is initialized

'ArtPollReply.PortTypes(1) = SetBit(0, 6) ' set as dmx input to art-net
'ArtPollReply.GoodInput(1) = SetBit(0, 7) ' good, recieveing from dmx hardware

'ArtPollReply.Swin(1) = 0 ' we are recieving dmx from hardare and sending to artnet universe 0

' set output universes
ArtPollReply.Swout(1) = ArtUnivIN ' we are send dmx from recieved art-net universe x

ArtPollReply.SwVideo = 0
ArtPollReply.SwMacro = 0
ArtPollReply.SwRemote = 0
ArtPollReply.Spare1 = 0
ArtPollReply.Spare2 = 0
ArtPollReply.Spare3 = 0
ArtPollReply.Mac(1) = 0
ArtPollReply.Mac(2) = 0
ArtPollReply.Mac(3) = 0
ArtPollReply.Mac(4) = 0
ArtPollReply.Mac(5) = 0
ArtPollReply.Mac(6) = 0
For a = 1 To 32
ArtPollReply.Filler(a) = 0
Next a
End Sub




Public Sub Send_DMX(univ As Byte, subnet As Byte, scode As Byte, DMXData() As Byte)

Dim sndDmx As T_ArtDmx ' packet to send
Dim byBuffer(0 To Len(sndDmx)) As Byte
Dim buf As String

' fill the packet
With sndDmx
.id(0) = Asc("A")  ' prepare header
.id(1) = Asc("r")
.id(2) = Asc("t")
.id(3) = Asc("-")
.id(4) = Asc("N")
.id(5) = Asc("e")
.id(6) = Asc("t")
.id(7) = &H0
.OpCode = OpOutput ' set as Art Output packet
.Version = ProtocolVersion
.VersionH = 0  ' not used
.Sequence = 0  ' not used
.Physical = 0  ' not used
.Universe = univ ' does not have subnet yet
.Length = End16(512) ' data length (manual byteswap)
' copy the data into the packet
CopyMemory .data(0), DMXData(1), 511
End With ' snddmx
' copy the packet into a buffer
CopyMemory byBuffer(0), sndDmx, Len(sndDmx)
buf = Left$(StrConv(byBuffer, 64), Len(sndDmx))
If BroadCast_Address <> "" Then
    ' set to the broadcast address
    Hoofdblad.ArtSocket.RemoteHost = BroadCast_Address
    ' send the buffer
    Hoofdblad.ArtSocket.SendData (buf)
End If
End Sub







Public Function SetBit(InByte As Byte, Bit As Byte) As Byte
SetBit = InByte Or (2 ^ Bit)  'Set het n'de Bit
End Function
Public Function ClearBit(InByte As Byte, Bit As Byte) As Byte
ClearBit = InByte And Not (2 ^ Bit) 'Clear het n'de Bit
End Function
Public Function IsBitSet(InByte As Byte, Bit As Byte) As Boolean
IsBitSet = ((InByte And (2 ^ Bit)) > 0)
End Function
Public Function ToggleBit(InByte As Byte, Bit As Byte) As Byte
ToggleBit = InByte Xor (2 ^ Bit)
End Function
Function End16(ByVal iNum As Integer) As Integer
Dim iRes As Variant
iRes = (iNum And &HFF) * 2 ^ 8
iRes = iRes Or (iNum And &HFF00) / 256
End16 = iRes - IIf(iRes > 32767, 65536, 0)
End Function


