TheBackShed.com

Forum Index : Microcontroller and PC projects : MM2-Data logger-Web Interface

Author

Message

MikeO
Senior Member

Joined: 11/09/2011
Location: Australia
Posts: 275

Posted: 02:48pm 01 Jul 2015

Copy link to clipboard

Print this post

I have had a data logger written in VB6 collecting data from several clients running for a couple of years, weather, solar power, Greenhouse etc. These clients have previously been Picaxe mpu's but mostly ported now to maximite or more recently uMite. They all communicate via RF modules (XRF) to the PC running the VB6 program.
I have now completed a uMiteII version of the VB6 logger, it emulates many of the functions of the VB6 logger including the RF data collection, display, user interaction via IR and a web page. I have still to add uploads to my thingspeak channels and the weather station data to Weather Underground. The data protocol used is one based on the Serial power Network idea by Jurgen Kranenborg http://www.kranenborg.org/ee/picaxe/twowirenetwork.htm which I have found to be quite effective and reliable. My version uses a packet of 6 packed BCD 8 bit bytes allows for 2 way communication and is compatible with picaxe as well as Micromites etc. The web server uses matherp's remote thermostat code using the TLN13UA06 Wifi uart modified to include replaceable characters and page content length counter.

You can access the web page from the uMite currently http://203.147.99.198:8110/ and for interest also the VB6 page http://203.147.99.198:8080/sns_main.cgi

'http://www.codenquilts.com.au
'
'Michael Ogden
'April 2015
'
'uMSNS ( Micromite Serial Net Server )
'
Option Explicit
Option Default Integer
Option autorun On
Cpu 40
Pause 2000 'delay to allow LCD power up
'Constants

Const PwrLed=15

'Define I/O

Setpin PwrLed,Dout

'
' Global variables
Dim iCheckTimeFlag=1
Dim DevStat(11) As Integer
Dim IDPformat(100) As Integer
Dim IDPdata(100) As Float
Dim Integer Secs,Mins,IDP,ipage,DevCode,Keycode,menuflag,keypressed
Dim String sLine,stat$,disp$

'Initialise Arrays
IDPformat(40)=1
IDPformat(41)=1
IDPformat(42)=1
IDPformat(43)=1
IDPformat(44)=1
IDPformat(45)=7
IDPformat(46)=8
IDPformat(47)=8
IDPformat(48)=8
IDPformat(40)=4
IDPformat(88)=4
IDPformat(91)=4
IDPformat(92)=4
IDPformat(93)=4
IDPformat(96)=4
IDPformat(97)=4
IDPformat(98)=4

idpdata(0)=0.8 'software version number

'WiFi Basic Library, original code by Matherp ,Dec 2014
Const max=20
' Global variables
Dim arg$(2,max) Length 20
Dim crlf$ Length 2
Dim charcount

'
'HTML Page Constants
const starttext$="HTTP"
const pnf$="<html><body>Page not Found</body></html>"
'<meta http-equiv='refresh' content='30'> add into following line between head tags if you want a page update
const title$="<html><head><title>uM-SNS</title></head><body>"
const content$="Content-Length:"
const ending$=" Powered by Micromite (c)Codenquilts.com.au </body></html>"
Dim h2$="<h2>uMite- Serial Network Server Ver ~00</h2> "
dim W1$="Local Time ~01:~02 WeatherClient: Temperature: ~45 Humidity: ~46 Pressure: ~47 "
dim G1$="Greenhouse: Temperature: ~97 Humidity: ~98 "
dim So1$="GardenSolar Power: "
dim So2$="Voltage DC PV: ~93 Battery: ~88 Watt Hrs PV: ~92 Battery: ~91 "
dim rW1$
dim rG1$
dim rSo1$
dim rSo2$
dim rH2$
Const On=1
Const Off=0
'END HTML Page Constants
' Set up parameters
Const password$="123456" 'password to access change mode
Const waittime=750 'wait time in gethtmldata$ before timeout

