module1.bas

用VB通过并口控制I2C总线

Attribute VB_Name = "Module1"
'Public Declare Function GetTickCount Lib "kernel32" () As Long
Global LptIic As LptI2C
Global LPTini As LPT
Global SDAIn As Byte
Global SDAOut As Byte
Global SDAOutCPL As Byte
Global SDAInCPL As Byte
Global SCLIn As Byte
Global SCLOut As Byte
Global SCLOutCPL As Byte
Global SCLInCPL As Byte
Global SDAFindOut As Boolean
Global SCLFindOut As Boolean
'延时 TT ms 子程序
'Sub TimeDelay(TT As Long)
'  Dim t As Long
'  t = GetTickCount()
'  Do
'    DoEvents
'    If GetTickCount - t < 0 Then t = GetTickCount
'  Loop Until GetTickCount - t >= TT
'End Sub
Public Function IicReadByte(ByVal SlaveAddr As Byte, ByVal RegAddr As Byte) As Byte
    Dim r As Byte
    Dim BusTryCnt As Byte
    BusTryCnt = 5
    LptIic.IicError = False
    Do
        LptIic.IicStart SlaveAddr
        LptIic.IicSendByte RegAddr
        LptIic.IicStart (SlaveAddr + 1)
        r = LptIic.IicReceiveByte
        If LptIic.IicError = False Then
            Exit Do
        End If
        BusTryCnt = BusTryCnt - 1
    Loop While (BusTryCnt)
    IicReadByte = r
End Function
Public Function SearchIicTool() As Boolean
Dim i As Byte
Dim j As Byte
Dim tempIn As Byte
Dim tempOut As Byte

If LPTini.OpenLPT = False Then
   MsgBox "LPT open faile"
   Exit Function
End If
'=================================================================================
For i = 0 To 7 Step 1

'-------------------------------------------------------
For j = 0 To 7 Step 1
LPTini.SetLptBit 888, i
If LPTini.GetLptBit(889, j) = True Then
'--------------------------------------
   LPTini.ClrLptBit 888, i
   If LPTini.GetLptBit(889, j) = False Then
      If SDAFindOut = False Then
         SDAOut = i
         SDAIn = j
         SDAFindOut = True
      Else
         SCLOut = i
         SCLIn = j
         SCLFindOut = True
      End If
   Exit For
   End If
'--------------------------------------
Else
'-------------------------------
   LPTini.ClrLptBit 888, i
   If LPTini.GetLptBit(889, j) Then
      If SDAFindOut = False Then
         SDAOut = i
         SDAIn = j
         SDAFindOut = True
      Else
         SCLOut = i
         SCLIn = j
         SCLFindOut = True
      End If
   Exit For
   End If
'-------------------------------
End If
Next
'--------------------------------------------------------
If SDAFindOut = True And SCLFindOut = True Then
   Exit For
End If
Next
'==============================================================================
If SDAFindOut = True And SCLFindOut = True Then
'Form1.Text1 = CStr(SDAOut) & CStr(SDAIn) & CStr(SCLOut) & CStr(SCLIn)
'SearchIicTool = True
Else
SearchIicTool = False
Exit Function
End If

If DerictI2cBus(0, 0, 0, 0) = True Then
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(0, 0, 0, 1) = True Then '1
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(0, 0, 1, 0) = True Then '2
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(0, 0, 1, 1) = True Then '3
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(0, 1, 0, 0) = True Then '4
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(0, 1, 0, 1) = True Then '5
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(0, 1, 1, 0) = True Then '6
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(0, 1, 1, 1) = True Then '7
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(1, 0, 0, 0) = True Then '8
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(1, 0, 0, 1) = True Then '9
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(1, 0, 1, 0) = True Then '10
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(1, 0, 1, 1) = True Then '11
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(1, 1, 0, 0) = True Then '12
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(1, 1, 0, 1) = True Then '13
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(1, 1, 1, 0) = True Then '14
   SearchIicTool = True
   Exit Function
ElseIf DerictI2cBus(1, 1, 1, 1) = True Then '15
   SearchIicTool = True
   Exit Function
End If
   SearchIicTool = False
End Function
Public Function DerictI2cBus(ByVal tempSDAInCPL As Byte, ByVal tempSDAOutCPL As Byte, ByVal tempSCLInCPL As Byte, ByVal tempSCLOutCPL As Byte) As Boolean
LptIic.SDA_In_Config 889, SDAIn, tempSDAInCPL
LptIic.SDA_Out_Config 888, SDAOut, tempSDAOutCPL
LptIic.SCL_In_Config 889, SCLIn, tempSCLInCPL
LptIic.SCL_Out_Config 888, SCLOut, tempSCLOutCPL
LptIic.IicError = False
LptIic.IicStart (160)
'LptIic.IicStop
'TimeDelay 20
 If LptIic.IicError = False Then
    SDAInCPL = tempSDAInCPL
    SDAOutCPL = tempSDAInCPL
    SCLInCPL = tempSCLInCPL
    SCLOutCPL = tempSCLOutCPL
    Form1.Text1.Text = "889," & CStr(SDAIn) & "," & CStr(SDAInCPL) & vbCrLf
    Form1.Text1.Text = Form1.Text1.Text & "888," & CStr(SDAOut) & "," & CStr(SDAOutCPL) & vbCrLf
    Form1.Text1.Text = Form1.Text1.Text & "889," & CStr(SCLIn) & "," & CStr(SCLInCPL) & vbCrLf
    Form1.Text1.Text = Form1.Text1.Text & "888," & CStr(SCLOut) & "," & CStr(SCLOutCPL) & vbCrLf
    DerictI2cBus = True
    Exit Function
 End If
 '----------------------------
 tempIn = SDAIn 'SCL,SDA互换
 tempOut = SDAOut
 SDAIn = SCLIn
 SDAOut = SCLOut
 SCLIn = tempIn
 SCLOut = tempOut
 '---------------------------
 LptIic.SDA_In_Config 889, SDAIn, tempSDAInCPL
LptIic.SDA_Out_Config 888, SDAOut, tempSDAOutCPL
LptIic.SCL_In_Config 889, SCLIn, tempSCLInCPL
LptIic.SCL_Out_Config 888, SCLOut, tempSCLOutCPL
LptIic.IicError = False
LptIic.IicStart (160)
'LptIic.IicStop
'TimeDelay 20
 If LptIic.IicError = False Then
    SDAInCPL = tempSDAInCPL
    SDAOutCPL = tempSDAOutCPL
    SCLInCPL = tempSCLInCPL
    SCLOutCPL = tempSCLOutCPL
    Form1.Text1.Text = "889," & CStr(SDAIn) & "," & CStr(SDAInCPL) & vbCrLf
    Form1.Text1.Text = Form1.Text1.Text & "888," & CStr(SDAOut) & "," & CStr(SDAOutCPL) & vbCrLf
    Form1.Text1.Text = Form1.Text1.Text & "889," & CStr(SCLIn) & "," & CStr(SCLInCPL) & vbCrLf
    Form1.Text1.Text = Form1.Text1.Text & "888," & CStr(SCLOut) & "," & CStr(SCLOutCPL) & vbCrLf
    DerictI2cBus = True
    Exit Function
 End If
 DerictI2cBus = False
End Function