ds9123.frm

利用VB开发的针对Maxim-Dallas DS2770电量检测芯片

    sndbyt(0) = data
    MSComm1.Output = sndbyt
    If data = &HE3 Then   'Must send these command twice becuase they will
        MSComm1.Output = sndbyt                     '   be swallowed by the DS2480 if only sent once
    End If
    start = Timer
    While MSComm1.InBufferCount < 1     'Wait to get a response back
        If ((Timer - start) > 1) Or Timer < 10 Then
            Exit Sub
        End If
    Wend
    DummyBuff = MSComm1.Input       'Swallow the Byte returned
    Debug.Print Hex(sndbyt(0))
End Sub

' ReadData
'
' Reads data from the one wire bus.
'
' Returns: The byte that was read.
'
Function ReadData() As Byte
Dim InBuffer() As Byte
Dim start As Single
    MSComm1.Output = Chr$(&HFF)     'Sends &HFF to read byte
    
    start = Timer
    While MSComm1.InBufferCount < 1     'Wait to get a response back
        If ((Timer - start) > 1) Or Timer < 10 Then
            ReadData = 0
            Exit Function
        End If
    Wend
    InBuffer = MSComm1.Input        'Captures Data that is read
    ReadData = InBuffer(0)          'Returns byte
End Function

' OneWireReset
'
' Issues a one wire reset, then looks for a presence pulse.
'
' Returns: True if presence found; False if no parts found.
'
Function OneWireReset() As Boolean
Dim InBuffer() As Byte
Dim start As Single
Dim MaskedByte As Byte
    CommandMode2480             'Put Ds2480 in command mode
    sndbyt(0) = &HC1
    MSComm1.Output = sndbyt 'Send command to generate Reset Pulse
    start = Timer               'Mark Time this starts
    While MSComm1.InBufferCount < 1 'Wait for response
        If (Timer > (start + 2)) Or (Timer < 10) Then
            OneWireReset = False    'If no response within 2 seconds, then return False
            Exit Function
        End If
    Wend
    InBuffer = MSComm1.Input    'Capture byte that is returned
    
    MaskedByte = InBuffer(0) Or &H3C
    'The following are valid responses for a Reset Pulse
  
    If MaskedByte = &HFD Then
        OneWireReset = True
    Else
        OneWireReset = False
    End If


End Function

' SkipROM
'
' Issues the one wire Skip ROM command.
'
' Returns: nothing.
'
Sub SkipROM()
    DataMode2480                'data mode
    sndbyt(0) = &HCC
    SendData (&HCC)             'Skip ROM Command
End Sub

' MatchROM
'
' Issues the one wire Match ROM command, and sends the ROM code to match.
'
' Returns: nothing.
'
Function MatchROM(ROMNumber() As Byte)  'Send the ROMCode Number to be matched
Dim i As Integer
    DataMode2480                'Set DS2480 into Data Mode
    sndbyt(0) = &H55
    SendData (&H55)
    For i = 1 To 8 Step 1
        SendData (ROMNumber(i)) 'Sends 8 bytes of ROM Code
    Next i
End Function


' ReadROM
'
' Issues the one wire Read ROM command, and reads back the ROM code.
'
' Returns: An eight-byte array with the ROM code.
'
Function ReadROM() As Variant
Dim i As Integer
Dim tPad As String
Dim InBuffer() As Byte
Dim DummyBuff() As Byte
Dim ROMArray(8) As Byte

    DataMode2480            'data mode
    SendData (&H33)         'read ROM command
        
    ' now read the ROM code
    For i = 1 To 8 Step 1   'Loops 8 times for each byte of ROM Code
        MSComm1.Output = Chr$(&HFF)     'Sends &HFF to Read Byte
        wait = Timer
        While MSComm1.InBufferCount < 1     'Waits for Recieve response
            If ((Timer - wait) > 2) Or (Timer < wait) Then
                Exit Function
            End If
        Wend
        InBuffer = MSComm1.Input        'Captures byte returned
        ROMArray(i) = InBuffer(0)       'Sets ROMArray with byte read
    Next i
    
    ReadROM = ROMArray  'Returns the 8 byte ROM Code
End Function

Function ReadROM39h() As Variant
Dim i As Integer
Dim tPad As String
Dim InBuffer() As Byte
Dim DummyBuff() As Byte
Dim ROMArray(8) As Byte

    DataMode2480            'data mode
    SendData (&H39)         'read ROM command
        
    ' now read the ROM code
    For i = 1 To 8 Step 1   'Loops 8 times for each byte of ROM Code
        MSComm1.Output = Chr$(&HFF)     'Sends &HFF to Read Byte
        While MSComm1.InBufferCount < 1 'Waits for response
        Wend
        InBuffer = MSComm1.Input        'Captures byte returned
        ROMArray(i) = InBuffer(0)       'Sets ROMArray with byte read
    Next i
    
    ReadROM39h = ROMArray  'Returns the 8 byte ROM Code