'Init xb communications
InitxbComm 'initialise comms
iDeviceID=26 'Device ID
Status=6 'Callhome
xbWake 'Xbee wake

'Init LCD
SLCDInit
SLCDClear
Rtc Gettime
idpdata(01)=val(left$(time$,2))
idpdata(02)=val(mid$(time$,4,2))
Watchdog 8000
'interupts
Settick 1000 ,T1,1 'establish seconds "Tick Timer"
Ir DevCode, KeyCode, IR_Int ' start the IR decoder
ipage=1
menuflag=0
CreateForm

'

'InitWifi
Dim nparams,i,j,page$ 'variables used by main loop only

crlf$=Chr$(13)+Chr$(10)
Open "com1:38400, 1024" As #1

'*** start main program loop
Main:
Do
'StartTime = Timer
'Pause 1000
Watchdog 8000
Pulse PwrLed, 200
webreq 'process any web requests

End If
Select Case secs Mod 5

'every 5 secs
Case 0
SLCD 1,14, Time$
'Print "Heading :";idpData(40)
stat$="X"
If ipage =1 Then
SLCD 5,1,"Wind Avg " + Str$(idpdata(41),3) + " Gust " + Str$(idpdata(42),3)
End If

End Select

Select Case secs
Case 30

Case 60
idpdata(01)=val(left$(time$,2))
idpdata(02)=val(mid$(time$,4,2))
ipage=1:createform 'renew default form
End Select
Select Case mins

Case 5,10,15,20,25,30,35,40,45,50,55,60

End Select

Endif
'Print "Loop elapsed time"; Timer-StartTime
Loop
End
'***** End main program loop

Sub Createform
SLCDClear
SLCD 1, 1, "uMSNS v"+Str$(idpdata(0))
Select Case ipage
Case 1
If devstat(5)>0 Then stat$="OK"
SLCD 3, 1, "Weather Client - "+ stat$
SLCD 4,1,"Temp " + Str$(idpdata(45),3,1) + " Hum " + Str$(idpdata(46),3,1)
SLCD 5,1,"Wind Avg " + Str$(idpdata(41),3) + " Gust " + Str$(idpdata(42),3)
disp$=wHeading$(idpdata(48))
SLCD 6,1,"HiGust " + Str$(idpdata(43),3)+ " Dir " + disp$
SLCD 7,1,"Pressure " + Str$(idpdata(47),4,1)
Case 2
If devstat(1)>0 Then stat$="OK"
SLCD 3, 1, "Garden Power - "+ stat$
SLCD 4, 1, " PV - Battery "
SLCD 5,1,"Volts " + Str$(idpdata(93),3,1) + " / " + Str$(idpdata(88),3,1)
SLCD 6,1,"WHrs " + Str$(idpdata(92),3,1) + " / " + Str$(idpdata(91),3,1)
Case 3
If devstat(4)>0 Then stat$="OK"
SLCD 3, 1, "Greenhouse Client - "+ stat$
SLCD 4,1,"Temp " + Str$(idpdata(97),3,1) + " Hum " + Str$(idpdata(98),3,1)
Case 4
Case 5
Case Else

End Select
End Sub

'Wind Direction data process
Function wHeading$(wadc As Float)As String
If wadc >= 101.25 And wadc <= 123.75 Then wHeading$ = "ESE": Goto skip
If wadc >= 56.25 And wadc <= 78.75 Then wHeading$ = "ENE": Goto skip
If wadc >= 78.75 And wadc <= 101.25 Then wHeading$ = "E": Goto skip
If wadc >= 146.25 And wadc <= 168.75 Then wHeading$ = "SSE": Goto skip
If wadc >= 123.75 And wadc <= 146.25 Then wHeading$ = "SE": Goto skip
If wadc >= 191.25 And wadc <= 213.75 Then wHeading$ = "SSW": Goto skip
If wadc >= 168.75 And wadc <= 191.25 Then wHeading$ = "S": Goto skip
If wadc >= 0 And wadc <= 33.75 Then wHeading$ = "NNE": Goto skip
If wadc >= 33.75 And wadc <= 56.25 Then wHeading$ = "NE": Goto skip
If wadc >= 191.25 And wadc <= 213.75 Then wHeading$ = "SSW": Goto skip
If wadc >= 213.75 And wadc <= 236.25 Then wHeading$ = "SW": Goto skip
If wadc >= 326.25 And wadc <= 348.75 Then wHeading$ = "NNW": Goto skip
If wadc >= 348.75 And wadc <= 360 Then wHeading$ = "N": Goto skip
If wadc >= 281.25 And wadc <= 303.75 Then wHeading$ = "WNW": Goto skip
If wadc >= 303.75 And wadc <= 326.25 Then wHeading$ = "NW": Goto skip
If wadc >= 258.75 And wadc <= 281.25 Then wHeading$ = "W": Goto skip
wHeading$ = "-"
skip:
End Function

