I2C USB Modem Programmbeispiel / I2C USB Interface program Example

Excel-Makro mit port.dll
Visual Basic 2010 Express Projekt

'Deklarationen der port.dll
Declare Function OPENCOM Lib "Port.dll" (ByVal A$) As Integer
Declare Sub CLOSECOM Lib "Port.dll" ()
Declare Sub SENDBYTE Lib "Port.dll" (ByVal b%)
Declare Function READBYTE Lib "Port.dll" () As Integer
Declare Sub DELAY Lib "Port.dll" (ByVal b%)

'Deklarationen der FTDI-Bibliothek
Declare Function FT_CreateDeviceInfoList Lib "FTD2XX.DLL" _
(ByRef lpdwNumDevs As Long) As Long

Declare Function FT_ListDevices Lib "FTD2XX.DLL" _ 
(ByVal arg1 As Long, ByVal arg2 As String, ByVal dwFlags As Long) As Long

Public Const FT_LIST_BY_NUMBER_ONLY = &H80000000
Public Const FT_LIST_BY_INDEX = &H40000000
Public Const FT_LIST_ALL = &H20000000

Declare Function FT_OpenEx Lib "FTD2XX.DLL" _ 
(ByVal arg1 As String, ByVal arg2 As Long, ByRef lngHandle As Long) As Long

Declare Function FT_GetComPortNumber Lib "FTD2XX.DLL" _ 
(ByVal lngHandle As Long, ByRef portnumber As Long) As Long

Declare Function FT_Close Lib "FTD2XX.DLL" _ 
(ByVal lngHandle As Long) As Long

Public Const FT_OPEN_BY_SERIAL_NUMBER = 1
Public Const FT_OPEN_BY_DESCRIPTION = 2

Option Explicit
'Globale Variablen anlegen, die in der Funktion "Modem_Antwort"
'beschrieben werden

Dim FB           'Frame Befehl
Dim FA           'Frame Anzahl
Dim FE           'Frame Ende
Dim D(1 To 128)  'Daten
Dim stgn         'Statusfarbe hellgrün
Dim strd         'Statusfarbe hellrot

Private Sub Command_VERSION_Click()
Dim By1, By2, By3, By4, By5, By6
'Befehl VERSION 11hex = 17dez.
'Das I2C-Modem antwortet mit sechs Byte.
'Werden die Bytes in der Reihenfolge zusammengesetzt
'so ergibt sich die Versionsnummer der geladenen Firmware

'Befehl zum I2C-USB-Modem schicken
SENDBYTE (17)      'Befehl 17 = Versionsabfrage
SENDBYTE (0)       'Frame Anzahl = 0
SENDBYTE (4)       'Endekennung

'Antwort vom Modem lesen
If Modem_Antwort = True Then
    TextBox_VERSION.Text = "Version: " & D(1) & "." & D(2) & D(3)
Else
    TextBox_VERSION.Text = "Fehler"
End If

End Sub

Private Sub Command_CALL_Click()
Dim By1, By2, By3, By4
Dim ERR
'Befehl CALL 12 hex = 18 dez.
'Modem sendet I2C-OK. Dieser Befehl kann dazu verwendet werden,
'das I2C-Modem an der RS232 zu erkennen.
'Empfängt das I2C-Modem diesen Befehl, wird ein Datenbyte generiert,
'in dem die Bits 6 und 7 gesetzt sind. (192 dez = "#")

SENDBYTE (18)      'Befehl 18 = Call
SENDBYTE (0)       'Frame Anzahl = 0
SENDBYTE (4)       'Endekennung

'Antwort vom Modem lesen
If Modem_Antwort = True Then
    TextBox_CALL.Text = Chr$(D(1))
Else
    TextBox_CALL.Text = "Fehler"
End If

End Sub

Private Sub Command_PULLUP_Click()
'Befehl PULLUP 21 hex = 33 dez.
'Mit diesem Befehl kann der aktuelle Status der
'Pullup-Widerstände ausgelesen werden

SENDBYTE (33)      'Befehl 18 = Call
SENDBYTE (0)       'Frame Anzahl = 0
SENDBYTE (4)       'Endekennung

'Antwort vom Modem lesen
If Modem_Antwort = True Then
    If D(1) = 128 Then
        TextBox_PULLUP.Text = "Pullups sind EIN"
    ElseIf D(1) = 0 Then
        TextBox_PULLUP.Text = "Pullups sind AUS"
    Else
        TextBox_CALL.Text = "Fehler"
    End If
