ds9123.frm

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

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form DS9123 
   Caption         =   "DS9123"
   ClientHeight    =   2670
   ClientLeft      =   60
   ClientTop       =   570
   ClientWidth     =   5415
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   2670
   ScaleWidth      =   5415
   StartUpPosition =   1  'CenterOwner
   Visible         =   0   'False
   Begin VB.Frame Frame1 
      Height          =   2652
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5412
      Begin VB.Timer Timer1 
         Enabled         =   0   'False
         Interval        =   10
         Left            =   0
         Top             =   120
      End
      Begin VB.CommandButton cmdSearchROM 
         Caption         =   "Search ROM"
         Height          =   612
         Left            =   240
         TabIndex        =   4
         Top             =   1800
         Width           =   1572
      End
      Begin VB.CommandButton cmdReset2480 
         Caption         =   "Reset DS2480"
         Height          =   612
         Left            =   240
         TabIndex        =   3
         Top             =   1080
         Width           =   1575
      End
      Begin VB.CommandButton cmdOWReset 
         Caption         =   "OneWire Reset"
         Height          =   612
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   1572
      End
      Begin VB.TextBox FoundROM 
         Height          =   2052
         Left            =   2160
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   1
         Top             =   360
         Width           =   3012
      End
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   4200
      Top             =   240
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      InBufferSize    =   2
      InputLen        =   2
   End
   Begin VB.Menu mnuExit 
      Caption         =   "Exit"
   End
   Begin VB.Menu mnuPreferences 
      Caption         =   "Preferences"
   End
End
Attribute VB_Name = "DS9123"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public FoundROMs As Variant
Public ROM2Wire As Integer      'index of 2 wire 2407 ROM
Public ROMGPIO As Integer       'index of other 2407 ROM
Public PrefCommPort As Integer
Public PrefBaudRate As Variant
Public initializing As Boolean
Public PrefChosen As Boolean
Public InitializeLoop As Integer
Dim OWR As Boolean
Dim PortFound As Boolean
Public AdapterError As Boolean
Dim sndbyt(0) As Byte
Dim wait As Double
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Manually sends a 1-Wire Reset and reports the value to the text box on this form
'
Sub cmdOWReset_Click()
    If (OneWireReset()) Then
        FoundROM.Text = "True"
    Else
        FoundROM.Text = "False"
    End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Manually Resets the Device
'
Sub cmdReset2480_Click()
    Reset2480
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Manually begins a search ROM and displays found ROM Code in the text box on this form
'
Sub cmdSearchROM_Click()
Dim tPad As String
Dim i As Integer
Dim j As Byte
    
    FoundROM.Text = ""          'Clears FoundROM text box
    FoundROMs = SearchROM()     'Performs SearchROM and puts in FoundROMs array
    
    If FoundROMs(1)(1) <> 0 Then                    'If any ROMs are found, then proceed
        For i = 1 To UBound(FoundROMs, 1) Step 1    'Loops as many times as ROM Numbers found
            For j = 1 To 8 Step 1                   'Loops to read each byte in the 8 byte ROM Code
                If FoundROMs(i)(j) < &H10 Then      'If the byte is a single digit, then add a
                    tPad = "0"                      '      "0" to the front of byte for display purposes
                Else
                    tPad = ""
                End If
                FoundROM.Text = FoundROM.Text + tPad + Hex$(FoundROMs(i)(j)) 'Updates the FoundROM textbox a byte at a time
            Next j
            
            'If the ROM Code is one of the two in the DS9123, then the following
            '   text will be added to FoundROM textbox to identify the device
            If (i = ROM2Wire) Then
                FoundROM.Text = FoundROM.Text & "   ROM2Wire"
            ElseIf (i = ROMGPIO) Then
                FoundROM.Text = FoundROM.Text & "   ROMGPIO"
            End If
            
            FoundROM.Text = FoundROM.Text & Chr$(13) & Chr$(10) 'Adds a Carriage Return and Line Feed after each ROM number is displayed
        Next i
    End If
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Initialize() should be performed before any communication is attempted.  This function
'
Function Initialize() As Boolean
Dim InBuffer() As Byte
Dim SelectBaud As Integer
Dim i As Long
    Initialize = True   'Sets Initialize as true and if it is false by the end of the routine
                        '   then the DS9123 was not initialized properly
    
    initializing = True 'Initializing is true to identify the program is starting up when
                        '   while identifying the MSCommPort
    On Error GoTo CheckError
    
    OpenPref            'Opens Preference file for Comm Port and Baud Rate
    
