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