hs1 to hs2

[cohan1279]

Hello, Ive been trying for about a week to get the parallel port plugin working with hs2. My coding skills are very limited (web stuff, php ,ect.)

The prob. is with GetDevice needing to be switched to GetDeviceEnumerator. Im at a complete loss at how this is done.

Could someone please look at this code and give me a hand.

The hs1 working code.

Sub CreateDevices()
    Dim i As Integer
    Dim j As Integer
    Dim h As Integer
    Dim d As Integer
    Dim index As Integer
    Dim dv
    Dim unit As Integer
    Dim house_code As String
    Dim dev_code As Integer
    On Error Resume Next
    
    Screen.MousePointer = vbHourglass
    
    ' first, check to see if our devices are created already
    h = "["
    For j = 1 To MAX_IO_CODES
        For i = 1 To hs.DeviceCount
            Set dv = hs.GetDevice(i)
            If dv.interface = IFACE_NAME And dv.iotype = IOTYPE_VARIABLE Then
                MsgBox "Your variables appear to be created already. Please delete them before attempting to rebuild them", vbExclamation + vbOKOnly
                Screen.MousePointer = vbDefault
                Exit Sub
            End If
        Next
        h = Chr(Asc(h) + 1)
    Next
    
    ' create 6 variables
    ' call back to HS to get a free housecode
    house_code = callback.GetNextFreeIOCode
    
    ' exit if all codes are used
    If house_code = -1 Then
        MsgBox "HSPI_PPortIO ERROR. Sorry, all device codes used", vbCritical + vbOKOnly
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
    
    ' save this for restore later
    SaveSetting "hspi_PPortIO", "Settings", "gbasecode", house_code
    SaveSetting "hspi_PPortIO", "Settings", "LPTport", Port
    gbasecode = Chr(house_code)

    ' create the devices
    ' note the special "iotype" property that must be set
    dev_code = 1
    For i = 0 To 11
        index = hs.NewDevice("Variable " + Trim(Str(i)))
        Set dv = hs.GetDevice(index)
        dv.location = "PPortIO Device"
        dv.hc = Chr(house_code)
        dv.dc = Trim(Str(dev_code))
        dv.interface = IFACE_NAME
        dv.iotype = IOTYPE_VARIABLE
        dv.Status = NO_X10
        dv.misc = 0             ' On/Off only, no dim
        dv.dev_type_string = "PPortIO Variable"
        dev_code = dev_code + 1
    Next
    
    Screen.MousePointer = vbDefault

    MsgBox "Created 12 devices"
End Sub

Ive tried this which will create the 12 devices but it sets all 12 output pins on, and on/off from hs2 has no effect .

Sub CreateDevices()
    Dim i As Integer
    Dim j As Integer
    Dim h As Integer
    Dim d As Integer
    Dim index As Integer
    Dim dv As Object
    Dim lIndex As Integer
  '  Dim dv
    Dim unit As Integer
    Dim house_code As String
    Dim dev_code As Integer
    Dim DE As Object
    On Error Resume Next
    
    Screen.MousePointer = vbHourglass
    
    ' first, check to see if our devices are created already
    
    
    
   

            DE = hs.GetDeviceEnumerator
            If Not DE Is Nothing Then
                Do While Not DE.Finished
                    dv = DE.GetNext
                    If Not dv Is Nothing Then
                        If dv.interface = IFACE_NAME Then
                            ' already exist, just exit
                            Exit Sub
                        End If
                    End If
                Loop
            End If

    
    
        
    ' create 6 variables
    ' call back to HS to get a free housecode
    house_code = callback.GetNextFreeIOCode
    
    ' exit if all codes are used
    If house_code = -1 Then
        MsgBox "HSPI_PPortIO ERROR. Sorry, all device codes used", vbCritical + vbOKOnly
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
    
    ' save this for restore later
    SaveSetting "hspi_PPortIO", "Settings", "gbasecode", house_code
    SaveSetting "hspi_PPortIO", "Settings", "LPTport", Port
    gbasecode = Chr(house_code)

    ' create the devices
    ' note the special "iotype" property that must be set
    dev_code = 1

    
            ' this is a good place to actually assign the real zone names
            
        For i = 0 To 11

        lIndex = hs.NewDeviceRef("Zone " & Trim(Str(i)))
        dv = hs.GetDeviceByRef(lIndex)
           
        dv.location = "PPortIO Device"
        dv.hc = Chr(house_code)
        dv.dc = Trim(Str(dev_code))
        dv.interface = IFACE_NAME
        dv.iotype = IOTYPE_VARIABLE
        dv.Status = NO_X10
        dv.misc = 0             ' On/Off only, no dim
        dv.dev_type_string = "PPortIO Variable"
        dev_code = dev_code + 1
    Next
    Screen.MousePointer = vbDefault

    MsgBox "Created 12 devices"
