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 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

Private Sub Command_OpenCom_Click()

If Command_OpenCom.Caption = "COM öffnen" Then
  'Serielle Schnittstelle öffnen
  If OPENCOM(Combo_Com.Text & ":" & Combo_Baud.Text & ",n,8,1") = 0 Then
    MsgBox ("Fehler, kann " & Combo_Com.Text & " nicht öffnen")
  Else
    SDA 1 'I2C-Interface testen
    If Not SDA_in Then
      MsgBox ("Keine Antwort vom I2C-Seriell Interface")
    Else
      Command_OpenCom.Caption = "COM schließen"
      'I2C-Bus initialisieren
      i2cInit
      i2cStart
      i2cStop
    End If
  End If
Else
  CLOSECOM 'Serielle Schnittstelle schließen
  Command_OpenCom.Caption = "COM öffnen"
End If

End Sub

Private Sub Command_lesen_Click()
Dim i, ii, Wert

TextBox1.Text = "" 'Textbox löschen

i2cStart
If i2cSlave(160) Then       'Bus-Adresse des EEproms schreiben
   i2cOut 0                 'Byteadresse zum EEprom schreiben
   i2cStop
   i2cStart
   i2cOut 161               'Bus-Adresse des EEproms zum Lesen

   For i = 1 To 255         'Gesamten Speicherinhalt lesen
      Wert = i2cIn          'Wert vom EEprom lesen
      TextBox1.Text = TextBox1.Text + Chr$(Wert)

      If i <> 255 Then
         i2cAck             'Ack schicken
      End If

   Next
End If

i2cNoAck
i2cStop

End Sub


Private Sub Command_schreiben_Click()
Dim i, ii, Wert, Zeichen

On Error GoTo ErrorHandler

For i = 0 To 255 Step 8     '255 Zeichen in 8 Byte Schitten schreiben
   i2cStart

   If i2cSlave(160) Then    'Bus-Adresse des EEproms schreiben
      i2cOut i 'Byteadresse zum EEprom schreiben

      For ii = 1 To 8       '8 Bytes schreiben (PageWrite)

         If Len(TextBox1.Text) < i + ii Then
            Wert = 0
         Else               'Ein Zeichen aus der Textbox holen
            Zeichen = Mid$(TextBox1.Text, i + ii, 1)
            Wert = Asc(Zeichen) 'ASCI-Umwandlung
            If Wert > 255 Then Wert = 0 'ungültiges Zeichen
         End If

         i2cOut Wert        'Zeichen zum EEprom übertragen
      Next ii

      i2cStop               'Werte werden gebrannt
      DELAY 20              '20 ms warten bis Daten geschrieben sind

   End If
Next i

i2cNoAck
i2cStop

Exit Sub

ErrorHandler:
MsgBox ("Fehler " & Err.Number) 'Fehlernummer auswerten.

End Sub