Public Declare Sub PortOut32 Lib "inpout32.dll" Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Integer)
Public Declare Function PortIn32 Lib "inpout32.dll" Alias "Inp32" (ByVal PortAddress As Integer) As Integer
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Const I2C_Port = 890 'War zu faul, den Port variabel zu machen. Wer es ändern will: Standard-ParallelPort-Adresse + 2!
Const SCLlo = 1
Const SCLhi = 0
Const SDAlo = 2
Const SDAhi = 0
'Const StaticOut = 255 'Statische Ausgabe am Port (Stromversorgung des ICs)

Function BintoDez(ByVal Bin As String) As Long
  Dim x&, Y&
    Bin = Bin & String$(8 - Len(Bin), "0")
    For x = 1 To Len(Bin)
      If Mid$(Bin, x, 1) = "1" Then
        Y = Y + 2 ^ (8 - x)
      End If
    Next x
    BintoDez = Y
End Function

Function DeztoBin(ByVal Dez As Long) As String
  Dim x%
   If Dez >= 2 ^ 32 Then
     Call MsgBox("Zahl ist größer als 32 Bit")
     Exit Function
   End If
   Do
     If (Dez And 2 ^ x) Then
       DeztoBin = "1" & DeztoBin
     Else
       DeztoBin = "0" & DeztoBin
     End If
     x = x + 1
   Loop Until 2 ^ x > Dez
   DeztoBin = Format(DeztoBin, "00000000")
End Function

'Startbit senden
Function Start()
PortOut32 I2C_Port, SCLhi + SDAhi
PortOut32 I2C_Port, SCLhi + SDAlo
PortOut32 I2C_Port, SCLlo + SDAhi
End Function

'Stoppbit senden
Function Stopp()
PortOut32 I2C_Port, SCLhi + SDAlo
PortOut32 I2C_Port, SCLhi + SDAhi
End Function

'Ein Byte schreiben
Function WriteByte(ByVal I2C_Data As Long) As Boolean
Dim RetVal As Boolean
Dim BinData As String
Dim x As Long

BinData = DeztoBin(I2C_Data) 'dezimale Daten in binäre umwandeln

For x = 1 To 8
  If Mid(BinData, x, 1) = "1" Then
    PortOut32 I2C_Port, SCLlo + SDAhi
    PortOut32 I2C_Port, SCLhi + SDAhi
    PortOut32 I2C_Port, SCLlo + SDAhi
  Else
    PortOut32 I2C_Port, SCLlo + SDAlo
    PortOut32 I2C_Port, SCLhi + SDAlo
    PortOut32 I2C_Port, SCLlo + SDAlo
  End If
Next

'ACK ausgeben und auslesen, ob es ankam
PortOut32 I2C_Port, SCLlo + SDAhi
PortOut32 I2C_Port, SCLhi + SDAhi
If PortIn32(I2C_Port - 1) And 64 Then
  RetVal = False
Else
  RetVal = True
End If
PortOut32 I2C_Port, SCLlo + SDAhi 'Wichtig: SCL muss wieder low werden - hätte fast die Nerven verloren!
WriteByte = RetVal
End Function

Function WriteLoBit() '-> ACK
PortOut32 I2C_Port, SCLlo + SDAlo
PortOut32 I2C_Port, SCLhi + SDAlo
PortOut32 I2C_Port, SCLlo + SDAlo
End Function

Function WriteHiBit() '-> NACK
PortOut32 I2C_Port, SCLlo + SDAhi
PortOut32 I2C_Port, SCLhi + SDAhi
PortOut32 I2C_Port, SCLlo + SDAhi
End Function

Function ReadByte(Optional ByVal NACK As Boolean = False) As Long
Dim Temp As Long
Dim x As Long
For x = 1 To 8
  PortOut32 I2C_Port, SCLlo + SDAhi
  PortOut32 I2C_Port, SCLhi + SDAhi
  If PortIn32(I2C_Port - 1) And 64 Then
    Temp = Temp + 2 ^ (8 - x)
  End If
Next
ReadByte = Temp

If NACK = True Then
  WriteHiBit
Else
  WriteLoBit
End If
End Function