End Sub

Any help would be great.

Also heres the full vb source. the vb project is in the pportIO folder. the port95nt folder has the need DLPORTIO.BAS

[cohan1279]

Ok I was way over thinking this...
Ive got it working as far as controling on/off.
Now im just missing the status. With any of the 12 devices on or off, the status shows "0" in hs2. any ideas?.

Sub CreateDevices()
    Dim i As Integer
    Dim j As Integer
    Dim h As Integer
    Dim d As Integer
    Dim index As Integer
    Dim dv
    Dim unit As Integer
    Dim house_code As String
    Dim dev_code As Integer
    On Error Resume Next
    
    Screen.MousePointer = vbHourglass
    
    ' first, check to see if our devices are created already
    h = "["
    For j = 1 To MAX_IO_CODES
        For i = 1 To hs.DeviceCount
            ' Set dv = hs.GetDevice(i)
            Set dv = hs.GetDeviceByRef(i)
            If dv.interface = IFACE_NAME And dv.iotype = IOTYPE_VARIABLE Then
                MsgBox "Your variables appear to be created already. Please delete them before attempting to rebuild them", vbExclamation + vbOKOnly
                Screen.MousePointer = vbDefault
                Exit Sub
            End If
        Next
        h = Chr(Asc(h) + 1)
    Next
    
    ' create 6 variables
    ' call back to HS to get a free housecode
    house_code = callback.GetNextFreeIOCode
    
    ' exit if all codes are used
    If house_code = -1 Then
        MsgBox "HSPI_PPortIO ERROR. Sorry, all device codes used", vbCritical + vbOKOnly
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
    
    ' save this for restore later
    SaveSetting "hspi_PPortIO", "Settings", "gbasecode", house_code
    SaveSetting "hspi_PPortIO", "Settings", "LPTport", Port
    gbasecode = Chr(house_code)

    ' create the devices
    ' note the special "iotype" property that must be set
    dev_code = 1
    For i = 0 To 11
        '  index = hs.NewDevice("Variable " + Trim(Str(i)))
        index = hs.NewDeviceRef("Variable " & Trim(Str(i)))
        '  Set dv = hs.GetDevice(index)
        Set dv = hs.GetDeviceByRef(index)
        dv.location = "PPortIO Device"
        dv.hc = Chr(house_code)
        dv.dc = Trim(Str(dev_code))
        dv.interface = IFACE_NAME
        dv.iotype = IOTYPE_VARIABLE
        dv.Status = NO_X10
        dv.misc = 0             ' On/Off only, no dim
        dv.dev_type_string = "PPortIO Variable"
        dev_code = dev_code + 1
    Next
    
    Screen.MousePointer = vbDefault

    MsgBox "Created 12 devices"
End Sub

What Im I missing for status?

[tenholde]

What are you trying to accomplish with the following statement:

dv.Status = NO_X10


tenholde

[cohan1279]

Im not sure. That was in the script already. This is MikeMatthews script, very old.

[cohan1279]

oops

[cohan1279]

oops

[tenholde]

Sub CreateDevices()
        Dim i As Integer
        Dim j As Integer
        Dim h As Integer
        Dim d As Integer
        Dim index As Integer
        'Dim dv
        Dim dv As Scheduler.Classes.DeviceClass
        Dim unit As Integer
        Dim house_code As String
        Dim dev_code As Integer
        On Error Resume Next

        Screen.MousePointer = vbHourglass

        ' first, check to see if our devices are created already
        h = Asc("[")
        For j = 1 To MAX_IO_CODES
            For i = 1 To hs.DeviceCount
                ' Set dv = hs.GetDevice(i)
                dv = hs.GetDeviceByRef(i)
                If dv.interface = IFACE_NAME And dv.iotype = IOTYPE_VARIABLE Then
                    MsgBox("Your variables appear to be created already. Please delete them before attempting to rebuild them", vbExclamation + vbOKOnly)
                    Screen.MousePointer = vbDefault
                    Exit Sub
                End If
            Next
            h = Asc(h) + 1
        Next

        ' create 6 variables
        ' call back to HS to get a free housecode
        house_code = callback.GetNextFreeIOCode

        ' exit if all codes are used
        If house_code = -1 Then
            MsgBox("HSPI_PPortIO ERROR. Sorry, all device codes used", vbCritical + vbOKOnly)
            Screen.MousePointer = vbDefault
            Exit Sub
        End If

        ' save this for restore later
        SaveSetting("hspi_PPortIO", "Settings", "gbasecode", house_code)
        SaveSetting("hspi_PPortIO", "Settings", "LPTport", Port)
        gbasecode = Chr(house_code)

        ' create the devices
        ' note the special "iotype" property that must be set
        dev_code = 1
        For i = 0 To 11
            '  index = hs.NewDevice("Variable " + Trim(Str(i)))
            index = hs.NewDeviceRef("Variable " & Trim(Str(i)))
            '  Set dv = hs.GetDevice(index)
            dv = hs.GetDeviceByRef(index)
            dv.location = "PPortIO Device"
            dv.hc = Chr(house_code)
            dv.dc = Trim(Str(dev_code))
            dv.interface = IFACE_NAME
            dv.iotype = IOTYPE_VARIABLE
            'dv.status = NO_X10
            dv.status_support = True
            dv.misc = 0             ' On/Off only, no dim
            dv.dev_type_string = "PPortIO Variable"
            dev_code = dev_code + 1
        Next

        Screen.MousePointer = vbDefault

        MsgBox("Created 12 devices")
    End Sub