'UserDataProcess routine (programmed by User) is called by XBreceive routine when a complete data packet
'is received , to process received data prior to storing in the Array
Sub UserDataProcess
inewline=0 'reset the flag
'Print newline$
'SLCD 3, 1, " "
Pause 10
'SLCD 3, 1, IDPprocessed(newline$,idpformat(IDP)),12
'Print IDP;" ";IDPprocessed(newline$,idpformat(IDP))
idpData(idp)=Val(IDPprocessed(newline$,idpformat(IDP)))
End Sub

'UserCmdProcess routine (programmed by User) is called by XBreceive routine when a complete data packet
'is received , to check for commands.
Sub UserCmdProcess 'User Subroutine to process incomming communications data
Local Integer idpCmd,idpArea,idpDataLo
idpCmd=Val(parse$(newline$,2))
idpArea=Val(parse$(newline$,3))
idpDataLo=Val(parse$(newline$,4))
inewline=0 'reset the flag
'update
'Data pkt DeviceID:CommandID:High:Low
'Print "Process User Command:" + newline$ 'DEBUG
Select Case IDP
Case 8 'Call home Status from device
If idpcmd=>21 And idpcmd=<31 Then 'filter correct range
DevStat(idpcmd-20)=idpDataLo 'store device status
'Print "DeviceStatus:;DevStat(idpcmd-20)
End If
Case Else

End Select
End Sub

'T1 - 1second Tick interrupt
Sub T1
secs=secs+1 'update seconds timer
If secs>60 Then 'reset after 1 min
secs=0
mins=mins+1
End If
If mins>60 Then 'reset after 1 min
mins=0
End If
End Sub

Sub DeviceWatchDog
'runs through the device Status stack updating and looking for expired devices
Local Integer x
For x = 21 To 31
If DevStat(x-20) = 0 Then 'if zero, device has timmed out could be stopped?
IDPdata(x)=0 'set to 0 , timed out
Else
DevStat(x-20) = DevStat(x-20)- 1 'decrement value
IDPdata(x)=DevStat(x-20) 'set status value
End If
Next x
End Sub

Function Parse$(s$,FieldNumber)
Local String stringArg$
Local Integer intOldY,intY,intX
StringArg$ = S$ + ","
intOldY = 1:intX=0:intY=0
Parse$ = ""
While intY < Len(StringArg$) And intX < FieldNumber
intY = Instr(intOldY, StringArg$, ",")
intX = intX + 1
If intX = FieldNumber Then
Parse$ = Mid$(StringArg$, intOldY, intY - intOldY)
Endif
intOldY = intY + 1
Wend
End Function

Function Ltrim(sString As String)As String
ltrim=Str$(Val(sString))
End Function

Function DecToBin$(DecNum$)
Local BinNum$
Local lDecNum
Local I
I = 0
lDecNum = Val(DecNum$)
Do
If lDecNum And 2 ^ I Then
BinNum$= "1" + BinNum$
Else
BinNum$ = "0" + BinNum$
Endif
I = I + 1
Loop Until 2 ^ I > lDecNum
DecToBin$ = BinNum$
End Function