End Function
' UnwrapNybble
'
' Used by SearchROM, this routine extracts 4 bits from the eight
' bits returned by the DS2480
'
' Returns: A byte with lower four bits filled with nybble.
'
Function UnwrapNybble(nybbleByte As Byte) As Byte
    Dim bit0, bit1, bit2, bit3 As Byte
    
    bit0 = (nybbleByte And 2) / 2
    bit1 = (nybbleByte And 8) / 4
    bit2 = (nybbleByte And 32) / 8
    bit3 = (nybbleByte And 128) / 16
    
    UnwrapNybble = (bit3 Or bit2 Or bit1 Or bit0)
End Function

' SearchROM
'
' Executes the entire Search ROM algorithm, finding all one-wire
' devices attached to the bus.
'
' Returns: A two dimensional array of bytes. First dimension is
' variable, depending upon the number of devices found. The second
' dimension is 8, corresponding to the 8 bytes in each found ROM.
'
Function SearchROM() As Variant

Dim tLastRecvd(1 To 16) As Byte
Dim tCharInput() As Byte
Dim tLastDiscrep As Byte
Dim tLastDiscrepNum As Byte
Dim tCurrDiscrepNum As Byte
Dim tDone As Boolean
Dim tLDBitNext As Byte
Dim k As Integer
Dim tDiscrepByte As Byte
Dim i As Byte
Dim B As Byte
Dim tSendByte As Byte
Dim sendByte As String
Dim tDiscrepTest As Byte
Dim j As Byte
Dim tROMLowNybble As Byte
Dim tROMHighNybble As Byte
Dim tROM As Byte
Dim tPad As String
Dim ROMArray() As Variant
Dim ROMCode(8) As Byte
Dim tFirst As Boolean
Dim tDiscrepFound As Boolean

Dim m As Byte
Dim n As Variant

Dim d As Byte
Dim tMask As Byte
Dim tNextDiscrep(16) As Byte
Dim tNext As Byte


    tLastDiscrep = 0
    tLastDiscrepNum = 0
    tCurrDiscrepNum = 0
    tDone = False
    tDiscrepFound = False
    n = 0
    tLDBitNext = 1
    tDiscrepByte = 0
    k = 1
    tFirst = True
    
    For i = 1 To 16 Step 1
        tLastRecvd(i) = 0
    Next i
        
    Do While Not tDone
        ' First, check to see if there's parts out there
        If Not OneWireReset() Then
            ReDim ROMArray(1) As Variant    'if none are found, fill array with zeros
            ROMArray(1) = Array(0, 0, 0, 0, 0, 0, 0, 0)
            Exit Do
        End If
        
        ' then, issue the Search ROM command
        SearchROMOn
        
        ' step through sending/receiving 16 bytes
        For i = 1 To 16 Step 1
            If i < tLastDiscrep Then
                tSendByte = tLastRecvd(i)
            End If
            
            If i = tLastDiscrep Then
                If tNextDiscrep(i) = 0 Then
                    tDone = True
                End If
                tSendByte = tNextDiscrep(i)
                    
            End If
            
            If i > tLastDiscrep Then
                tSendByte = 0
            End If
            
            sendByte = "&H" & Hex$(tSendByte)
            MSComm1.Output = Chr$(sendByte)
            
          
            If tSendByte = &HE3 Then ' Or tSendByte = &HE1 Or tSendByte = &HF3 Then
                MSComm1.Output = Chr$(sendByte)
            End If
            
            
            wait = Timer
            While MSComm1.InBufferCount < 1     'Waits for Recieve response
                If ((Timer - wait) > 2) Or (Timer < wait) Then
                    Exit Function
                End If
            Wend
            
            tCharInput = MSComm1.Input
            tLastRecvd(i) = tCharInput(0)
            
        Next i