'    If AdapterError = True Then 'AdapterError is true if cannot find an Adapter, so False is returned
'        Initialize = False
'        Exit Function
'    End If
    
    Select Case PrefBaudRate    'Selects Baud Command to send to the DS2480 to identify baud rate of Port
        Case 9600
            SelectBaud = &H71
        Case 19200
            SelectBaud = &H73
        Case 57600
            SelectBaud = &H75
        Case Else
            SelectBaud = &H71   'Defaults to 9600
    End Select
    
    If PrefCommPort = MSComm1.CommPort Then 'If PrefCommPort matches the last CommPort Selected
        If MSComm1.PortOpen = True Then
            MSComm1.PortOpen = False        'If the Port is Open, then close it
        End If
    Else
        MSComm1.CommPort = PrefCommPort     'If Comm Port has changed, then this sets to the new Port
    End If
    
    'Default MSComm Port Settings
    MSComm1.Settings = "9600,N,8,1" 'Starts at 9600 to initialize DS2480, no Parity, 8 data bits and stop bit
    MSComm1.DTREnable = False
    MSComm1.RTSEnable = True
    MSComm1.Handshaking = comNone
    MSComm1.InputMode = comInputModeBinary
    MSComm1.InBufferSize = 1
    MSComm1.InputLen = 0
    MSComm1.RThreshold = 1
    MSComm1.PortOpen = True
    
    Reset2480   'Must Reset DS2480 prior to any other communication
    
    If MSComm1.PortOpen Then    'If the port is open
        sndbyt(0) = &HC1
        MSComm1.Output = sndbyt 'Send a &HC1 to generate a Reset Pulse
    
        If OneWireReset() Then  'Test for a OneWireReset,
            'if OneWireReset is true then...
            MSComm1.Output = Chr(SelectBaud)   'Send Command for Selected Baud Rate to DS2480
            wait = Timer
            While MSComm1.InBufferCount < 1     'Waits for Recieve response
                If ((Timer - wait) > 2) Or (Timer < wait) Then
                    Initialize = False
                    Exit Function
                End If
            Wend
            InBuffer = MSComm1.Input
            MSComm1.Settings = PrefBaudRate & ", N, 8, 1"   'Sets Comm Port to match DS2480 Baud Rate
        Else
            'if no OneWireReset then Start Initialize routine again
            Reset2480
            InitializeLoop = InitializeLoop + 1
            If InitializeLoop <= 4 Then     'Repeat the Initialize 4 times
                Initialize = False
                Initialize
            Else    'If still no parts acknowledging after 4 loops, the False is returned
                Initialize = False
                Exit Function
            End If
        End If
    Else    'If the port hasn't been opened, give error and return false
        MsgBox "Unable to Open COM Port"
        Initialize = False
        Exit Function
    End If
    
    If OneWireReset() Then
        cmdSearchROM_Click  'Begins a search Rom to identify all 1 wire devices on the DQ line
                            '   and identify the DS2407's in the DS9123 adapter
    Else
        Initialize = False  'Returns false
        Exit Function
    End If
    
    initializing = False    'Indicates Initialze routine has been completed
    Initialize = True       'If the routine made it this far, then it has been initialized
    Exit Function

CheckError:
    If Err.Number = 3 Then Initialize = False 'If get a return without a Gosub error
    Initialize = False
    Err.Clear
    If InitializeLoop < 2 Then  'Loops twice before failing
        InitializeLoop = InitializeLoop + 1     'Increments loop variable
        'PollSerialPorts         'Polls ports to find port with Ds9123 connected to it
        If Initialize() Then    'Restarts Initialize routine
            Initialize = True
            Exit Function
        End If
    Else
        Exit Function
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The DS9123 Universal Brick Form contains all the commands that support
'   the 1,2 and 3 wire protocols
'
'
'

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This section contains all the commands that support the DS2480 ONLY.
'
'
'

' Reset2480
'
' Causes a power-on reset of the DS2480
'
' Returns: nothing.
'
Sub Reset2480()
Dim CurrentSettings As String

    CurrentSettings = MSComm1.Settings  'Stores current settings of MSComm port
    
    MSComm1.Settings = "4800,N,8,1"    'Sets Baud Rate to 4800 for talking to DS2480
    If MSComm1.PortOpen Then            'If the port is open
