?? ds9123.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -