DS1820 hőmérő-család lekérdezése (1-Wire hőmérő)
DS1820 hőmérő-család lekérdezése (1-Wire hőmérő)
sziasztok!
olyan kérdéssel fordulnék hozzátok hogy ha van 4db ds1820 as höméröm és tudom mindnek az idjét akkor hogy tudnám öket egyesével lekérdezni?
$regfile = "m8535.dat" ' specify the used micro
$crystal = 11059200 ' used crystal frequen
$baud = 9600
Config 1wire = Portd.2
Echo Off
Declare Sub Init
Declare Sub Convallt
Declare Function Decigrades(byval Sc(9) As Byte) As Integer
Dim B As Byte
Dim W As Word
Dim Dg As Integer
Dim Min1 As Integer
Dim Min2 As Integer
Dim Max1 As Integer
Dim Max2 As Integer
Dim Min3 As Integer
Dim Min4 As Integer
Dim Max3 As Integer
Dim Max4 As Integer
Dim Dsid1(8) As Byte
Dim Dsid2(8) As Byte
Dim Dsid3(8) As Byte
Dim Dsid4(8) As Byte
Dim Sc(9) As Byte
Dim Id3 As String * 16
W = 1wirecount()
do
Dsid1(1) = 1wsearchfirst()
Print Dsid1(1)
If Dsid1(8) = Crc8(dsid1(1) , 7) Then
Print "CRC OK Sensor 1 ID"
'ezt irja ki terminálba 2esével egymás alá gondolom erre a cimre
'halgat az első chip de hogy lehetne átadni a lekérdezésnél hogy ez a
'cim változzon ?'"10 98 C5 7A 01 08 00 75"
Wait 1
For B = 1 To 8
Print Hex(dsid1(b))
Next
End If
loop
http://tetye.hu/robi.jpg
olyan kérdéssel fordulnék hozzátok hogy ha van 4db ds1820 as höméröm és tudom mindnek az idjét akkor hogy tudnám öket egyesével lekérdezni?
$regfile = "m8535.dat" ' specify the used micro
$crystal = 11059200 ' used crystal frequen
$baud = 9600
Config 1wire = Portd.2
Echo Off
Declare Sub Init
Declare Sub Convallt
Declare Function Decigrades(byval Sc(9) As Byte) As Integer
Dim B As Byte
Dim W As Word
Dim Dg As Integer
Dim Min1 As Integer
Dim Min2 As Integer
Dim Max1 As Integer
Dim Max2 As Integer
Dim Min3 As Integer
Dim Min4 As Integer
Dim Max3 As Integer
Dim Max4 As Integer
Dim Dsid1(8) As Byte
Dim Dsid2(8) As Byte
Dim Dsid3(8) As Byte
Dim Dsid4(8) As Byte
Dim Sc(9) As Byte
Dim Id3 As String * 16
W = 1wirecount()
do
Dsid1(1) = 1wsearchfirst()
Print Dsid1(1)
If Dsid1(8) = Crc8(dsid1(1) , 7) Then
Print "CRC OK Sensor 1 ID"
'ezt irja ki terminálba 2esével egymás alá gondolom erre a cimre
'halgat az első chip de hogy lehetne átadni a lekérdezésnél hogy ez a
'cim változzon ?'"10 98 C5 7A 01 08 00 75"
Wait 1
For B = 1 To 8
Print Hex(dsid1(b))
Next
End If
loop
http://tetye.hu/robi.jpg
A hozzászólást 1 alkalommal szerkesztették, utoljára tetye 2008. október 17. péntek, 12:53-kor.
-
Hooligan01
1w
köszi az megvan hogy lehet a többit kiolvasni, a kérdés arrol szolna hogy hogy lehet szelektiven lekérdezni öket ha tudom a cimüket?
-
Hooligan01
alapötlet:
http://www.mcselec.com/index.php?option ... &Itemid=57
http://www.mcselec.com/index.php?option ... &Itemid=57
Kód: Egész kijelölése
' DS18B20_two_thermo.bas for Atmel AVR with BASCOM - AVR and Dallas semiconductors DS18B20 temperature sensors - NO extra hardware
' Program "DUAL DS Thermo"
' Messures and displays temperature in 1/10 celcius on two DS sensors,
' stores and displays minimum and maximum readings.
' This program will NOT work on BASCOM earlier than 1.11.6.2, cause of the CRC-function
' and (maybe ?) its not possible to declare functions in earlier environment.
' But the 1w-functions work from 1.11.4 , I think.
' The program code (BIN) will be ~3Kb so its NOT possible to run in DEMO-environment anyway
' Platform(s) : Atmel devkit ~1996, used "AVR ISP programmer"-setting
' Dev - uC : Atmel AT90s8515 (AVR) @ 4 Mhz
' BASCOM-AVR IDE Version : 1.11.6.2 Compiler: Version 1.11.6.2 (released)
' This is a TWO-sensor DS18b20 thermometer displayed on 2*16 LCD
' The sensors are on the same 1-w bus :-) which is the intresting part
' The bus used is of 2-wire type, that means : Port-PIN to DQ, +5V to VDD and Gnd.
' See also HTML-help-file in BASCOM regarding "Using the 1 WIRE protocol"
' Main goal is to show basics of using two DS-sensors on the same uC-pin.
' The code is written for easy understanding as goal, not optimized for anything else
' If you use it or test it, please report to the author. (Not when only browsing )
' mailto: gote@sys-op.com
' subject : DS18B20_two_thermo.bas test-report
' message : type of uC, Mhz, type of sensors used, type of cable and length
' platform (devkit / PCB ?), BASCOM-version, compiled code size, (BIN file size)
' That will be enough pay-back for non-commercial use.
' Changes in the code will be allowed, if copy of changed program is sent to author,
' with comments in English ( or German, Swedish ).
' For commercial use, contact author.
' (c) 2001 Göte Haluza, gote@sys-op.com, gote@hotmail.com (Sweden)
' version :1 , revision 2, Startdate : 18 apr 2001 Last update : 27 Apr 2001
$regfile = "8515def.dat"
$crystal = 4000000
Declare Sub Init
Declare Sub ConvAllT ' Convert T on ALL sensors
Declare Function Decigrades(BYVAL sc(9) as byte) as integer
Config 1wire = Portb.6 '0,1,2 NOP 3,4,5,6,7 works good ON MY Equipment
Config Lcd = 16 * 2
Config Lcdpin = Pin , Db4 = Porta.4 , Db5 = Porta.5 , Db6 = Porta.6 , Db7 = Porta.7 , E = Porta.3 , Rs = Porta.2
'Temp variables
Dim B As Byte
Dim W As Word
'Program variables
'Implicit Err created by compiler
Dim Dg As Integer 'DECIgrades, I call it, cause I have no space for commas on the display....
Dim Min1 As Integer
Dim Min2 As Integer
Dim Max1 As Integer
Dim Max2 As Integer
Dim Dsid1(8) As Byte 'Dallas ID 64 bits incl CRC
Dim DsId2(8) As Byte
'When used like this : DsId(1) = 1wread(8)
'DsId(1) = family code 'Ds1820 10h, DS18B20 28h, Ds18s20 10h
'DsId(2) '48 Bits Serial, LSB
'DsId(3)
'DsId(4)
'DsId(5)
'DsId(6)
'DsId(7) '48 Bits Serial, MSB
'DsId(8) '8 CRC
Dim Sc(9) as byte 'Scratchpad 0-8 72 bits incl CRC, explanations for DS18b20
'Sc(1) 'Temperature LSB
'Sc(2) 'Temperature MSB
'Sc(3) 'TH/user byte 1 also SRAM
'Sc(4) 'TL/user byte 2 also SRAM
'Sc(5) 'config also SRAM x R1 R0 1 1 1 1 1 - the r1 r0 are config for resolution - write FF to byte for 12 bit - others dont care
'Sc(6) 'res
'Sc(7) 'res
'Sc(8) 'res
'Sc(9) '8 CRC
'DALLAS DS18B20 ROM and scratchpad commands''''''''''''''''''''''''''1wwrite....
'&H 33 read rom - single sensor
'&H 55 match rom, followed by 64 bits
'&H CC skip rom
'&H EC alarm search - ongoining alarm >TH <TL
'&H BE read scratchpad
'&H 44 convert T
cls
lcd "This is a 2sensor DS18B20 thermometer"
locate 2,1
lcd " by gote@sys-op.com"
wait 1
for b = 1 to 20
shiftlcd left
waitms 500
next
wait 2
cls
W = 1wirecount()
' Here I assume 2 sensors - no errorcontrol made, but would be easy to do with the "Err"-variable
' Getting the two sensors IDs.
DsId1(1) = 1wsearchfirst()
Do
DsId2(1) = 1wsearchnext()
Loop Until Err = 1
' If displayed, everything went well.
' First sensor identified and stored in variable
if dsid1(8) = crc8(DsId1(1), 7) then ' Control that the received CRC match the calculated
locate 1,1
lcd "CRC OK Sensor 1 ID"
wait 1
locate 1,1
for B=1 to 8
lcd Hex(DsId1(b))
next
end if
' Second sensor
if dsid2(8) = crc8(DsId2(1), 7) then
locate 2,1
lcd "CRC OK Sensor 2 ID"
wait 1
locate 2,1
for B=1 to 8
lcd Hex(DsId2(b))
next
end if
wait 1
cls
Init
' Main loop
Do
ConvAllT ' "Convert ALL T on the 1w-bus"
Waitus 200 : waitus 200 : waitus 200 : waitus 200 'if you use 2-wire, could be reduced to 200us
1wverify DsId1(1) 'Issues the "Match ROM "
locate 1,1
if err = 1 then
lcd "Err " 'Err = 1 if something is wrong
elseif err = 0 then 'lcd " Sensor found"
1wwrite &HBE
Sc(1) = 1wread(9) 'read bytes into array
if sc(9) = crc8(sc(1),8) then
DG = DeciGrades(sc(9))
if min1 > dg then min1 = dg
if max1 < dg then max1 = dg
lcd dg : locate 1,7 : lcd min1 : locate 1,14 : lcd max1
end if
end if
1wverify DsId2(1)
locate 2,1
if err = 1 then
lcd "DsId2 not on bus "
elseif err = 0 then ' lcd " Sensor found "
1wwrite &HBE
Sc(1) = 1wread(9)
if sc(9) = crc8(sc(1),8) then
DG = DeciGrades(sc(9))
if min2 > dg then min2 = dg
if max2 < dg then max2 = dg
lcd dg : locate 2,7 : lcd min2 : locate 2,14 : lcd max2
end if
end if
wait 1
loop
end 'end program
'Sets variables and LCD for further use'''''''''''''''''''''''''''''''''''''''''
Sub Init
Cls
Lcd " Min Max"
locate 2,1
Lcd " Min Max"
Min1 = 999 ' to get a real value from start
Min2 = 999
end sub
'Makes the Dallas "Convert T" command on the 1w-bus configured in "Config 1wire = Portb. "
'WAIT 200-750 ms after issued, internal conversion time for the sensor''''''''''
'SKIPS ROM - so it makes the conversion on ALL sensors on the bus simultaniously
'When leaving this sub, NO sensor is selected, but ALL sensors has the actual
'temperature in their scratchpad ( within 750 ms )
Sub ConvAllT
1wreset ' reset the bus
1wwrite &HCC ' skip rom
1wwrite &H44 ' Convert T
End sub
'Makes a integer value of the first two bytes in scratchpad'''''''''''''
'Works on DS18 B 20 , observe "B". The R0 and R1 in Sc(5) tells you how many bits are accurate
function Decigrades(Byval Sc(9) as byte)
Decigrades = 0
Decigrades = Makeint(Sc(1) , Sc(2))
Decigrades = Decigrades * 10
Decigrades = Decigrades / 16
end function
' If you have DS1820 or DS18 S 20 , you can use this algo instead:
' Observe that DsId1(1) contains the info value of which sensor is used.
'(
Function Decigrades(byval Sc(9) As Byte)
Dim Tmp As Byte , T As Integer , T1 As Integer
Tmp = Sc(1) And 1 ' 0.1C precision
If Tmp = 1 Then Decr Sc(1)
T = Makeint(sc(1) , Sc(2))
'Print Hex(t)
'Print T
T = T * 50 'here we calculate the 1/10 precision like
T = T - 25 'DS18S20 data sheet
T1 = Sc(8) - Sc(7)
T1 = T1 * 100
T1 = T1 / Sc(8)
T = T + T1
Decigrades = T / 10
'As integer, this routine gives T*10, with 1/10 degree precision
End Function
')
változók értelemszerűen...
1wire(32) as byte (tomb!, ez tartalmazza a 1...8, 9...16, 17...24, 25...32 erteken az 1W IDk vannak... - 4db DS1820)
1wire(32) as byte (tomb!, ez tartalmazza a 1...8, 9...16, 17...24, 25...32 erteken az 1W IDk vannak... - 4db DS1820)
Kód: Egész kijelölése
Disable Interrupts
1wreset 'reset the device
If Err <> 0 Then Print "1-wire error: " ; Err 'print error 1 if error
1wirecounter = 1wirecount()
Print "1-wire count: " ; 1wirecounter ; " device(s)"
Print
If 1wirecounter > 0 Then
Decr 1wirecounter
For L_temp1w = 0 To 1wirecounter
Print L_temp1w ; ":";
L_temp1b = L_temp1w * 8
L_temp2b = L_temp1b + 1
L_temp1b = L_temp1b + 8
' 1wire(6) = &H09 'CRC error teszt
If 1wire(l_temp1b) = Crc8(1wire(l_temp2b) , 7) Then ' Control that the received CRC match the calculated
Print " CRC:OK"
Else
Print " CRC:Err"
End If
Next L_temp1w
End If
Print : Print "Start measure";
1wreset ' reset the bus
1wwrite &HCC ' skip rom
1wwrite &H44 ' Convert T - mind egyszerre!
Waitms 200
Print ".";
Waitms 200
Print ".";
Waitms 200
Print ".";
Waitms 200
Print "OK"
1wirecounter = 1wirecount()
If 1wirecounter > 0 Then
Decr 1wirecounter
For L_temp1w = 0 To 1wirecounter
L_temp1b = L_temp1w * 8
Incr L_temp1b
1wiretemp(1) = 1wire(l_temp1b)
Incr L_temp1b
1wiretemp(2) = 1wire(l_temp1b)
Incr L_temp1b
1wiretemp(3) = 1wire(l_temp1b)
Incr L_temp1b
1wiretemp(4) = 1wire(l_temp1b)
Incr L_temp1b
1wiretemp(5) = 1wire(l_temp1b)
Incr L_temp1b
1wiretemp(6) = 1wire(l_temp1b)
Incr L_temp1b
1wiretemp(7) = 1wire(l_temp1b)
Incr L_temp1b
1wiretemp(8) = 1wire(l_temp1b)
1wverify 1wiretemp(1) 'letezik-e a detektalt homero?
Print L_temp1w ; ": "; 'sorszam (0....)
If Err = 1 Then
Print "Err"
Else
1wwrite &HBE
1wiretemp(1) = 1wread(9) 'strachpad kiolvasasa
If 1wiretemp(9) = Crc8(1wiretemp(1) , 8) Then 'eredmeny CRCellenorzes
L_temp2b = L_temp1w * 8
Incr L_temp2b 'chipazonosito helye az IDben (csaladkod)
Dg = Decigrades(1wiretemp(9) , 1wire(l_temp2b))
Print Dg
Else
Print "CRC:Err"
End If
End If
Next L_temp1w
End If
Enable Interrupts
1w
háát eddig jutottam tegnap este de sajna hiába adja át mert ki irja 2esével egymás alá az "ID" byteokat utánna meg hogy hiba:S
mintha már csak a hőmérséklet kiolvasásánál lenne baj, de ebben hol lehet a hiba?
mintha már csak a hőmérséklet kiolvasásánál lenne baj, de ebben hol lehet a hiba?
Kód: Egész kijelölése
$regfile = "m8535.dat" ' specify the used micro
$crystal = 11059200 ' used crystal frequen
$baud = 9600
Config 1wire = Portd.2
Echo Off
Declare Sub Dsidbetolt
Declare Sub Init
Declare Sub Convallt1 ' Convert T on ALL sensors
Declare Function Decigrades(byval Sc(9) As Byte) As Integer
Dim Min1 As Integer
Dim Max1 As Integer
Dim B As Byte
Dim W As Word
Dim F As Byte
Dim Dg As Integer 'DECIgrades, I call it, cause I have no space for commas on the display....
Dim Sc(9) As Byte 'Scratchpad 0-8 72 bits incl CRC, explanations for DS18b20
Dim Id1(8) As Byte
Dim Id2(8) As Byte
Min1 = 999
Do
Dsidbetolt
Convallt1 ' "Convert ALL T on the 1w-bus"
Waitus 200 : Waitus 200 : Waitus 200 : Waitus 200 'if you use 2-wire, could be reduced to 200us
1wwrite &HBE
Sc(1) = 1wread(9) 'read bytes into array
If Sc(9) = Crc8(sc(1) , 8) Then
Dg = Decigrades(sc(9))
If Min1 > Dg Then Min1 = Dg
If Max1 < Dg Then Max1 = Dg
Print "temp:"
Print Dg
Else
Print "hiba"
End If
Loop
End 'end program
Sub Dsidbetolt
Id1(1) = &H10
Id1(2) = &H98
Id1(3) = &HC5
Id1(4) = &H7A
Id1(5) = &H01
Id1(6) = &H08
Id1(7) = &H00
Id1(8) = &H75
Id2(1) = &H10
Id2(2) = &H47
Id2(3) = &HA0
Id2(4) = &H7A
Id2(5) = &H01
Id2(6) = &H08
Id2(7) = &H00
Id2(8) = &H56
End Sub
Sub Convallt1
Print : Print "Start measure";
1wreset ' reset the bus
1wwrite &HCC ' skip rom
1wwrite &H44 ' Convert T - mind egyszerre!
Waitms 200
Print ".";
Waitms 200
Print ".";
Waitms 200
Print ".";
Waitms 200
Print "OK"
1wreset ' reset the bus
For F = 1 To 8
1wwrite &H55 , &HID2(F) ' skip rom
Print Hex(id2(f))
Next F
' Convert T
End Sub
Function Decigrades(byval Sc(9) As Byte)
Decigrades = 0
Decigrades = Makeint(sc(1) , Sc(2))
Decigrades = Decigrades * 10
Decigrades = Decigrades / 16
End Function
1w
elméletileg itt szolitom meg azal hogy 1wwrite &h55, és itt a változo ami ugye 2x8 értékböl áll és szt tölti be és küldi ki ugye 2esével.
[/code]
Kód: Egész kijelölése
For F = 1 To 8
1wwrite &H55 , &HID2(F) ' match rom
Print Hex(id2(f))
Next F
1w
átraktam de ugan ugy nem olvassa ki az most az id2 változo amit használ a csip megszolitáshogy mert proba panelen 1db érzékelöt szeretnék elöször név szerint ki olvasni aztán már könnyebben hozzá füzöm a többit a rendes helyén.
csak az a gáz ha a változot ő maga generálja azzal hogy search elli a buszon az eszközök id jét ugyment igy hogy én adném át neki ugyan ugy változoba igy nem akar:S
amit küldtél azzal probálkoztam elöször de nem mentem sajna azzal sem sokra.
csak az a gáz ha a változot ő maga generálja azzal hogy search elli a buszon az eszközök id jét ugyment igy hogy én adném át neki ugyan ugy változoba igy nem akar:S
amit küldtél azzal probálkoztam elöször de nem mentem sajna azzal sem sokra.
1w
igen minden stimm, lábak, ellenálat, chpiet ki is tudom olvasni a "keres csipet a buszon és mond meg az idjét" parancsokkal de akor azt az egyet mondja meg amit épp talált nem pedig amit id alapján én szeretnék.
print err értéke 0
print err értéke 0
1w
ez a rész mire jo mert ezt kodbol vettem át és itt nincs egyenlöség ezért nem is megy tovább a DG re.
Kód: Egész kijelölése
Sc(1) = 1wread(9)
If Sc(9) = Crc8(sc(1) , 8) Then