Else
    TextBox_CALL.Text = "Fehler"
End If

End Sub

Private Sub Command_PULLUP_EIN_Click()
'Befehl PULLUP 21 hex = 33 dez.
'Einschalten der Pulup-Widerstände

SENDBYTE (33)      'Befehl 33
SENDBYTE (1)       'Frame Anzahl = 1
SENDBYTE (1)       '1 = PullUp's EIN
SENDBYTE (4)       'Endekennung

If Modem_Antwort = False Then
    MsgBox ("Fehler bei PULLUP EIN")
End If

End Sub

Private Sub Command_PULLUP_AUS_Click()
'Befehl PULLUP 21 hex = 33 dez.
'Einschalten der Pulup-Widerstände

SENDBYTE (33)      'Befehl 18 = Call
SENDBYTE (1)       'Frame Anzahl = 1
SENDBYTE (0)       'PullUp's EIN
SENDBYTE (4)       'Endekennung

If Modem_Antwort = False Then
    MsgBox ("Fehler bei PULLUP AUS")
End If

End Sub

Private Sub Command_SPEED_Click()
'Befehl 32: I2C-Speed 22 hex = 34 dez.
'Die Geschwindigkeit am I2C-Buss wird auf den gewünschten Wert
'eingestellt.Der Defaultwert ist Null und stellt die 
'maximale Busgeschwindigkeit ein.
Dim Wert

SENDBYTE (34)      'Befehl 18 = I2C-SPEED
SENDBYTE (0)       'Frame Anzahl = 0
SENDBYTE (4)       'Endekennung


If Modem_Antwort = True Then
    Wert = D(2) * 256 + D(1)    'High-Byte * 256 + Low Byte
    TextBox_SPEED.Text = Fix(1 / (Wert * 0.0000004)) & " Hz"
Else
    MsgBox ("Fehler bei SPEED lesen")
End If

End Sub

Private Sub Command_SPEED_SET_Click()
'Befehl SPEED 22 hex = 34 dez.
'Mit diesem Befehl kann die Taktgeschwindigkeit des I2C-Bus zwischen
'350 kHz und 40 Hz eingestellt werden.
'Dabei handelt es sich um einen zwei Byte großen Wert,
'der mit dem LSB voran im Datenblock abzulegen ist.

Dim Takt, Wert As Integer
Dim HBy, LBy As Byte

Takt = Val(Combo_SPEED.Text) * 1000

Wert = 1 / (Takt * 0.0000004)

HBy = Fix(Wert / 256)   'high-Byte berechnen
LBy = Wert - HBy * 256  'low-Byte berechnen

SENDBYTE (34)      'Befehl 34
SENDBYTE (2)       'Frame Anzahl = 2
SENDBYTE (LBy)     'low-Byte senden
SENDBYTE (HBy)     'high-Byte senden
SENDBYTE (4)       'Endekennung

If Modem_Antwort = False Then
    MsgBox ("Fehler bei SPEED SET")
End If

End Sub

Private Sub Command_I2C_GET_Click()
'Befehl I2C-GET 32 hex = 50 dez.
'Mit diesem Befehl kann der aktuellen Zustand der
'I2C-Bussignale SDA SCL und INT abgefragt werden.

SENDBYTE (50)      'Befehl 50 = Statusabfrage
SENDBYTE (0)       'Frame Anzahl = 0
SENDBYTE (4)       'Endekennung

If Modem_Antwort = True Then
    If (D(1) And 1) > 0 Then
       TextBox_STATUS_SDA.BackColor = vbGreen
    Else
       TextBox_STATUS_SDA.BackColor = vbWhite
    End If
    
    If (D(1) And 2) > 0 Then
       TextBox_STATUS_SCL.BackColor = vbYellow
    Else
       TextBox_STATUS_SCL.BackColor = vbWhite
    End If
    
    If (D(1) And 4) > 0 Then
       TextBox_STATUS_INT.BackColor = vbWhite
    Else
       TextBox_STATUS_INT.BackColor = vbRed
    End If
Else
    MsgBox ("Fehler bei I2C_GET")
End If

End Sub

Private Sub Command_SCHREIBEN_Click()
'Der Befehl I2C-Data 33 hex = 51 dez.
'liest oder schreibt bis zu 128 Bytes vom I2C-Slave

Dim W, Adr
Adr = Combo_SAdresse.Text   'Adresse aus Cobo-Box

On Error GoTo ErrorHandler  'Für falsche Eingaben im Feld

