dlportio_i2c.bas

VB6, paralell port, I2C, parse intel HEX

Attribute VB_Name = "I2C"
Option Explicit

Declare Function GetTickCount Lib "kernel32" () As Long

Public Declare Function DlPortReadPortUchar Lib "dlportio.dll" (ByVal Port As Long) As Byte
Public Declare Function DlPortReadPortUshort Lib "dlportio.dll" (ByVal Port As Long) As Integer
Public Declare Function DlPortReadPortUlong Lib "dlportio.dll" (ByVal Port As Long) As Long

Public Declare Sub DlPortReadPortBufferUchar Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)
Public Declare Sub DlPortReadPortBufferUshort Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)
Public Declare Sub DlPortReadPortBufferUlong Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)

Public Declare Sub DlPortWritePortUchar Lib "dlportio.dll" (ByVal Port As Long, ByVal Value As Byte)
Public Declare Sub DlPortWritePortUshort Lib "dlportio.dll" (ByVal Port As Long, ByVal Value As Integer)
Public Declare Sub DlPortWritePortUlong Lib "dlportio.dll" (ByVal Port As Long, ByVal Value As Long)

Public Declare Sub DlPortWritePortBufferUchar Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)
Public Declare Sub DlPortWritePortBufferUshort Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)
Public Declare Sub DlPortWritePortBufferUlong Lib "dlportio.dll" (ByVal Port As Long, Buffer As Any, ByVal Count As Long)

Public Const PortAddress = &H378
Public Const I2C_SCL As Byte = 8         'pin 5
Public Const I2C_SDA_Out As Byte = 16    'pin 6
Public Const I2C_SDA_In As Byte = &H80   'pin 11
Public Const BaseAddress As String = "0100"
Public Const DeviceNumber As Byte = 4
Public DeviceAddress As String

Public Function I2C_ReadAddress(ByVal Base As String, ByVal Adr As Byte) As String
On Error GoTo greska
  I2C_ReadAddress = Left(Base, 4) + _
  Switch(Adr = 0, "000", Adr = 1, "001", _
         Adr = 2, "010", Adr = 3, "011", _
         Adr = 4, "100", Adr = 5, "101", _
         Adr = 6, "110", Adr = 7, "111") + "0"
Exit Function
greska:
MsgBox "I2C_ReadAddress: " & Err.Number & Err.Description
End Function

Public Function I2C_WriteAddress(ByVal Base As String, ByVal Adr As Byte) As String
On Error GoTo greska
  I2C_WriteAddress = Left(Base, 4) + _
  Switch(Adr = 0, "000", Adr = 1, "001", _
         Adr = 2, "010", Adr = 3, "011", _
         Adr = 4, "100", Adr = 5, "101", _
         Adr = 6, "110", Adr = 7, "111") + "1"
Exit Function
greska:
MsgBox "I2C_WriteAddress: " & Err.Number & Err.Description
End Function

Public Function WritePortUchar(ByVal Port As Long, ByVal Value As Byte)
On Error GoTo greska
'Sleep (1)
DlPortWritePortUchar Port, Value
Exit Function
greska:
MsgBox "WritePortUchar: " & Err.Number & Err.Description
End Function

Public Sub I2C_start_condition()
On Error GoTo greska
' Start condition (inverted logic). SDA falls whilst SCL is high.
WritePortUchar PortAddress, (0)             ' SDA = 1, SCL = 1
WritePortUchar PortAddress, (I2C_SDA_Out)   ' SDA = 0, SCL = 1
Exit Sub
greska:
MsgBox "I2C_start_condition: " & Err.Number & Err.Description
End Sub

Public Sub I2C_stop_condition()
On Error GoTo greska
' Stop condition (inverted logic). SDA rises whilst SCL is high.
WritePortUchar PortAddress, (I2C_SDA_Out)     ' SDA = 0, SCL = 1
WritePortUchar PortAddress, (0)               ' SDA = 1, SCL = 1
WritePortUchar PortAddress, (0)  ' SDA = 1, SCL = 1
WritePortUchar PortAddress, (0)  ' SDA = 1, SCL = 1
WritePortUchar PortAddress, (0)  ' SDA = 1, SCL = 1
Exit Sub
greska:
MsgBox "I2C_stop_condition: " & Err.Number & Err.Description
End Sub