' here we decide where the discrepancy is and what to do about it
        For n = 16 To 1 Step -1
            tDiscrepTest = tLastRecvd(n) And 85
            If tDiscrepTest <> 0 Then
                If ((tLastRecvd(n) And &HC0) = &H40) Then
                    tNextDiscrep(n) = (tLastRecvd(n) And &H7F) Or &H80
                ElseIf ((tLastRecvd(n) And &H30) = &H10) Then
                    tNextDiscrep(n) = (tLastRecvd(n) And &H1F) Or &H20
                ElseIf ((tLastRecvd(n) And &HC) = &H4) Then
                    tNextDiscrep(n) = (tLastRecvd(n) And &H7) Or &H8
                ElseIf ((tLastRecvd(n) And &H3) = &H1) Then
                    tNextDiscrep(n) = (tLastRecvd(n) And &H1) Or &H2
                Else
                    tDiscrepFound = True
                    tNextDiscrep(n) = 0
                End If
                If tDiscrepFound = False Then
                    tLastDiscrep = n
                    Exit For
                End If
            End If
            tDiscrepFound = False
        Next n
    
        If tLastDiscrep = 0 Then
            tDone = True
        End If
 
        ' go back to regular command mode
        SearchROMOff
           
        If (Not tDone) Or tFirst Then
            m = 1
            ' assemble the actual ROM code
            For j = 1 To 15 Step 2
                tROMLowNybble = UnwrapNybble(tLastRecvd(j))
                tROMHighNybble = UnwrapNybble(tLastRecvd(j + 1))
                tROM = (16 * tROMHighNybble) Or tROMLowNybble
                ROMCode(m) = tROM
                m = m + 1
            Next j
        
            ReDim Preserve ROMArray(k) As Variant
        
            ROMArray(k) = ROMCode
            k = k + 1
        End If
        tFirst = False
    Loop
    
    FoundROMs = ROMArray
    If FoundROMs(1)(1) <> 0 Then
        For B = 1 To UBound(FoundROMs, 1) Step 1
'MsgBox Hex(FoundROMs(b)(8)) & " " & Hex(FoundROMs(b)(7)) & " " & Hex(FoundROMs(b)(6)) _
& " " & Hex(FoundROMs(b)(5)) & " " & Hex(FoundROMs(b)(4)) & " " & Hex(FoundROMs(b)(3)) _
& " " & Hex(FoundROMs(b)(2)) & " " & Hex(FoundROMs(b)(1))

            If ((FoundROMs(B)(1)) = &H12) Or ((FoundROMs(B)(1)) = &H92) Then
                Read2407EPROM (B)
            End If
        Next B
    End If
    
    SearchROM = ROMArray
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This section contains all the commands that support 2-wire protocol.
' This assumes the use of a DS2480.
'
'
'
'AccessGP2
'
' Selects DS2407 which handles SDA/DQ and SCL/CLK.
'   Sets up the part to read the current state, and only change
'       one line, leaving the other in the existing state
' Returns: True if part found, False if not.
'
Function AccessGP2() As Boolean
    AccessGP2 = False
    
    If (OneWireReset()) Then
        MatchROM (FoundROMs(ROM2Wire))

        SendData (&HF5)    'channel access command
        SendData (&H6C)    'Channel Control Byte 1
        SendData (&HFF)    'Channel Control Byte 2
        ReadData           'Dummy Read for Channel Info Byte
        AccessGP2 = True
    End If
End Function

'CLOCKHigh
'
'Sets CLOCK High and leaves DATA in the state that it was found
'
'Returns nothing
'
Sub CLOCKHigh()
Dim ExistingValue As Byte
Dim DataToWrite As Byte

    ExistingValue = ReadData And &H55 'Picks off DATA value
    DataToWrite = ExistingValue Or &HAA 'Sets CLOCK High, leaves DATA alone
    SendData (DataToWrite)
End Sub

'CLOCKLow
'
'Sets CLOCK Low and leaves DATA in the state that it was found
'
'Returns nothing
'
Sub CLOCKLow()
Dim ExistingValue As Byte
Dim DataToWrite As Byte

    ExistingValue = ReadData And &H55 'Picks off DATA value
    DataToWrite = ExistingValue Or &H0 'Sets CLOCK low, leaves DATA alone
    SendData (DataToWrite)
End Sub

'DATAHigh
'
'Sets DATA High and leaves CLOCK in the state that it was found
'
'Returns nothing
'
Sub DATAHigh()
Dim ExistingValue As Byte
Dim DataToWrite As Byte

    ExistingValue = ReadData And &HAA 'Picks off CLOCK value
    DataToWrite = ExistingValue Or &H55 'Sets DATA High, leaves CLOCK alone
    SendData (DataToWrite)
End Sub

'DATALow
'
'Sets DATA Low and leaves CLOCK in the state that it was found
'
'Returns nothing
'
Sub DATALow()
Dim ExistingValue As Byte
Dim DataToWrite As Byte

    ExistingValue = ReadData And &HAA 'Picks off CLOCK value
    DataToWrite = ExistingValue Or &H0 'Sets DATA low, leaves CLOCK alone
    SendData (DataToWrite)
End Sub


' Access2Wire
'
' Selects DS2407 which handles SDA/DQ and SCL/CLK.
'
' Returns: True if part found, False if not.
'
Function Access2Wire() As Boolean
    Access2Wire = False
    
    If (OneWireReset()) Then
        MatchROM (FoundROMs(ROM2Wire))

        SendData (&HF5)    'channel access command
        SendData (&H2C)    'Channel Control Byte 1