If TextBox_SWert.Text > 255 Then
    MsgBox ("Im Feld WERT nur Zahlen <= 255 erlaubt")
Else
    If CheckBox_Sinv.Value = True Then
      W = 255 - TextBox_SWert.Text  'Ausgabewert invertieren
    Else
      W = TextBox_SWert.Text        'Ausgabewert direkt zum Portbaustein
    End If

    SENDBYTE (51)  'Befehl 51 = Daten senden
    SENDBYTE (3)   'Frame Anzahl = 3
    SENDBYTE (Adr) 'Bus-Adresse des PCF 8574
    SENDBYTE (0)   'Adresse MSB
    SENDBYTE (W)   'Wert ausgeben
    SENDBYTE (4)   'Endekennung
End If

If Modem_Antwort = False Then
    MsgBox ("Fehler bei I2C-DATA")
End If

ErrorHandler:
Select Case ERR.Number              'Fehlernummer auswerten.
    Case 0 'ok
    Case 13
         MsgBox ("Im Feld WERT nur Zahlen erlaubt")
         TextBox_SWert.Text = ""
    Case Else
        MsgBox ("Fehler " & ERR.Number)
    End Select

End Sub

Private Sub Command_LESEN_Click()
'Der Befehl I2C-Data 33 hex = 51 dez.
'liest oder schreibt bis zu 128 Bytes vom I2C-Slave
Dim Adr
Adr = Combo_LAdresse.Text   'Adresse aus Cobo-Box

SENDBYTE (51)      'Befehl 51 = I2C-DATA
SENDBYTE (3)       'Frame Anzahl = 3
SENDBYTE (Adr)     'Bus-Adresse des PCF 8574
SENDBYTE (0)       'Adresse MSB
SENDBYTE (1)       '1 Byte lesen
SENDBYTE (4)       'Endekennung

If Modem_Antwort = True Then
    If CheckBox_Linv.Value = True Then
      TextBox_LWert.Text = 255 - D(1)  'Wert in Textbox eintragen invertiert
    Else
      TextBox_LWert.Text = D(1)        'Wert in Textbox eintragen
    End If
Else
    MsgBox ("Fehler bei I2C-DATA")
End If

End Sub

Private Sub Command_EPROM_LESEN_Click()
'Der Befehl I2C-Data 33 hex = 51 dez.
'liest oder schreibt bis zu 128 Bytes vom I2C-Slave
Dim Adr, Text, i
Adr = Combo_EPROM_Adresse.Text  'Adresse aus Cobo-Box

'bevor vom Eprom gelesen werden kann muss die Registeradresse
'eingestellt werden. Dies erfolgt über einen Schreibbefehl
'ohne Daten auf das Eprom
SENDBYTE (51)      'Befehl 51 = Data
SENDBYTE (3)       'Frame Anzahl = 3
SENDBYTE (Adr)     'Adresse LSB lesen
SENDBYTE (0)       'Adresse HSB
SENDBYTE (0)       'Registeradresse
SENDBYTE (4)       'Endekennung

If Modem_Antwort = False Then
    MsgBox ("Fehler beim Register einstellen")
    Exit Sub
End If

'jetzt können gleich alle 16 Zeichen abgeholt werden
SENDBYTE (51)      'Befehl 51 = Data
SENDBYTE (3)       'Frame Anzahl = 3
SENDBYTE (Adr + 1) 'Adresse LSB lesen
SENDBYTE (0)       'Adresse HSB
SENDBYTE (16)      '16 Bytes lesen
SENDBYTE (4)       'Endekennung

'Antwort vom Modem lesen
If Modem_Antwort = True Then
    Text = ""
    For i = 1 To 16   'Text aus den Daten zusammensetzen
       Text = Text & Chr$(D(i))
    Next i
    'Text eintragen
    TextBox_EPROM.Text = Text
Else
    MsgBox ("Fehler bei Eprom lesen")
End If

End Sub

Private Sub Command_EPROM_SCHREIBEN_Click()
'Der Befehl I2C-Data 33 hex = 51 dez.
'liest oder schreibt bis zu 128 Bytes vom I2C-Slave
Dim i, Adr, Text, Zeichen
Adr = Combo_EPROM_Adresse.Text

'eingegebener Text auf min. 16 Zeichen verlängern
Text = TextBox_EPROM & Space(16)

'die Daten zum Eprom müssen in zwei Schritten zu je
'8 Byte geschrieben werden