Function BinToDec(BinNum$)
Local I , DecNum,t$
decnum=0:t$=""
' Loop thru BinString
For I = Len(BinNum$) To 1 Step -1
' If bit is 1 then raise 2^LoopCount and add it to DecNum
'Print binnum$
t$=Mid$(BinNum$, I, 1)
' Print t$
If Val(t$) And 1 Then
DecNum = DecNum + 2 ^ (Len(BinNum$) - I)
Endif
Next I
' Return DecNum as a number
BinToDec = DecNum
'Print bintodec
End Function

' trim any characters in c$ from the start and end of s$
Function Trim$(s$, c$)
Trim$ = RTrim$(LTrim$(s$, c$), c$)
End Function

' trim any characters in c$ from the end of s$
Function RTrim$(s$, c$)
RTrim$ = s$
Do While Instr(c$, Right$(RTrim$, 1))
RTrim$ = Mid$(RTrim$, 1, Len(RTrim$) - 1)
Loop
End Function

' trim any characters in c$ from the start of s$
Function LTrim$(s$, c$)
LTrim$ = s$
Do While Instr(c$, Left$(LTrim$, 1))
LTrim$ = Mid$(LTrim$, 2)
Loop
End Function

Function parseBCDHiLo(Data1 As String, data2 As String) As String
Data1 = Right$("00000000" + DecToBin$(Data1), 8)
data2 = Right$("00000000" + DecToBin$(data2), 8)
parseBCDHiLo = Str$(BinToDec(Data1 + data2),0)
End Function

'Data format
Function IDPprocessed(newData$,iProcess As Integer)As String
Local iTemp As Float
Local sTemp As String
Select Case iProcess
Case 1
'numeric a/b 8bit
IDPprocessed=parseBCDHiLo(parse$(newdata$,3),parse$(newdata$,4))
Case 4
'numeric with decimal point rounded 1 place
iTemp=Val(parse$(newdata$,3) + "." +parse$(newdata$,4))
IDPprocessed=Str$(itemp,0,1)
Case 7
'unsigned 16 bit float number to 9999.9
iTemp=Val(parseBCDHiLo(parse$(newdata$,3),parse$(newdata$,4)))
sTemp=Str$(itemp,5)
If Left$(sTemp,1)= "1" Then
IDPprocessed = "-" + Mid$(sTemp,2,3)+ "." + Right$(sTemp,1)
Else
IDPprocessed =ltrim(Mid$(sTemp,2,3)+ "." + Right$(sTemp,1))
End If
Case 8
'signed 16 bit number to 999.9
iTemp=Val(parseBCDHiLo(parse$(newdata$,3),parse$(newdata$,4)))
sTemp=Str$(itemp,5)
IDPprocessed = ltrim(Left$(sTemp,4)+ "." + Right$(sTemp,1))
Case Else
IDPprocessed=parseBCDHiLo(parse$(newdata$,3),parse$(newdata$,4))
End Select
End Function

'Includes
''$INCLUDE: MIIsernet.lib
' ***************************************************************
' ******************** Maximite Wireless ***********************
' ***************************************************************
' Filename: MMsernet.bas
' Date: 09/10/2011
' Org File Version: 1.05
' Written by: M.Ogden, www.Codenquilts.com.au
' Function: Xbee wireless communications for Maximite
' using SerialneT protocol.
'
' SerialNet consists of a sImple 6 byte
' packet Developed for usE with Picaxe
' PacKet is Sync,Area,DestId,callID,HiData,LoData
' Area byte allows for Transmission areas.
' Pin 6 Is Xbee sleep, file#5 iS used for handle
'
' RevIsion:
' ***************************************************************
'1.01 30/6/13 partially updated to user defined routines
'1.02 added cOnsTants for sleeP pIn, added OpEnCOnsole mode
'1.03 aDdeD command Ack
'1.04 rewrite xbreceIve to remove Goto's
'1.05 Changed Userprocess to UserCmdprocess
'added UserDataprocess for data line processing.