'        MSComm1.Output = ChrW$(&H0)      'Send a 0 to reset
        sndbyt(0) = &H0
        MSComm1.Output = sndbyt       'Send a 0 to reset
        While MSComm1.OutBufferCount > 0    'Wait for outbuffer to clear
        Wend
    End If
    
    MSComm1.Settings = CurrentSettings  'Restore original settings
End Sub

' CommandMode2480
'
' Puts the DS2480 into command mode by sending &HE3
'
' Returns: nothing.
'
Sub CommandMode2480()
Dim wait As Double
    sndbyt(0) = &HE3
    MSComm1.Output = sndbyt

    If initializing = True Then
        wait = Timer
        While (Timer - wait) < 0.001
            If Timer < wait Then
                wait = Timer
            End If
            'DoEvents
        Wend
    End If
End Sub

' DataMode2480
'
' Puts the DS2480 into data mode by sending &HE1
'
' Returns: nothing.
'
Sub DataMode2480()
Dim wait As Double
    sndbyt(0) = &HE1
    MSComm1.Output = sndbyt
    
    If initializing = True Then
        wait = Timer
        While (Timer - wait) < 0.001
            If Timer < wait Then
                wait = Timer
            End If
            'DoEvents
        Wend
    End If
End Sub

' ProgramPulse2480
'
' Tells the DS2480 to apply a programming pulse by sending &HFD
'
' Returns: nothing.
'
Sub ProgramPulse2480()
Dim wait As Double
    sndbyt(0) = &HFD
    MSComm1.Output = sndbyt
    
    wait = Timer
    While (Timer - wait) < 0.08
        If Timer < wait Then
            wait = Timer
        End If
    Wend
    
End Sub

' SearchROMOn
'
' Puts the DS2480 into data mode, issues Search ROM command, then puts
' the DS2480 into command mode, and turns the search accelerator on. The
' DS2480 is then returned to data mode.
'
' Returns: nothing.
'
Sub SearchROMOn()

    DataMode2480                ' data mode
    SendData (&HF0)            ' F0 = search ROM command
    CommandMode2480
    sndbyt(0) = &HB1
    MSComm1.Output = sndbyt     ' search accelerator on
    DataMode2480
    

End Sub

' SearchROMOff
'
' Puts the DS2480 into command mode, and turns the search accelerator off. The
' DS2480 is left in command mode.
'
' Returns: nothing.
'
Sub SearchROMOff()
    CommandMode2480
    sndbyt(0) = &HA1
    MSComm1.Output = sndbyt      ' search accelerator off
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This section contains all the commands that support the DS 1-wire protocol.
' This assumes the use of a DS2480.
'
'

'Read2407EPROM reads the EPROM of the 2407 and assigns the appropriate
'   identification to distinguish between the DS2407's on the brick and
'   any others that may be out there
'
'
Sub Read2407EPROM(ROMNum As Byte)
Dim i As Byte
Dim IDBuffer(8) As Byte
    If OneWireReset() Then
        MatchROM (FoundROMs(ROMNum))
        'sndbyt(0) = &HF0
        SendData (&HF0) 'read memory command
        'sndbyt(0) = &H0
        SendData (&H0) ' start address 00
        'sndbyt(0) = &H0
        SendData (&H0)  'start address 00
        For i = 0 To 7 Step 1
            IDBuffer(i) = (ReadData())  'Reads contents of EEPROM
        Next i
        
        If IDBuffer(0) = &H44 And IDBuffer(1) = &H53 And IDBuffer(2) = &H39 And _
        IDBuffer(3) = &H31 And IDBuffer(4) = &H32 And IDBuffer(5) = &H33 And _
        IDBuffer(6) = &H53 And IDBuffer(7) = &H44 Then
            ROM2Wire = ROMNum   'EEPROM reads 'DS9123SD'
        ElseIf IDBuffer(0) = &H44 And IDBuffer(1) = &H53 And IDBuffer(2) = &H39 And _
        IDBuffer(3) = &H31 And IDBuffer(4) = &H32 And IDBuffer(5) = &H33 And _
        IDBuffer(6) = &H33 And IDBuffer(7) = &H57 Then
            ROMGPIO = ROMNum    'EEPROM reads 'DS91233W'
        End If
    
        OWR = OneWireReset()
    End If
End Sub

' SendData
'
' Sends out data to one wire bus, and swallows the echoed data.
'
' Returns: nothing.lol'

'
Sub SendData(data As Byte)
Dim DummyBuff() As Byte
Dim cngbyt As Byte
Dim start As Single