www.pudn.com > LPT_I2C.rar > Module1.bas

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