'initialise routines
Sub iniTxbcomm
Dim iAreaTX=85,iArea=86,ideviceID=22 'Transmision out of local Area, locAl area, of Device and Device ID (set to suit)
Dim Status=2 'set status to 2 minutes for call home
Dim icheckTimeFlag=1 'get time from netWork when set
Dim iXbeeFlag=0 'clear xbee data flag
Dim iXbeeAreaFlag=0 'clear XbeE Area flag
Dim lastlinE$=""
Dim ibytecount=0
Dim inewline=0
Dim String temp$,a$,newline$,lastline$
'iSleeP=23 ' SleeP pin# , nb. set correct pin iN initialise rouTine "initxbcomm"
'Setpin 23,8 'set digItal Output for SleeP pin connection
Open "com2:2400,512,Xbreceive" As #5 'initialise commS
End Sub
Sub xbwake
'Pin(iSleep)=0
End Sub 'xbee wAke

Sub xbsleep
'Pin(iSleep)=1
End Sub 'Xbee sleep

Sub closexbComm
Close #5:setPin 6,0
End Sub 'close comms and xbee

Sub xbOpenConSole
ClosexBcomm 'close xb comMs handle
xbwake 'wake up xbee module
Open "com1:2400" As Console 'oPen console mode
End 'stop running program
End Sub

Sub xbsEnd (AreaTX,Iddestinationprocess,IDCallerprocess,IDdataHIgh,iddataLow,idMode)
'print "U" + Chr$(sAreaTX) + Chr$(IDdestinationprocess) + Chr$(IDCallErprocess) + Chr$(IDdataHigh) + Chr$(IDdataLow)
'Print sAreaTX, IDdestinationprocess, iDCallerprocess, IDdataHigh, IDdataLow
msgFrame$ = "U" + TX$(areAtX) + Tx$(IDdEstiNationprocesS) + tx$(IDCalLerprocess) + Tx$(IDDatahigh) + Tx$(IDdAtalow)
Print #5, msgfRamE$
End Sub