'Befehl zum I2C-USB-Modem schicken
SENDBYTE (51)   'Befehl 51 = Data
SENDBYTE (11)   '2 Adresse + 1 Start 8 Daten
SENDBYTE (Adr)  'Adresse des EEproms
SENDBYTE (0)    'Adresse HSB
SENDBYTE (0)    'Startadresse im Eprom
For i = 1 To 8
    Zeichen = Mid(Text, i, 1)  'ein Zeichen aus Text
    SENDBYTE (Asc(Zeichen))    'abschicken
Next i
SENDBYTE (4)      'Endekennung

'Antwort vom Modem lesen
If Modem_Antwort = False Then
    TextBox_EPROM.Text = "Fehler"
End If

'Befehl zum I2C-USB-Modem schicken
SENDBYTE (51)   'Befehl 51 = Data
SENDBYTE (11)   '2 Adresse + 1 Start 8 Daten
SENDBYTE (Adr)  'Adresse des EEproms
SENDBYTE (0)    'Adresse HSB

SENDBYTE (8)    'Startadresse im Eprom

For i = 9 To 16
    Zeichen = Mid(Text, i, 1)   'ein Zeichen aus Text
    SENDBYTE (Asc(Zeichen))    '5 Bytes lesen
Next i

SENDBYTE (4)      'Endekennung

'Antwort vom Modem lesen
If Modem_Antwort = False Then
    TextBox_EPROM.Text = "Fehler"
End If

End Sub

Private Sub Command_OpenCom_Click()
Dim A, I
Dim ok As Boolean
Dim Handle, cP As Long
Dim strDescription As String * 256

'Farben für Statusfenster belegen
stgn = &HC0FFC0   'Statusfarbe hellgrün
strd = &HC0C0FF   'Statusfarbe hellrot

'Prüfen ob FTDI-Chip am USB-Bus vorhanden ist
Call FT_CreateDeviceInfoList(A)

If A = 0 Then
    MsgBox ("Kein I2C-USB-Modem angeschlossen")
Else
  If Command_OpenCom.Caption = "COM öffnen" Then
    
    'prüfen ob ein USB-Modem angeschlossen ist
    ok = False
    For I = 0 To A - 1

      Call FT_ListDevices(I, strDescription, _
      FT_LIST_BY_INDEX Or FT_OPEN_BY_DESCRIPTION)
       
      If InStr(1, strDescription, "USB Modem") Then
        ok = True
        Call FT_OpenEx(strDescription, _
        FT_OPEN_BY_DESCRIPTION, Handle)
        
        Call FT_GetComPortNumber(Handle, cP)
        Call FT_Close(Handle)
        Exit For
      End If
    Next I
    
    If ok = False Then
      MsgBox ("Kein I2C-USB-Modem angeschlossen")
      Exit Sub
    End If
    
    Cells(3, 3) = "COM" & cP & ":" & "115200,n,8,1"
    'Serielle Schnittstelle öffnen
    If OPENCOM("COM" & cP & ":" & "115200,n,8,1") = 0 Then
        MsgBox ("Fehler, kann COM" & cP & " nicht öffnen")
    End If
    'Buttons einbelnden
    Command_OpenCom.Caption = "COM schließen"
    Command_CALL.Visible = True
    Command_PULLUP.Visible = True
    Command_PULLUP_EIN.Visible = True
    Command_PULLUP_AUS.Visible = True
    Command_SPEED.Visible = True
    Command_SPEED_SET.Visible = True
    Command_VERSION.Visible = True
    Command_I2C_GET.Visible = True
    Command_LESEN.Visible = True
    Command_SCHREIBEN.Visible = True
    Command_EPROM_SCHREIBEN.Visible = True
    Command_EPROM_LESEN.Visible = True
    STATUS_Text.Text = "online über COM" & cP
    STATUS_Text.BackColor = stgn
  Else
    'Serielle Schnittstelle schließen
    CLOSECOM
    'Buttons ausbelnden
    Command_OpenCom.Caption = "COM öffnen"
    Command_CALL.Visible = False
    Command_PULLUP.Visible = False
    Command_PULLUP_EIN.Visible = False
    Command_PULLUP_AUS.Visible = False
    Command_SPEED.Visible = False
    Command_SPEED_SET.Visible = False
    Command_VERSION.Visible = False
    Command_I2C_GET.Visible = False
    Command_LESEN.Visible = False
    Command_SCHREIBEN.Visible = False
    Command_EPROM_SCHREIBEN.Visible = False
    Command_EPROM_LESEN.Visible = False
    TextBox_STATUS_SDA.BackColor = vbWhite
    TextBox_STATUS_SCL.BackColor = vbWhite
    TextBox_STATUS_INT.BackColor = vbWhite
    TextBox_VERSION.Text = "Version ?.?"
    TextBox_SPEED.Text = ""
    TextBox_CALL.Text = ""
    STATUS_Text.Text = "offline"
    Cells(3, 3) = ""
    STATUS_Text.BackColor = vbWhite
    STATUS_Antwort = ""
    STATUS_Bytes = ""
    TextBox_PULLUP.Text = ""
  End If