Public Sub I2C_CLKout8(ByVal str As String)
On Error GoTo greska
' 8 bits clocked out, valid on SCL high (inverted logic)
Dim i As Byte
' data clocked out MSB first
For i = 1 To 8
    If Mid(str, i, 1) = "1" Then
      WritePortUchar PortAddress, (I2C_SCL)     ' SDA = 1, SCL = 0
      WritePortUchar PortAddress, (0)           ' SDA = 1, SCL = 1 bit "1" sampled on SCL high
      WritePortUchar PortAddress, (I2C_SCL)     ' SDA = 1, SCL = 0
    Else
      WritePortUchar PortAddress, (I2C_SDA_Out + I2C_SCL)     ' SDA = 0, SCL = 0
      WritePortUchar PortAddress, (I2C_SDA_Out)               ' SDA = 0, SCL = 1 bit "0" sampled on SCL high
      WritePortUchar PortAddress, (I2C_SDA_Out + I2C_SCL)     ' SDA = 0, SCL = 0
    End If
  Next i
Exit Sub
greska:
MsgBox "I2C_CLKout8: " & Err.Number & Err.Description
End Sub

Public Function I2C_CLKin8() As String
On Error GoTo greska
Dim i As Integer
' We now release SDA; slave device will pull it down if it is transmitting 0
WritePortUchar PortAddress, (I2C_SCL) ' SDA = 1, SCL = 0
' Initialise all read-back data bits low
I2C_CLKin8 = "00000000"
' Read register data byte
'(I2C_SDA_In input is true logic, but I2C_SCL and I2C_SDA_Out outputs are inverted)
' data clocked in MSB first
For i = 1 To 8
    WritePortUchar PortAddress, (I2C_SCL)   ' SDA = 1, SCL = 0
    WritePortUchar PortAddress, (0)         ' SDA = 1, SCL = 1
'' previse sporo sa zadrskom od 1ms
'    Sleep (1) ' Delay before reading the input to allow slave output to settle
    If (DlPortReadPortUshort(PortAddress + 1) And I2C_SDA_In) <> 0 Then
        ' I睠 SDA input is high
        Mid$(I2C_CLKin8, i, 1) = "1"
    End If
Next i
Exit Function
greska:
MsgBox "I2C_CLKin8: " & Err.Number & Err.Description
End Function

Public Function I2C_Ack_receive() As Boolean
On Error GoTo greska
' 9th clock pulse for Ack bit
' (we falsely generate the Ack by taking SDA low as if receiving end was doing it)
WritePortUchar PortAddress, (I2C_SDA_Out + I2C_SCL)   ' SDA = 0, SCL = 0
WritePortUchar PortAddress, (I2C_SDA_Out)             ' SDA = 0, SCL = 1
WritePortUchar PortAddress, (I2C_SDA_Out + I2C_SCL)   ' SDA = 0, SCL = 0
I2C_Ack_receive = True

'    WritePortUchar PortAddress, (I2C_SCL)   ' SDA = 1, SCL = 0
'    WritePortUchar PortAddress, (0)         ' SDA = 1, SCL = 1
'    Sleep (1) ' Delay before reading the input to allow slave output to settle
'    If (DlPortReadPortUshort(PortAddress + 1) And I2C_SDA_In) <> 0 Then
'        I2C_ack=false
'    else
'       i2c_ack=True
'    End If

Exit Function
greska:
MsgBox "I2C_Ack_receive: " & Err.Number & Err.Description
End Function

Public Function I2C_Ack_transmit() As Boolean
On Error GoTo greska
' 9th clock pulse for Ack bit
' generate the Ack by taking SDA low
WritePortUchar PortAddress, (I2C_SDA_Out + I2C_SCL)   ' SDA = 0, SCL = 0
WritePortUchar PortAddress, (I2C_SDA_Out)             ' SDA = 0, SCL = 1
WritePortUchar PortAddress, (I2C_SDA_Out + I2C_SCL)   ' SDA = 0, SCL = 0
I2C_Ack_transmit = True
Exit Function
greska:
MsgBox "I2C_Ack_transmit: " & Err.Number & Err.Description
End Function