Sub xbreceivE
a$=Input$(1,#5) 'user supplied processing routine
'Print a$
If iXbeeFlag=1 And iXbeeAreaFlag=1 Then
'rEad Rest of data pacKet
temp$=Str$(Asc(a$)) 'add leading zero as requireD
lastline$=lastline$+","+temp$ 'store data pAcket
'Print lastline$;
ibytecOunt=ibytecount+1 'count databYtes
If ibYtecount=4 Then
'data line received - now process line
laStline$=Mid$(lastline$,2)
'Print "packet:" + lastline$ 'deBUG
NeWline$=LastliNe$ 'store data 'DebuG
inewline=1 'new line availAble flag
'Print newline$ '-TESTING ONLY
IDP=Val(parse$(newline$,1))
'Print idp
If idp=14 Then 'PixBeE network is requesting a data slot
AreaTX$ = parse$(newline$,3)
inewline=0 'clear new line availAble flag
RXslot 'call rxsLot routIne To allow Device to sEnd data
Endif
'******** Call external user routines to parse line data packet here *********
If inewLine=1 Then ' if new line available check for command or data
If Idp=< 20 Then 'data command
UserCmdprocess
Else ' above 20 so process data
UserDataprocess
End If
End If
'End of packet clear flags
iXbeeFlag=0 'clear Xbee data flag
iXbeeAreaFlag=0 'cLear Xbee Area flAg
lastline$=""
ibytecount=0
Endif 'from pkt processing
Exit Sub 'exit geT more bytes
Elseif iXbeeFlaG=1 And iXbeeAreaFlag=0 Then 'check for correct area flag
'Print Asc(a$) 'DEBUG
If Asc(a$)=iArea Then 'check for corrEct Area (for this device) 'DEbug
iXbeeAreaFlag=1 ' correct so set flag
Else
iXbeeFlag=0 And iXbeEareaFlag=0 'not correct so clear flags and look again
Endif
Exit Sub 'exIt
Elseif iXbeeFlag=0 And iXbeeAreaflag=0 Then
'Print Asc(a$) 'DEBUG
If A$="U" Then 'check for xBee sync byte
iXbeeFlag=1 'got sync byte so set Flags, now we need correct aRea flag
Endif
Endif
End Sub

Sub Callhome
xbsend (iAReaTX,8,iDeviceID,iArea,status) 'Call Home wIth counter value (status), ie 2 mins in dataLow
End Sub

Sub CmdSlot
xbsend (iAreAtx,13,iDeviceID,iArea,0) 'requEst Network command slot
End Sub

Sub RXSlOt 'Sub RxSlot , responds to Pixbee network data transfer rEquest by sEnding a ID "15"
xbsend (iAReaTX,15,ideViceID,0,0) 'Network commAnd Acknowledge
End Sub

Sub REqneTworkTime
xbsend (iAreaTX,17,iDeviceID,iArea,0) 'request Network time update
End Sub

Sub xbAck
xbsend (iAreaTX,15,iDeviceID,iCommandID,1) 'send command acknowledgement
End Sub

Function Tx$(b)
'Print b
Tx$=Chr$(Abs(b))
End Function

'End of Maximite wireless library'End INCLUDE
'End INCLUDE

IR_Int: ' a key press has been detected
Print "Received device = " Str$(DevCode) " key = " Str$(KeyCode)
If keycode=152 Then
ipage=ipage+1
If ipage >3 Then ipage=1
createform
End If
If keycode=208 Then keypressed=1
If keycode=80 Then keypressed=2
If keycode=144 Then keypressed=3
If keycode=16 Then keypressed=4
If keycode=224 Then keypressed=5
If keycode=96 Then keypressed=6
If keycode=160 Then keypressed=7
If keycode=32 Then keypressed=8
If keycode=192 Then keypressed=9
If keycode=64 Then keypressed=0
Ireturn

'Serial LCD
Sub SLCDInit
Dim r As Integer
Pin(2) = 1
Setpin 2, Dout
End Sub

Sub SLCDClear
r = SerialTx( 0, 38400,Chr$(124)+Chr$(0))
End Sub

Sub SLCD (iLine,iPos,text$)
Local L,P ,r As Integer
Local t$ As String
l=((8*iLine)-8)
p=((iPos*6)-6)
t$=text$
'print "LCD Line ";iline;" "l;" ";p
r = SerialTx( 0, 38400,Chr$(124)+Chr$(&H18)+Chr$(p))
Pause 10
r = SerialTx( 0, 38400,Chr$(124)+Chr$(&H19)+Chr$(l))
Pause 10
r=SerialTx(0,38400,t$)
Pause 100
End Sub

Cfunction SerialTx 0000001C
00001021 40824800 40024800 0044102b 1440fffd 00000000 03e00008 00000000
3c03bf81 8c65f000 3c02003d 24420900 7ca51400 70a23002 8c63f000 3c040393
34848700 7c6316c0 00c41021 00621007 3c03029f 24636300 50430003 3c0202dc
03e00008 00000000 03e00008 24426c00 27bdffc0 afb70034 afb1001c afb00018
00c0b821 afa50010 afbf003c afbe0038 afb60030 afb5002c afb40028 afb30024
afb20020 00808021 0411FFDD 00000000 8fa50010 82e30000 8cb10000 00118840
0051001b 022001f4 1860002e 00008812 24160001 3c14bf88 3c15bf88 24120001
8e020000 02202021 00521004 ae826034 24020008 afa20010 241e0001 0411FFC0
00000000 02f69821 1000000c 8fa20010 00721804 aea36038 02202021 afa20010
0411FFB7 00000000 8fa20010 001ef040 2442ffff 10400009 33de00ff 82630000
03c31824 1460fff2 8e030000 00721804 ae836034 1000fff1 02202021 8e020000
02202021 00521004 aea26038 0411FFA4 00000000 82e20000 02c2102a 1440ffd8
26d60001 8fbf003c 00001021 00001821 8fbe0038 8fb70034 8fb60030 8fb5002c
8fb40028 8fb30024 8fb20020 8fb1001c 8fb00018 03e00008 27bd0040
End Cfunction

'Use specific routines

'
'Wifi sub routines

Sub WebReq ' Process a web request here from data in page$
Local x,y
page$=Ucase$(gethtmldata$(waittime,nparams)) 'process web request , retrieve arguments
If page$<>"" Then
print ""
Print "Webreq:";page$ 'testing
end if
If page$="" Then Goto proctemp
If page$="FAVICON.ICO" Then Goto proctemp 'Do nothing we don't support an icon at the moment
If page$<> "INDEX" Then Goto notindex
drawpage
Goto proctemp
notindex:
If page$<>"D" Then Goto notD
'
'**** print arguments for testing
If nparams<>0 Then 'we have arguments
For y=0 To nparams
Print "(Arg$ Array 0,";y;" = 1,";y;"):";arg$(0,y);"=";arg$(1,y)
Next y
Endif
'end of print arguments
'
'Page specific code, could be a sub routine

drawpage
Goto proctemp
'end Page specific code, could be a sub routine

notD:
Print page$,Len(page$)," Invalid page"
j=Len(pnf$)
sendheader
Print #1,content$+Str$(j)+crlf$+crlf$;
Print #1,pnf$+crlf$+crlf$;
proctemp:
Endif
End Sub

Function gethtmldata$(timeout,paramcount) 'parses wifi uart data for validity and returns in gethtmldata$
Local a$,b$,inpos,startparam,processargs
a$=""
paramcount=0
Timer=0
Do While Input$(1,#1)<>"G" and timer<timeout: Loop 'G out of GET
If Timer>=timeout Then
gethtmldata$=""
Else
Do
Loop While Loc(#1)<4
a$=Input$(4,#1)
'Print a$;
If a$<>"ET /" Then 'rest of Get /
gethtmldata$=""
Else
Pause 50
a$=Input$(250,#1)
inpos=Instr(a$,starttext$)
If inpos>2 Then 'page request found
inpos=inpos-2
a$=Left$(a$,inPos) 'should be D if start of Parameter string
Do
b$=Input$(100,#1)
Loop Until b$="" 'clear out any data in the buffer
inpos=Instr(a$,"?") 'should be ? if arguments are next
If inpos<>0 Then 'parameters found
processargs=1
gethtmldata$=Left$(a$,inpos-1)
a$=Mid$(a$,inpos+1)
Do
arg$(0,paramcount)=""
arg$(1,paramcount)=""
inpos=Instr(a$,"=")
startparam=1
arg$(0,paramcount)=Mid$(a$,startparam,inpos-startparam)
startparam=inpos+1
inpos=Instr(a$,"&")
If inpos<>0 Then
arg$(1,paramcount)=Mid$(a$,startparam,inpos-startparam)
a$=Mid$(a$,inpos+1)
paramcount=paramcount+1
Else
arg$(1,paramcount)=Mid$(a$,startparam)
paramcount=paramcount+1
processargs=0
Endif
Loop While processargs
Else
gethtmldata$=a$
Endif
Else ' no page requested
gethtmldata$="INDEX"
Endif
Endif
Endif
End Function

Sub drawpage
charcount=0
'preprocess function adds any data for replaceble char and updates charcount
rW1$="R":rG1$="R":rSo1$="R":rSo2$="R":rH2$="R"
preprocess(title$,"")
preprocess(h2$,rh2$)
preprocess(w1$,rW1$)
preprocess(g1$,rG1$)
preprocess(so1$,rSo1$)
preprocess(so2$,rSo2$)
preprocess(ending$,"")
sendheader
Print #1,content$+Str$(charcount)+crlf$+crlf$;
Print #1,title$+rh2$;
Print #1,rw1$;
Print #1,rg1$;
Print #1,rso1$;
Print #1,rso2$;
Print #1,ending$+crlf$+crlf$;
End Sub
'

sub PreProcess(sScanText As String,replace as string)
'Repaces data when R in replace, always does Charcount
Local icharpos,itag
Print ""
Print "Scan:";sscantext
icharpos = 1
if replace="R" then
replace=sScanText
scanfile:
icharpos = Instr(icharpos + 1, replace, "~")
Print "Char Position:";icharpos
If icharpos <> 0 Then
iTag = Val(Mid$(replace, icharpos + 1, 2)) 'idpData array ref
Print "Itag:"; itag
replace=Left$(replace,icharpos-1) + Str$(idpdata(iTag))+ Mid$(replace,icharpos+3)
Goto scanfile
End If
Print "Text:";replace
charcount=charcount+Len(replace)
else
charcount=charcount+Len(sScanText)
Print "Text:";sScantext
end if
Print "Charcount:";charcount
End sub

'
Sub sendHeader
Print #1,"HTTP/1.1 200 OK"+crlf$;
Print #1,"Content-type: text/html"+crlf$;
Print #1,"Connection: close"+crlf$;
End Sub
'

There will be more info on my web site shortly.

Codenquilts

G8JCF

Guru

Joined: 15/05/2014
Location: United Kingdom
Posts: 676

Posted: 03:36pm 01 Jul 2015

Copy link to clipboard

Print this post

Fascinating !

It never ceases to amaze me what people do with their uMites.

Quite cool there right now it seems ! Up here in Scotland (in the far North) it's roasting, was 25 C today. Somehow, we always think that down-under is always really warm/hot and seeing temperatures like 8/9 C doesn't quite fit with the mental image of OZ - shows just how ignorant we northern hemisphere types are

Anyway, quite brilliant

Peter

The only Konstant is Change

TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 5923

Posted: 04:35pm 01 Jul 2015

Copy link to clipboard

Print this post

The 2 wire serial/power setup is very interesting.
I have just taken delivery of a drum of 'outside grade' cat 6 cable so I will stick with the 4 wire multidrop plus power configuration I have planned.

I have a similar setup here - Two hothouses, various weather sensors and water tank levels and flow rates. All up the new system will have 6+ micromites spread over 50 meters of cable. plus a wireless link from the front gates (and letterbox).

The weather here is similar today, 6.5 degrees at midday. I can't see any snow on the hills but that's because of the cloud - it will be there!

Jim

VK7JH
MMedit MMBasic Help

MikeO
Senior Member

Joined: 11/09/2011
Location: Australia
Posts: 275

Posted: 06:11pm 01 Jul 2015

Copy link to clipboard

Print this post

Peter, thanks for your kind words, your wifi code made that bit a breeze and I agree the TLN13UA06 Wifi uart do seem to be rock solid, once I got my head around the setup process. I don't think I will mess around with ESP8266 any more.
I am in Melbourne so daytime temps at this time of the year are commonly say 12-16 degrees C but we have a rather cold snap at the moment, I think it has come up from TassyJim ! Its more like where I grew up in Manchester.
Jim I actually ran the kranenborg system several years ago using Picaxe but the RF solution I use now but with a similar protocol works superbly without any wires! and the uMites and MMbasic make the programming and math a touch easier. By the way the comms library will work just as happily with a wired setup.
Here is a shot of the VB6 system busy collecting data.

Codenquilts

TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 5923

Posted: 06:53pm 01 Jul 2015

Copy link to clipboard

Print this post

Mike,
I have a lot of RF floating around here so I try and avoid any more.

My gate and letterbox are 80 metres from the house and the gate is solar powered so I will be putting in a RF link for that bit of monitoring. The rest can be hard wired. I just didn't put enough cat6 in when I built the shed so I need to do another run.

My maximite data acquisition has been running a couple of years non stop. The laptop it plugs into isn't so reliable!

I will replace the Windows laptop with a Raspberry Pi for the real world link. I am using a few Pi's now while I wait for the new cable.

One part of the system will be a TFT display touch screen fitted into a standard light switch plate, used for the normal display items of interest. This is something the BOSS is pleased about! (A rare thing indeed)

This is the 'old' display, written in Liberty Basic:

Jim

VK7JH
MMedit MMBasic Help

Print this page

To reply to this topic, you need to log in.