End If

End Sub

Private Function Modem_Antwort()
Dim i, T
DELAY 150       '150ms warten bis alle Daten angekommen sind

FB = READBYTE   'Antwort Befehl
FA = READBYTE   'Antwort Länge
STATUS_Bytes.Text = FA

For i = 1 To FA
    D(i) = READBYTE 'Daten vom USB-Modem lesen
Next i

FE = READBYTE   'Ende-Kennung vom Modem

If FE <> 4 Then 'Testen FE=EOT
    MsgBox "EOT <> 04!"
    'Empfangsbuffer leeren
    Do: T = READBYTE: Loop Until T = -1
End If

T = READBYTE    'Testen ob der Empfangsbuffer leer ist
If T <> -1 Then
    MsgBox "Zu viele Daten im Empfangsbuffer"
    'Empfangsbuffer leeren
    Do: T = READBYTE: Loop Until T = -1
End If

i = FB And 15

If i = 10 Then
    STATUS_Text.Text = "ok"
    STATUS_Text.BackColor = stgn
    Modem_Antwort = True
Else
    STATUS_Text.BackColor = strd
    Modem_Antwort = False
    
    Select Case D(1)   'Fehlercode liegt im ersten Datenbyte
    Case 1
        STATUS_Text.Text = "alles OK"
    Case 2
        STATUS_Text.Text = "Gruppenadresse ungültig"
    Case 2
        STATUS_Text.Text = "Kommando ungültig"
    Case 4
        STATUS_Text.Text = "Datenblock-Länge ungültig"
    Case 5
        STATUS_Text.Text = "Dtaneblocklänge zu groß"
    Case 6
        STATUS_Text.Text = "EOT fehlt am Ende des Frames"
    Case 7
        STATUS_Text.Text = "Als EOT wurde nicht 04 gesendet"
    Case 8
        STATUS_Text.Text = "Zeitüberschreitung beim Senden des Datenblocks"
    Case 16
        STATUS_Text.Text = "Version Kommando ist falsch aufgebaut."
    Case 17
        STATUS_Text.Text = "Zu viele Daten beim Befehl Call-Modem"
    Case 32
        STATUS_Text.Text = "kein Slave an der Adresse"
    Case 33
        STATUS_Text.Text = "Der Slave hat auf das Acknolw. nicht reagiert"
    Case 34
        STATUS_Text.Text = "Zeitüberschreitung beim Clock-Stretch"
    Case 255
        STATUS_Text.Text = "Kommando unbekannt"
        
    Case Else
        STATUS_Text.Text = "FEHLER " & D(1)
        
    End Select
End If

'Antwort-Frame in die Textbox eingetragen

'Befehl
STATUS_Antwort.Text = Right("00" & Hex(FB), 2) & ","
'Anzahl
STATUS_Antwort.Text = STATUS_Antwort.Text & Right("00" & Hex(FA), 2) & ","
'Daten
For i = 1 To FA
    STATUS_Antwort.Text = STATUS_Antwort.Text & _
    Right("00" & Hex(D(i)), 2) & ","
Next i
'Ende Kennung
STATUS_Antwort.Text = STATUS_Antwort.Text & Right("00" & Hex(FE), 2)

End Function

Programmbeispiel als Excel Makro (VBA)

	I2C-USB-Modem-Test.xls und port.dll (118 kB) Excel-Makro mit den Grundfunktionen des Modems und je einem Beispiel zur Ansteuerung der I2C-Ausgabekarte, I2C-Eingabekarte, und einem Eprom.
	Hier ein Link zur Beschreibung der "FTD2XX.DLL" direkt auf der Homepage von FTDI D2XX Programmer's Guide (ca. 750 kb)

Bausätze können Sie günstig in unserem Onlineshop in der Rubrik
"I2C-Komponenten" bestellen.

I2C-USB-Modem Programmierbeispiele

Kommunikation zum I2C-Bus über ein Excel-Makro mit "port.dll"