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