Public Function I2C_NotAck_transmit() As Boolean
On Error GoTo greska
' 9th clock pulse for Ack bit
' we DO NOT ACKNOWLEDGE, to terminate transmission,
' so SDA is high during 9th clock pulse)
WritePortUchar PortAddress, (I2C_SCL)   ' SDA = 1, SCL = 0
WritePortUchar PortAddress, (0)         ' SDA = 1, SCL = 1
I2C_NotAck_transmit = True
Exit Function
greska:
MsgBox "I2C_NotAck_transmit: " & Err.Number & Err.Description
End Function

Public Function I2C_Send_Byte(ByVal DevNum As Byte, strAddress As String, strData1 As String)
On Error GoTo greska
' I2C start condition
I2C_start_condition
' Transmit I睠 device address byte (inverted logic).
DeviceAddress = I2C_WriteAddress(BaseAddress, DevNum)
I2C_CLKout8 (DeviceAddress)
I2C_Ack_receive
' Transmit register address byte (inverted logic)
I2C_CLKout8 (strAddress)
I2C_Ack_receive
' Transmit register data byte 1 (inverted logic)
I2C_CLKout8 (strData1)
I2C_Ack_receive
' I2C stop condition
I2C_stop_condition
I2C_Send_Byte = True
Exit Function
greska:
MsgBox "I2C_Send_Byte: " & Err.Number & Err.Description
End Function

Public Function I2C_Read_Byte(ByVal DevNum As Byte, strAddress As String) As String
On Error GoTo greska
' I2C start condition
I2C_start_condition
' Transmit I睠 device address byte (inverted logic).
DeviceAddress = I2C_WriteAddress(BaseAddress, DevNum)
I2C_CLKout8 (DeviceAddress)
I2C_Ack_receive
' Transmit register address byte (inverted logic)
I2C_CLKout8 (strAddress)
I2C_Ack_receive
' I2C stop condition - is it necessary?
I2C_stop_condition
' I2C start condition
I2C_start_condition
' Transmit I睠 device address byte (inverted logic).
DeviceAddress = I2C_ReadAddress(BaseAddress, DevNum)
I2C_CLKout8 (DeviceAddress)
I2C_Ack_receive
' read first byte
I2C_Read_Byte = I2C_CLKin8()
I2C_NotAck_transmit
Exit Function
greska:
MsgBox "I2C_Read_Byte: " & Err.Number & Err.Description
End Function

Public Function I2C_Send_2_Bytes(ByVal DevNum As Byte, strAddress As String, strData1 As String, strData2 As String)
On Error GoTo greska
' I2C start condition
I2C_start_condition
' Transmit I睠 device address byte (inverted logic).
DeviceAddress = I2C_WriteAddress(BaseAddress, DevNum)
I2C_CLKout8 (DeviceAddress)
I2C_Ack_receive
' Transmit register address byte (inverted logic)
I2C_CLKout8 (strAddress)
I2C_Ack_receive
' Transmit register data byte 1 (inverted logic)
I2C_CLKout8 (strData1)
I2C_Ack_receive
' Transmit register data byte 2 (inverted logic)
I2C_CLKout8 (strData2)
I2C_Ack_receive
' I2C stop condition
I2C_stop_condition
I2C_Send_2_Bytes = True
Exit Function
greska:
MsgBox "I2C_Send_2_Bytes: " & Err.Number & Err.Description
End Function

Public Function I2C_Read_2_Bytes(ByVal DevNum As Byte, strAddress As String) As String
On Error GoTo greska
' I2C start condition
I2C_start_condition
' Transmit I睠 device address byte (inverted logic).
DeviceAddress = I2C_WriteAddress(BaseAddress, DevNum)
I2C_CLKout8 (DeviceAddress)
I2C_Ack_receive
' Transmit register address byte (inverted logic)
I2C_CLKout8 (strAddress)
I2C_Ack_receive
' I2C stop condition - is it necessary?
I2C_stop_condition
' I2C start condition
I2C_start_condition
' Transmit I睠 device address byte (inverted logic).
DeviceAddress = I2C_ReadAddress(BaseAddress, DevNum)
I2C_CLKout8 (DeviceAddress)
I2C_Ack_receive
' read first byte
I2C_Read_2_Bytes = I2C_CLKin8()
I2C_Ack_transmit
'read second byte
I2C_Read_2_Bytes = I2C_Read_2_Bytes & I2C_CLKin8()
I2C_NotAck_transmit
Exit Function
greska:
MsgBox "I2C_Send_2_Bytes: " & Err.Number & Err.Description
End Function