'******************************************************************
' BHT7500s RF DEMO PROGRAM
' VERSION: 1.01
' DATE: 29/01/01
' PROGRAMMER BRETT NEWSTEAD
' LAST UPDATED 11/10/01
' UPDATED BY BRETT NEWSTEAD
' update notes:
' changed the data file name to FTP.txt so it would not clash with other demo
' programs that used data.txt but had different field lengths.
' also included the newgky file so all the code was together
' PROJECT FILE: RF1.PD3
' ADDITIONAL FILES:
' ftprf.TXT COLLECTED DATA
' RFSETT.TXT SETTINGS FOR NETWORK CONNECTION
' SUBROUTINES:
' BORDER RESET HEADING
' HEADING2 TEXT1 TEXT2
' CONTROL CONTROL2 VIBRATE1
' ERRORDEMO INTRO TXTFLASH
' SETTINGS
' LABELS (MODULES):
' MENU COLLECT VIEW
' TRANSFER PURGEFILE AUTHORISE
' FTP TRANS
' BRIEF DESCRIPTION
' PROGRAM NOTES:
' THIS IS A SIMPLE DEMONSTRATION PROGRAM THAT MAY BE USED FOR FURTHER
' DEVELOPMENT OF DENSO PORTABLE DATA TERMINALS.
' THIS PROGRAM WILL ONLY ALLOW THE USER TO COLLECT 50 RECORDS WHILE IN DEMO
' MODE. IT CAN BE AUTHORISED FOR FURTHER DATA COLLECTION. WE WOULD SUGGEST
' THAT YOU KEEP THE AUTHORISATION SEQUENCE PRIVATE TO PROTECT YOUR OWN
' DEMONSTRATION EQUIPMENT FROM BEING USED WITHOUT YOUR APPROVAL.
' THE USER CAN DELETE THE DATA FILE AFTER 50 RECORDS ARE COLLECTED AND
' CONTINUE TO USE THE SCANNER FOR TESTING AND EVALUATION.
' AUTHORISATION SEQUENCE:
' FROM THE MAIN MENU PRESS "F7"
' WHEN PROMPTED FOR CODE ENTER "9"
' WHEN YOU RETURN TO THE MAIN MENU YOU SHOULD NOTICE 2 DOTS IN THE TOP LEFT
' CORNER.
' BUGS:
' I HAVE NOTICED THAT WHEN YOU RETURN TO THE MAIN MENU YOU MAY HAVE TO ENTER
' THE OPTION TWICE AS THE SCANNER JUST BEEPS AND RETURNS TO THE MAIN MENU THE
' FIRST TIME. THIS DOES NOT HAPPEN ALL THE TIME AND I HAVE NOT HAD TIME TO
' TEST AND FIX THIS BUG.
' IF YOU HAVE ANY TROUBLE WITH THIS CODE OR QUESTIONS PLEASE CALL BRETT @ DENSO
' PH 03 9279 2967 OR EMAIL .
'*************************************************************
'DECLARATIONS
bar%=1
DATA%=2
RFSETT%=8
DEFREG AUTHORISED
'SUBROUTINES
SUB BORDER(D1$,D2$)
END SUB
SUB RESET(D1$,D2$)
OUT &H6080,1
SCREEN 0,0
END SUB
SUB HEADING(D1$,D2$)
OUT &H6080,0
SCREEN 0,0
END SUB
SUB HEADING2(D1$,D2$)
OUT &H6080,0
SCREEN 1,0
END SUB
SUB TEXT1(D1$,D2$)
OUT &H6080,0
SCREEN 0,0
END SUB
SUB TEXT2(D1$,D2$)
OUT &H6080,1
SCREEN 0,0
END SUB
SUB CONTROL(D1$,D2$)
OUT &H6080,0
SCREEN 1,1
END SUB
SUB CONTROL2(D1$,D2$)
CALL TEXT2(D1$,D2$)
SCREEN ,1
locate 1,9:print"PRESS ANY KEY TO CONT";
SCREEN ,0
END SUB
SUB VIBRATE1(D1$,D2$)
out &h6090,10
beep 2,2,1,1
out &h6090,0
END SUB
SUB ERRORDEMO(D1$,D2$)
out &h6090,10
beep 2,2,5,1
out &h6090,0
cls
CALL HEADING(D1$,D2$)
locate 2,2:print"ERROR"
locate 2,3:print"NON AUTHORISED"
locate 2,4:print"DEMO VERSION"
locate 2,5:print"LIMIT OF 50 RECORDS"
LOCATE 2,6:PRINT"DELETE DATA TO CONT"
call control2(d1$,d2$)
END SUB
SUB Intro(D1$,D2$)
cls
CALL HEADING2(D1$,D2$)
locate 5,1:print"BHT 7500S ";
LOCATE 3,3:PRINT"DEMO PROGRAM";
CALL TEXT1(D1$,D2$)
LOCATE 2,8:PRINT"DENSO INTERNATIONAL";
LOCATE 2,9:PRINT"WWW.DENSO.CO.JP/EAP";
LOCATE 2,10:PRINT"WWW.DENSO.COM.AU";
LOCATE 2,11:PRINT"75RF1 Vn:1.01"
SCREEN ,1
locate 2,18:print" ANY KEY TO CONTINUE ";
SCREEN 0,0
LOCATE 1,20:PRINT"<BACKLIGHT";
out &h6090,10
beep 5,1,1,1
OUT &H6080,0
SCREEN 1,0
wait 0,1
dummy$=inkey$
end sub
'------
' Text Flash Routine
'------
sub txtflash(msg$,xcord%,ycord%,noflash%)
for flash%=1 to noflash%
locate xcord%,ycord%:screen ,1:print msg$;
timea=2
while timea
wend
screen ,0
locate xcord%,ycord%:print msg$;
timea=2
while timea
wend
next flash%
end sub
'------
'******************************************************************
' CHANGE SETTINGS MODULE
' VERSION: 1.01
' DATE: 29/07/01
' PROGRAMMER BRETT NEWSTEAD
' LAST UPDATED 29/07/01
' UPDATED BY BRETT NEWSTEAD
' DECLARATIONS
' 1 DOMAIN$ RF SYNCH
' 2 SECURITY$ RF SYNCH
' 3 TERMINALIP$ SOCKET CONN
' 4 SUBNETMASK$ SOCKET CONN
' 5 GATEWAY$ SOCKET CONN
' 6 SERV.IP$ FTP CONN
' 7 USERNAME$ FTP HOST
' 8 PASSWORD$ FTP HOST
' i/o & FILES:
' RFSETT.TXT
' KEYPAD ONLY
' LINKED TO:
' SUB TEXT1
' RETURNED VARIABLE:
' SETTING.TXT REOCRD
' BRIEF DESCRIPTION
' ALLOWS THE OPERATOR TO MODIFY SYSTEM SETTINGS TO SUIT THEIR
' APPLICATION.
'*************************************************************
SUB SETTINGS(D1$,D2$)
BACK: CLS
open "RFSETT.txt" as #8 RECORD 1
field #8%,1 as DOMAIN$,20 AS SECURITY$,15 as TERMINALIP$,15 AS SUBNET$,15 AS GATEWAY$,15 as SERVERIP$,20 AS USERNAME$,20 AS PASSWORD$
CALL TEXT1(D1$,D2$)
GET #8,1
LOCATE 5,1:PRINT"CURRENT SETTINGS";
SCREEN ,1
LOCATE 2,2:PRINT"1.DOMAIN";
LOCATE 2,4:PRINT"2.SECURITY";
LOCATE 2,6:PRINT"3.TERMINAL IP";
LOCATE 2,8:PRINT"4.SUBNET MASK";
LOCATE 2,10:PRINT"5.GATEWAY";
LOCATE 2,12:PRINT"6.SERVER IP";
LOCATE 2,14:PRINT"7.USERNAME";
LOCATE 2,16:PRINT"8.PASSWORD";
LOCATE 2,19:PRINT"SELECT ITEM TO CHANGE";
LOCATE 2,20:PRINT"PRESS 0 TO EXIT TO MAIN";
SCREEN ,0
LOCATE 2,3:PRINT DOMAIN$;
LOCATE 2,5:PRINT SECURITY$;
LOCATE 2,7:PRINT TERMINALIP$;
LOCATE 2,9:PRINT SUBNET$;
LOCATE 2,11:PRINT GATEWAY$;
LOCATE 2,13:PRINT SERVERIP$;
LOCATE 2,15:PRINT USERNAME$;
LOCATE 2,17:PRINT PASSWORD$;
while 1
WAIT 0,1
OPTION$=INKEY$
select option$
case "1"
gosub SDOMAIN
case "2"
gosub SSECURITY
case "3"
gosub STERMIP
CASE "4"
GOSUB SSUBNET
CASE "5"
GOSUB SGATEWAY
case "6"
gosub SSERVERIP
case "7"
gosub SUSERNAME
case "8"
gosub SPASSWORD
CASE "0"
GOSUB EXT2
end select
wend '2345678901234567890123456
SDOMAIN:BEEP 1,1,2,1
LOCATE 2,19:PRINT" ENTER NEW DOMAIN ";
LOCATE 2,20:PRINT" ";
LOCATE 2,3:PRINT" ";
LOCATE 2,3:INPUT DOMAIN$
PUT #8,1
CLOSE #8
GOTO BACK:
SSECURITY:BEEP 1,1,2,1
LOCATE 2,19:PRINT" ENTER NEW SECURIT P/W ";
LOCATE 2,20:PRINT" ";
LOCATE 2,5:PRINT" ";
LOCATE 2,5:INPUT SECURITY$
PUT #8,1
CLOSE #8
GOTO BACK:
STERMIP:BEEP 1,1,2,1
LOCATE 2,19:PRINT" ENTER NEW TERMINAL IP ";
LOCATE 2,20:PRINT" ";
LOCATE 2,7:PRINT" ";
LOCATE 2,7:INPUT TERMINALIP$
PUT #8,1
CLOSE #8
GOTO BACK:
SSUBNET:BEEP 1,1,2,1
LOCATE 2,19:PRINT" ENTER NEW SUBNET MASK ";
LOCATE 2,20:PRINT" ";
LOCATE 2,9:PRINT" ";
LOCATE 2,9:INPUT SUBNET$
PUT #8,1
CLOSE #8
GOTO BACK:
SGATEWAY:BEEP 1,1,2,1
LOCATE 2,19:PRINT" ENTER NEW GATEWAY ";
LOCATE 2,20:PRINT" ";
LOCATE 2,11:PRINT" ";
LOCATE 2,11:INPUT GATEWAY$
PUT #8,1
CLOSE #8
GOTO BACK:
SSERVERIP:BEEP 1,1,2,1
LOCATE 2,19:PRINT" ENTER NEW SERVER IP ";
LOCATE 2,20:PRINT" ";
LOCATE 2,13:PRINT" ";
LOCATE 2,13:INPUT SERVERIP$
PUT #8,1
CLOSE #8
GOTO BACK:
SUSERNAME:BEEP 1,1,2,1
LOCATE 2,19:PRINT" ENTER NEW FTP USERNAME ";
LOCATE 2,20:PRINT" ";
LOCATE 2,15:PRINT" ";
LOCATE 2,15:INPUT USERNAME$
PUT #8,1
CLOSE #8
GOTO BACK:
SPASSWORD:BEEP 1,1,2,1
LOCATE 2,19:PRINT" ENTER NEW FTP PASSWORD ";
LOCATE 2,20:PRINT" ";
LOCATE 2,17:PRINT" ";
LOCATE 2,17:INPUT PASSWORD$
PUT #8,1
CLOSE #8
GOTO BACK:
EXT2: BEEP 1,1,2,2
LOCATE 2,19:PRINT" EXIT UPDATE SETTINGS ";
LOCATE 2,20:PRINT" PRESS ANY KEY TO CONT ";
WAIT 0,1
DUMMY$=INKEY$
CLOSE #8
END SUB
' functions
'======
' SCAN KEY ROUTINE TO ALLOW CLR TO BE PUSHED ANYTIME
' IT IMPERSONATES THE INPUT XX$ ROUTINE BUT WITH THE ABILITY
' TO ALLOW THE USER TO CLR ANY TIME
' THIS CAN BE PUT INTO A LIBRARY
' Need to pass in parameters lett$,row%,col% and slen%
'======
Function jinput$(lett$,row%,col%,slen%)
clr%=0
jkey keydt$="" 'NUL-Initialise string
psy%=row% 'Copy start position
'------'------Reject <BS> as first char------
while lett$=chr$(8)
lett$=inkey$
while lett$="" or (lett$<chr$(48) or lett$>chr$(57)) and lett$>chr$(13) and lett$>chr$(24)
lett$=inkey$
wend
wend
'------'------Main loop to input chars until <CLR> or <ENT> is pushed------
while lett$>chr$(13) and lett$>chr$(24) and len(keydt$)<=slen%
if lett$=chr$(24) then 'If <CLR> then
jinput$="" 'clear data
exit function 'and return
end if
'------Backspace <BS> routine------
if lett$=chr$(8) then 'if a <BS> then
s%=len(keydt$) 'get length of data
keydt$=mid$(keydt$,1,s%-1) 'truncate last chr
locate psy%-1,col% 'set position for blank
print " "; 'blank out last chr
if psy%>=3 then 'if at >= column 3
psy%=psy%-2 'then move back 2
else 'otherwise
firstcol%=1 'set flag
psy%=psy%-1 'and move back 1
end if
end if
'------Display-character routine------
locate psy%,col% 'set position
if firstcol%=0 then 'if not at first col
psy%=psy%+1 'move forward one
end if
firstcol%=0 'reset flag
if lett$>chr$(8) then 'If not <BS>
print lett$; 'then display chr
keydt$=keydt$+lett$ 'compile string
end if
'------Start-column handler------
getk2: if psy% = row% then 'If at start column
lett$=inkey$ 'get chr
while lett$=chr$(8) or (lett$<chr$(43) or lett$>chr$(122)) and lett$>chr$(13) and lett$>chr$(24)
lett$=inkey$ 'ignore <BS>
wend
else 'otherwise get another
lett$=inkey$ 'chr
while (lett$<chr$(43) or lett$>chr$(122)) and lett$>chr$(13) and lett$>chr$(24) and lett$>chr$(8)
lett$=inkey$
wend
end if
'------Key check------
if lett$="" then 'if no key pressed
goto getk2 'go back and get key
end if
'Condition below ensures correct operation when at end column
'English prose: If at end column and the key wasn't a backspace
'and it wasn't an <ENT> nor a <CLR> then go back and get a key
if len(keydt$)=slen% and lett$>chr$(8) then
if lett$>chr$(13) and lett$>chr$(24) then
goto getk2
end if
end if
'------
wend
if lett$=chr$(24) then 'If a <CLR>
keydt$="" 'then assign NUL to str
clr%=1
end if
jinput$=keydt$ 'Assign return string
end function 'End function
'======
'START OF MAIN PROGRAM
p%=2
d%=0
call "system.fn3" 2 p%,d% '
p%=3
d%=0
call "system.fn3" 2 p%,d% '
p%=4
d%=4
call "system.fn3" 2 p%,d% '
p%=5
d%=2
call "system.fn3" 2 p%,d% '
CALL INTRO(D1$,D2$)
OPTION while 1 'Continuous loop (cannot exit)
gosub menu 'Option menu
select option$
case "1"
gosub collect
case "2"
gosub view
case "3"
gosub transfer
case "4"
gosub ftptrans
case "5"
gosub purgefile
CASE "6"
CALL SETTINGS(D1$,D2$)
case "G"
gosub authorise
END SELECT
wend
'***************************************************************************
' MENU SCREEN
'***************************************************************************
Menu:
cls
CALL HEADING2(D1$,D2$)
locate 3,1:print"MAIN MENU";
CALL HEADING2(D1$,D2$)
locate 2,3:print"1. COLLECT";
locate 2,5:print"2. VIEW";
locate 2,7:print"3. IRDA TRANSFER";
locate 2,9:print"4. FTP TRANSFER";
LOCATE 2,11:PRINT"5. DELETE DATA";
LOCATE 2,13:PRINT"6. SETTINGS";
if authorised then
CALL TEXT2(D1$,D2$)
LOCATE 1,1:PRINT".";
LOCATE 2,1:PRINT".";
CALL HEADING2(D1$,D2$)
else endif
beep 3,2,2,3000
wait 0,1
option$=inkey$
if option$="1" then
m$="1. COLLECT":x%=2:y%=3:f%=1
CALL txtflash(m$,x%,y%,f%)
ELSE ENDIF
if option$="2" then
m$="2. VIEW":x%=2:y%=5:f%=1
CALL txtflash(m$,x%,y%,f%)
ELSE ENDIF
if option$="3" then
m$="3. IRDA TRANSFER":x%=2:y%=7:f%=1
CALL txtflash(m$,x%,y%,f%)
ELSE ENDIF
if option$="4" then
m$="4. FTP TRANSFER":x%=2:y%=9:f%=1
CALL txtflash(m$,x%,y%,f%)
ELSE ENDIF
if option$="5" then
m$="5. DELETE DATA":x%=2:y%=11:f%=1
CALL txtflash(m$,x%,y%,f%)
ELSE ENDIF
if option$="6" then
m$="6. SETTINGS":x%=2:y%=13:f%=1
CALL txtflash(m$,x%,y%,f%)
ELSE ENDIF
return
'******************************************************************
' DATA COLLECT MODULE
' VERSION: 1.01
' DATE: 29/07/01
' PROGRAMMER BRETT NEWSTEAD
' LAST UPDATED 29/07/01
' UPDATED BY BRETT NEWSTEAD
' DECLARATIONS
' LOCATION$ 15
' PRODUCT$ 15
' QTY$ 15
' LINKED TO:
' AUTHORISED GLOBAL VARIABLE
' SUB TEXT1
' SUB TEXT2
' SUB ERRORDEMO
' SUB HEADING
' SUB VIBRATE1
' SUB VIBRATE2
' I/O & FILES
' BAR #1
' ftprf.TXT #2
' BRIEF DESCRIPTION:
' COLLECTS DATA FOR DATA FILE WITH OPTIONS OF ENTERING DATA
' FROM THE KEYPAD OR FROM THE SCAN ENGINE
' IS A LITTLE ROUGH BUT IT DOES TE JOB
'*************************************************************
collect
continue$=""
cls
while continue$ > "A"'123456789012345678901
CALL HEADING(D1$,D2$)
locate 5,1:print"COLLECT DATA"
CALL TEXT2(D1$,D2$)
LOCATE 1,10:PRINT"<BLT";
LOCATE 17,10:PRINT"TRGR>";
CALL TEXT2(D1$,D2$)
locate 1,3:print"LOC: ";
open "bar:" as #1 code "A","k","M","I","N","H"
open "ftprf.txt" as #2 RECORD 32000
field #2%,15 as location$,15 as product$,15 as qty$
LOCATE 1,8:PRINT"REC: ",lof(#2);
IF AUTHORISED THEN
CALL TEXT2(D1$,D2$)
LOCATE 1,1:PRINT"."
LOCATE 21,1:PRINT"."
CALL TEXT1(D1$,D2$)
ELSE
if lof(#2) > 50 then
call errordemo(d1$,d2$)
call text1(d1$,d2$)
wait 0,1
dummy$=inkey$
close #1
close #2
return
else endif
ENDIF
wait 0,3
CALL TEXT2(D1$,D2$)
'******************************CLEAN DATA SCREEN********************
locate 6,3:print" ";
locate 6,3:print" ";
locate 6,3:print" ";
'******************************IF F1 PRESSED QUIT*******************
locate 6,3:print" ";
locate 6,3:continue$=inkey$
if continue$="A" then
goto quit
else '12345678901234568
end if
'######## locate 3,16:print" ";
locate 1,7:print" ";
'*****************************KEY OR SCAN LOCATION******************
if continue$>"" then
a$=continue$:b%=6:c%=3:d%=15
location$=jinput$(a$,b%,c%,d%)
else
input #1,location$
call vibrate1(d1$,d2$)
end if
call vibrate1(d1$,d2$)
'beep 3,1,1,3000
locate 6,3:print" ";
locate 6,3:print location$;
'****************************KEY OR SCAN PRODUCT CODE***************
locate 1,4:print"CODE:";
wait 0,3
locate 7,4:print" ";
locate 7,4:continue2$=inkey$
if continue2$>"" then
a$=continue2$:b%=7:c%=4:d%=15
product$=jinput$(a$,b%,c%,d%)
else
input #1,product$
end if
beep 3,1,1,3000
locate 7,4:print" ";
locate 7,4:print product$;
'****************************KEY ONLY QUANTITY***********************
locate 1,5:print"QTY: ";
locate 6,5:print" ";
locate 6,5:input "",qty$
beep 3,1,1,3000
put #2
locate 6,5:print" ";
locate 6,5:print qty$;
locate 1,7:print"F1 EXT or ENT NXT REC";
quit: close #1
close #2
wend
return
'******************************************************************
' VIEW DATA FILE MODULE
' VERSION: 1.01
' DATE: 29/07/01
' PROGRAMMER BRETT NEWSTEAD
' LAST UPDATED 29/07/01
' UPDATED BY BRETT NEWSTEAD
' DECLARATIONS
' LOCATION$ 15
' PRODUCT$ 15
' QTY$ 15
' LINKED TO:
' I/O & FILE
' ftprf.TXT #2
' SUB HEADING
' SUB TEXT2
' SUB TEXT1
' RETURNED VARIABLE:
' BRIEF DESCRIPTION:
' VIEW ALLOWS THE USER TO LOOK UP THE DATA IN THE FILE DATA.TXT IN SEQUENTIAL
' ORDER FROM RECORD 1 THROUGH UNTIL THE END OF THE FILE.
'*************************************************************
view
cls
open "ftprf.txt" as #2 RECORD 32000
field #2%,15 as location$,15 as product$,15 as qty$
CALL HEADING(D1$,D2$)
locate 4,1:print"DATA.TXT FILE";
CALL TEXT2(D1$,D2$)
for i=1 to LOF(#2)
get #2 '12345678901234567890123456
CALL TEXT2(D1$,D2$)
locate 2,8:print"Rec: ";i
locate 13,8:print"of ";LOF(#2)
CALL TEXT1(D1$,D2$)
locate 7,2:print" ";
locate 7,3:print" ";
locate 7,4:print" ";
locate 1,2:print"LOC: ";
locate 7,2:print location$;
locate 1,3:print"CODE: ";
locate 7,3:print product$;
locate 1,4:print"QTY: ";
locate 7,4:print qty$;
CALL TEXT2(D$,D$)
screen ,1:locate 2,10:print"ENT next F1 exit";:screen ,0
wait 0,1
dummy$=inkey$
if dummy$="A" then
close #2
return
endif
beep 2,1,1,1000
next i
close #2
return
'******************************************************************
' TRANSFER DATA TO TSR-TU3A HOST UTILITY MODULE
' VERSION: 1.01
' DATE: 29/01/01
' PROGRAMMER JASON COWIE
' LAST UPDATED 29/07/01
' UPDATED BY BRETT NEWSTEAD
' DECLARATIONS
' LINKED TO:
' SUB BORDER(D1$,D2$)
' HEADING(D1$,D2$)
' TEXT2
' ERRMSG(BELOW) COMMS TIME OUT
' I/O & FILES
' COM1 #3 OPTICAL PORT
' ftprf.TXT
' RETURNED VARIABLE:
' BRIEF DESCRIPTION
' TRANSFER ALLOWS THE USE TO UPLOAD THE DATA FILE DATA.TXT TO A HOST
' COMPUTER RUNNING THE DENSO TRANSFER UTILITY TSR-TU3A, THE HOST
' LOCATION IS DEFINED BY THE TRANSFER UTILITY
'*************************************************************
transfer
cls
CALL BORDER(D1$,D2$)
call heading(d1$,d2$)
locate 3,1:Print"Uploading Data"
CALL TEXT2(D1$,D2$)
locate 1,3:print"SETTINGS: 115200,N,8,1";
locate 1,4:print"Optical comms"
locate 1,5:print"SLED or JET EYE";
LOCATE 1,6:PRINT"FILE:DATA.TXT";
locate 5,7:print"C to CANCEL";
locate 5,4
ON ERROR goto ermsg
open "com1:115200,N,8,1" as #3
XFILE "ftprf.txt","PSM"
close #3
locate 2,8:Print"Transfer complete";
beep 1,1,1,1000
screen ,1:Locate 2,9:Print"F8 TO PURGE";
locate 2,10:Print"ANY KEY TO KEEP";:screen ,0
wait 0,1
purge$=inkey$
if purge$="H" then
kill "ftprf.txt"
endif
return
'***************************************************************************
' COMMS TIME OUT
'***************************************************************************