Made a few changes, hope they help. What are these devices you are creating used for?

tenholde

[cohan1279]

Thanks but i get a build error with

Dim dv As Scheduler.Classes.DeviceClass

And as for the use, I was going to use these to control Christmas lights with a parallel port relay controller. Its alittile late for that now (maybe next year), but with the parallel port just sitting there unused might as well make use of it.

[cohan1279]

Might the prob. be in the HSPIControl.ctl.

Public Function InterfaceStatus() As Integer
    InterfaceStatus = ERR_NONE
End Function

' this function is called when an action on a device is to be executed.
' if a device's status is set to ON or OFF, or its value changes, this function is called
' note that this will be called for ALL I/O devices. You must check and make sure that
' the housecode value belongs to you. When your control is initialized, allocate a free
' housecode and save it in the registry. Restore it whenever you are initialized
Public Sub SetIO(dv As Variant, housecode As String, devicecode As String, command As Integer, brightness As Integer, data1 As Integer, data2 As Integer)
    On Error Resume Next
    Dim devstat As Integer, a As Integer, b As Integer
    Dim comstr As String
    Dim hci, comleft, comright
Const BinValues = "0000000100100011" & _
                    "0100010101100111" & _
                      "1000100110101011" & _
                      "1100110111101111"
                      
                     
comstr = ""
If housecode = gbasecode Then
      ' its for us
    If devicecode < 9 Then
        a = 1
        b = 7
        portadd = lptval
    End If
    
    If devicecode >= 9 Then
        a = 9
        b = 3
        portadd = lptct
    End If
    
        For i = 0 To b
            hci = gbasecode & (a + i)
            If i = devicecode - a Then
                devstat = command
                If devstat <> 2 Then devstat = 3
            Else
                devstat = hs.devicestatus(hci)
                If devstat = 17 Or devstat = 4 Then
                    devstat = 3
                    hs.setdevicestatus hci, devstat
                End If
            End If
            If a + i = 12 Or a + i = 11 Or a + i = 9 Then
                comstr = comstr & Abs(Str(Abs(devstat - 3)) - 1)
            Else
                comstr = comstr & Str(Abs(devstat - 3))
            End If
        Next
        comstr = Replace(comstr, " ", "")
       
        'hs.writelog "PPortIO", "Setting output, command: " & comstr
        i = 0
        Do Until Left(comstr, 4) = Mid(BinValues, i * 4 + 1, 4)
            'hs.WriteLog "hex1", Left(comstr, 4) & ":" & Mid(BinValues, i * 4 + 1, 4)
            i = i + 1
            If i > 17 Then Exit Do
        Loop
        comleft = Hex(i)
        comright = ""
        
        If Len(comstr) > 4 Then
            i = 0
            Do Until Right(comstr, 4) = Mid(BinValues, i * 4 + 1, 4)
                'hs.WriteLog "hex1", Right(comstr, 4) & ":" & Mid(BinValues, i * 4 + 1, 4)
                i = i + 1
                If i > 17 Then Exit Do
            Loop
            comright = Hex(i)
        End If
            
        comstr = comleft & comright
        Value = Val("&H" & comstr)
        'hs.writelog "PPortIO sent", "Port=" & portadd & " value=" & Value & " Comstr=" & comstr
        DlPortWritePortUchar Val(portadd), Value

End If
End Sub

' when some action happens to your device, use the base housecode and call back into
' HS to set the status of your virtual devices like:
'
' hs.SetDeviceStatus gbasecode+"1",UON
 

Private Function parseIO(Message As String)
Dim hex2bin As String
Dim i As Integer
Const BinValues = "0000000100100011" & _
                      "0100010101100111" & _
                      "1000100110101011" & _
                      "1100110111101111"
                      
Message = Replace(Message, "par[", "")
Message = Replace(Message, "]", "")
    For i = 1 To Len(Message)
        hex2bin = hex2bin & Mid$(BinValues, 4 * Val("&h" & Mid$(Message, i, 1)) + 1, 4)
    Next
parseIO = hex2bin

End Function