Declare Function OPENCOM Lib "Port.dll" (ByVal A$) As Integer
Declare Sub CLOSECOM Lib "Port.dll" ()
Declare Sub DTR Lib "Port.dll" (ByVal b%)
Declare Sub RTS Lib "Port.dll" (ByVal b%)
Declare Function CTS Lib "Port.dll" () As Integer
Declare Function DSR Lib "Port.dll" () As Integer
Declare Sub DELAY Lib "Port.dll" (ByVal b%) Public Function SCL(i) As Boolean

Public Function SCL(i) As Boolean
'SCL auf der RTS-Leitung am COM-Port
RTS i
End Function

Public Function SDA(i) As Boolean
'Die Daten werden über DTR am COM-Port geschreiben
DTR i
End Function

Public Function SDA_in() As Boolean
'Die SDA-Leitung wird über DSR am COM-Port wieder zurückgelesen
If DSR = 1 Then
   SDA_in = True
Else
   SDA_in = False
End If
End Function

Public Function I2C_INT() As Boolean
'Die INT-Leitung der Eingabekarten wird über CTS am COM-Port überwacht
If CTS = 1 Then
   I2C_INT = True
Else
   I2C_INT = False
End If
End Function

Public Sub i2cInit()
'Ruhezustand SDA=high und SCL=high
SDA 1
SCL 1
If Not SDA_in Then MsgBox ("Keine Antwort vom I2C-Seriell Interface")
End Sub

Public Sub i2cStart()
'START => SDA=low anschließend SCL=low
SDA 0
SCL 0
End Sub

Public Sub i2cStop()
'STOP => SDA=high, dann SCL=high
SDA 0
SDA 1
SCL 1
End Sub


Public Sub i2cAck()
'ACKNOWLEDGE => Byte empfangen weitere Daten senden
SDA 0
SCL 1
SCL 0
SDA 1
End Sub


Public Sub i2cNoAck()
'NO ACKNOWLEDGE => Byte empfangen - Keine weiteren Daten senden
SDA 1
SCL 1
SCL 0
End Sub


Function i2cSlave(Adresse) 'Slave adressieren
' Die 8 Bits der Slaveadresse werden nacheinander auf die SDA-Leitung
' gelegt und jeweils mit einem Impuls auf der SCL-Leitung bestätigt.
' nach dem Stop-Befehl quittiert der Slave den Empfnag der Daten

Bit = 128
For n = 1 To 8 '8 Bits senden
   If (Adresse And Bit) = 0 Then SDA 0 Else SDA 1 'Daten übertragen
   SCL 1 'pos Impuls
   SCL 0 'neg Impuls
   Bit = Bit / 2
Next n

SDA 1 'SDA high setzen - wird vom Slave heruntergezogen
SCL 1 '9. Impuls

' Slave antwortet mit neg. Flanke
If SDA_in Then
   MsgBox ("Kein I2C-Slave an Adresse " & Adresse)
   i2cSlave = False
Else
   'ok
   i2cSlave = True
End If
SCL 0
End Function


Public Function i2cIn() 'Wert vom Slave empfangen
' Der Master sendet 8 Impulse auf die SCL-Leitung und erhält die
' high- oder low-Signale über die SDA-Leitung zurück.

Bit = 128
Wert = 0
SDA 1

For n = 1 To 8
   SCL 1 'pos Impuls
   If SDA_in Then Wert = Wert + Bit
   SCL 0 'neg Impuls
   Bit = Bit / 2
Next n

i2cIn = Wert
End Function


Public Sub i2cOut(Wert) 'Wert zum Slave senden
Dim Bit, n
' Die 8 Datenbits werden nacheinander auf die SDA-Leitung gelegt und
' jeweils mit einem Impuls auf der SCL-Leitung bestätigt.
' nach dem neunten Impuls quittiert der Slave den Empfnag der Daten

Bit = 128
For n = 1 To 8 '8 Bits senden
If (Wert And Bit) = 0 Then SDA 0 Else SDA 1 'Daten übertragen
SCL 1 'pos Impuls
SCL 0 'neg Impuls
Bit = Bit / 2
Next n

' 9. Impuls
SDA 1
SCL 1 'pos Impuls

' Slave antwortet mit neg. Flanke
If SDA_in Then MsgBox ("keine quittierung der Daten vom Slave " & Adresse)

SCL 0 'neg Impuls

End Sub

Public Function i2cLM75_in() 'Liest einen Wert (2 Byte) vom LM75
Dim By1, By2, Wert

   By1 = i2cIn    '1. Byte Wert vom LM75 lesen
   i2cAck
   By2 = i2cIn    '2. Byte lesen
   i2cNoAck

   If (By1 And 128) = 0 Then
      Wert = By1        'Temperatur Vorkomma >= 0°C
   Else
      Wert = By1 - 255  'Temperatur Vorkomma < 0°C
   End If

   If (By2 And 128) <> 0 Then
      Wert = Wert + 0.5
   End If

   i2cLM75_in = Wert

End Function

Public Function i2cLM75_out(Wert) 'Schreibt einen Wert (2 Byte) zum LM75
Dim VK, NK, ZZ$, Z$

'nur Zahlen ausfiltern
For I = 1 To Len(Wert)
  Z$ = Mid$(Wert, I, 1)
  Select Case Z$
    Case "-", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0"
      ZZ$ = ZZ$ & Z$
    Case ".", ","
      ZZ$ = ZZ$ & ","
  End Select
Next I

VK = Fix(CInt(ZZ$))
NK = CInt(ZZ$) - VK

If VK >= 0 Then   'Vorkommawert schreiben
  i2cOut VK       ' Wert positiv
Else
  i2cOut 255 + VK ' Wert negativ
End If

If NK >= 0.5 Then 'Nachkommawert schreiben
  i2cOut 128      ' xx,5 schreiben
Else
  i2cOut 0        ' xx,0 schreiben
End If

End Function