📄 try.bas
字号:
REM '$INCLUDE: 'QB.BI'
CONST MaxNum = 10 'The Max number of allowable register.
CONST MaxT = 5 'The Max seconds we can waits for the comm.
CONST MaxMsgNum = 15 'The total number short msg in sms card.
DECLARE SUB ChangeFile (cfstr1$, cfstr2$())
DECLARE SUB Dealmsg (phmsg$)
DECLARE SUB ChangReg (a$, b$())
DECLARE SUB Delay (pa%)
DECLARE SUB InitWatchDog (pa%, pb%, pc%, pd%)
DECLARE SUB FeedWatchDog ()
DECLARE SUB ResetWatchDog ()
DECLARE SUB UnLockConfig ()
DECLARE SUB LockConfig ()
DECLARE SUB DisableWatchDog ()
DECLARE SUB EnableWatchDog ()
DECLARE SUB SetCounterValue (pa%, pb%, pc%)
DECLARE SUB SetTimeAction (pa%)
DECLARE SUB DSendMsg (SMsg$, tel$)
DECLARE FUNCTION TimeEX$ (DataStr AS STRING)
DECLARE FUNCTION TelEX$ (DataStr AS STRING)
DECLARE FUNCTION GenCommand$ (a%)
DECLARE FUNCTION Ieee2Float! (a%())
DECLARE FUNCTION GENCRC16% (pi%)
DECLARE FUNCTION CalculateCharacterCRC16% (pcrc%, pc%)
DECLARE FUNCTION S2L& (pl%)
DECLARE FUNCTION L2S% (pl&)
DECLARE FUNCTION ReadFile% ()
DECLARE FUNCTION GetMsgFromPhone% (no%, phmsg$)
DECLARE FUNCTION Ieee2Double# (pa%())
DIM openbox AS STRING
DIM str AS STRING
DIM startt AS STRING
DIM endt AS STRING
DIM commands AS STRING
DIM rok AS STRING
DIM rfail AS STRING
DIM logon AS STRING
DIM act AS STRING
DIM bye AS STRING
DIM result1(30) AS INTEGER
DIM msgreturn AS STRING
DIM a(0 TO 7) AS INTEGER
DIM crc AS INTEGER
DIM SendBz AS INTEGER
DIM lshi, lshj, lshk, lshl, lshc, lsht AS INTEGER
DIM phmsg AS STRING
DIM timestat(0 TO 1, 0 TO MaxNum - 1) AS LONG
DIM SHARED NextSmsNo AS INTEGER
DIM SHARED MsgFromPhone AS STRING
DIM SHARED tel(0 TO MaxNum - 1) AS STRING
DIM SHARED reg(0 TO 3, 0 TO MaxNum - 1) AS STRING
DIM SHARED interval AS LONG
DIM SHARED CentralCode AS STRING
PRINT "Waiting 20 Seconds!"
Delay (20) 'Wait for the mobil and the meter to work well!
NextSmsNo = 1
openbox = CHR$(&H5F) + CHR$(&H0) + CHR$(&H7B) + CHR$(&HB1) + CHR$(&H62) + CHR$(&HA5) + CHR$(&H8B) + CHR$(&H66)
rok = CHR$(2) + CHR$(6) + CHR$(6) + CHR$(&HA4) + CHR$(3)
rfail = CHR$(2) + CHR$(&H18) + CHR$(&HF5) + CHR$(&H5B) + CHR$(3)
act = CHR$(&H1B) + CHR$(2) + CHR$(3)
logon = CHR$(2) + "LEDMI,IMDEIMDE" + CHR$(0) + CHR$(&HD9) + CHR$(&H69) + CHR$(3)
bye = CHR$(2) + CHR$(&H58) + CHR$(&HBD) + CHR$(&H9F) + CHR$(3)
FOR lshi = 0 TO MaxNum - 1 'timestat(0,*)=1 means won't send message.
timestat(0, lshi) = 0: timestat(1, lshi) = 0
NEXT lshi
CALL InitWatchDog(&HFF, &HFF, &HFF, &HD)
CALL FeedWatchDog
ON ERROR GOTO handler
lshi = 0
DO
PRINT "Reading m.txt!"
lshj = ReadFile
IF lshj = 0 THEN EXIT DO
PRINT "Copying message.txt m.txt /y!"
SHELL "copy message.txt m.txt /y"
lshi = lshi + 1
LOOP UNTIL lshi = 2
IF lshj <> 0 THEN
PRINT "ReadFile Failed!"
END IF
PRINT "Openning com1 and com2!"
OPEN "COM1:1200,N,8,1,CD0,CS0,DS0,OP0,RS,TB2048,RB2048" FOR RANDOM AS #11
OPEN "COM2:19200,N,8,1,CD0,CS0,DS0,OP0,RS,TB2048,RB2048" FOR RANDOM AS #12
ON COM(2) GOSUB snoopmsg
ON TIMER(1) GOSUB dealtime
COM(2) ON
TIMER ON
PRINT "Infering"
PRINT #11, act
startt = TIME$
str = ""
DO
str = str + INPUT$(LOC(11), #11)
endt = TIME$
IF (60 + VAL(RIGHT$(endt, 2)) - VAL(RIGHT$(startt, 2))) MOD 60 > MaxT THEN
PRINT "Infer Failed"
EXIT DO
END IF
LOOP UNTIL INSTR(str, rok)
PRINT "Logging"
PRINT #11, logon
str = ""
startt = TIME$
DO
str = str + INPUT$(LOC(11), #11)
endt = TIME$
IF (60 + VAL(RIGHT$(endt, 2)) - VAL(RIGHT$(startt, 2))) MOD 60 > MaxT THEN
PRINT "Longon Failed"
EXIT DO
END IF
LOOP UNTIL INSTR(str, rok)
'PRINT #12, "AT+CSCA=" + CHR$(34) + "+8613800871500" + CHR$(34) + CHR$(13)
PRINT "Setting centalcode!"
PRINT #12, "AT+CSCA=" + CHR$(34) + RTRIM$(LTRIM$(CentralCode)) + CHR$(34) + CHR$(13) 'SetupCenterCode
str = ""
startt = TIME$
DO
str = MsgFromPhone
endt = TIME$
IF (60 + VAL(RIGHT$(endt, 2)) - VAL(RIGHT$(startt, 2))) MOD 60 > MaxT THEN
PRINT "Set CentralCode failed!"
EXIT DO
END IF
LOOP UNTIL INSTR(str, "OK")
MsgFromPhone = ""
IF INSTR(str, "OK") THEN PRINT "Set CentralCode sucess!"
WHILE 1
msgreturn = ""
lshi = 0
DO WHILE lshi < MaxNum
PRINT lshi
IF VAL("&H" + reg(0, lshi)) <> 0 AND reg(0, lshi) <> "" THEN
commands = GenCommand(VAL("&H" + reg(0, lshi)))
PRINT #11, commands
str = ""
startt = TIME$
DO
str = str + INPUT$(LOC(11), #11)
endt = TIME$
IF (60 + VAL(RIGHT$(endt, 2)) - VAL(RIGHT$(startt, 2))) MOD 60 > MaxT THEN
PRINT "Read Meter overtime!"
EXIT DO
END IF
LOOP UNTIL INSTR(str, CHR$(3))
IF INSTR(str, rfail) THEN
PRINT "CAN error"
EXIT DO
END IF
IF LEN(str) < 8 THEN EXIT DO
IF INSTR(str, CHR$(3)) = 0 THEN EXIT DO
IF INSTR(str, CHR$(2)) = 0 THEN EXIT DO
IF INSTR(str, CHR$(3)) - INSTR(str, CHR$(2)) < 7 THEN EXIT DO
result1(0) = ASC(MID$(str, 1, 1))
lshj = 1
WHILE ASC(MID$(str, lshj, 1)) <> 2
lshj = lshj + 1
WEND
lshk = 1
WHILE ASC(MID$(str, lshj, 1)) <> 3
IF ASC(MID$(str, lshj, 1)) = &H10 THEN
result1(lshk) = ASC(MID$(str, lshj + 1, 1)) - &H40
lshj = lshj + 1
ELSE
result1(lshk) = ASC(MID$(str, lshj, 1))
END IF
lshk = lshk + 1
lshj = lshj + 1
WEND
result1(lshk) = &H3
lshl = 1: crc = 0
WHILE lshl < lshk - 2
crc = CalculateCharacterCRC16(crc, result1(lshl))
lshl = lshl + 1
WEND
v = VARPTR(crc)
IF (result1(lshk - 2) <> PEEK(v + 1)) OR (result1(lshk - 1) <> PEEK(v)) THEN
PRINT "crc error"
EXIT DO
END IF
msgreturn = msgreturn + STRING$(4 - LEN(LTRIM$(reg(0, lshi))), &H30)
msgreturn = msgreturn + reg(0, lshi) + CHR$(lshk - 2 - 5)
lshl = 5
WHILE lshl < lshk - 2
msgreturn = msgreturn + CHR$(result1(lshl))
lshl = lshl + 1
WEND
IF timestat(0, lshi) = 0 THEN
SELECT CASE UCASE$(reg(1, lshi))
CASE "F"
a(3) = result1(lshk - 3): a(2) = result1(lshk - 4): a(1) = result1(lshk - 5): a(0) = result1(lshk - 6)
fr! = Ieee2Float(a())
IF fr! < VAL(reg(2, lshi)) OR fr! > VAL(reg(3, lshi)) THEN
SendBz = 2
timestat(0, lshi) = 1
END IF
CASE "B"
br% = result1(lshk - 3)
IF br% < VAL(reg(2, lshi)) OR br% > VAL(reg(3, lshi)) THEN
SendBz = 2
timestat(0, lshi) = 1
END IF
CASE "D"
a(7) = result1(lshk - 3): a(6) = result1(lshk - 4): a(5) = result1(lshk - 5): a(4) = result1(lshk - 6)
a(3) = result1(lshk - 7): a(2) = result1(lshk - 8): a(1) = result1(lshk - 9): a(0) = result1(lshk - 10)
dr# = Ieee2Double(a())
IF dr# < VAL(reg(2, lshi)) OR dr# > VAL(reg(3, lshi)) THEN
SendBz = 2
timestat(0, lshi) = 1
END IF
CASE ELSE
END SELECT
END IF
IF lshi < MaxNum - 1 THEN
msgreturn = msgreturn + " "
ELSE
END IF
END IF
lshi = lshi + 1
LOOP
CALL FeedWatchDog 'If have no this line,the computer will be reset after a while.
IF SendBz > 0 THEN
SendBz = SendBz - 1
FOR lshc = 0 TO MaxNum - 1
IF tel(lshc) <> "" THEN
DSendMsg msgreturn, tel(lshc)
END IF
NEXT lshc
END IF
IF GetMsgFromPhone(NextSmsNo, phmsg) THEN
CALL Dealmsg(phmsg)
END IF
NextSmsNo = NextSmsNo + 1
IF NextSmsNo = MaxMsgNum + 1 THEN NextSmsNo = 1
WEND
PRINT #11, bye
CLOSE #11
CLOSE #12
END
dealtime:
FOR dtlshi% = 0 TO MaxNum - 1
IF timestat(0, dtlshi%) = 1 THEN
timestat(1, dtlshi%) = timestat(1, dtlshi%) + 1
IF timestat(1, dtlshi%) >= interval THEN timestat(0, dtlshi%) = 0: timestat(1, dtlshi%) = 0
END IF
NEXT dtlshi%
RETURN
snoopmsg:
COM(2) OFF
MsgFromPhone = MsgFromPhone + INPUT$(LOC(12), #12)
IF INSTR(MsgFromPhone, "RING") OR INSTR(MsgFromPhone, "CMTI") THEN
SendBz = 1
MsgFromPhone = ""
END IF
COM(2) ON
RETURN
handler:
Delay (1)
RESUME
FUNCTION CalculateCharacterCRC16% (pcrc%, pc%)
DIM Llncrc AS LONG
DIM Lshcrc1, Lshcrc2 AS INTEGER
Llncrc = S2L(pcrc%)
CalculateCharacterCRC16 = L2S((Llncrc * 256) XOR GENCRC16((Llncrc \ 256) XOR pc%))
END FUNCTION
SUB ChangeFile (cfstr1$, cfstr2$())
DIM str1 AS STRING
DIM lshi AS INTEGER
IF cfstr2$(0) = "" THEN RETURN
PRINT "Copying m.txt message.txt /y!"
SHELL "copy m.txt message.txt /y"
PRINT "Openning m.txt!"
OPEN "m.txt" FOR INPUT AS #13
PRINT "Openning m1.txt!"
OPEN "m1.txt" FOR OUTPUT AS #14
DO
LINE INPUT #13, str1
IF INSTR(str1, cfstr1$) THEN
PRINT #14, LTRIM$(RTRIM$(cfstr1$))
WHILE cfstr2$(lshi) <> ""
PRINT #14, cfstr2$(lshi)
lshi = lshi + 1
WEND
lshi = 0
LINE INPUT #13, str1
WHILE INSTR(str1, "[") = 0
LINE INPUT #13, str1
WEND
END IF
PRINT #14, str1
LOOP UNTIL INSTR(str1, "[End]")
CLOSE #14
CLOSE #13
KILL "m.txt"
NAME "m1.txt" AS "m.txt"
END SUB
SUB ChangReg (a$, b$())
DIM str AS STRING
DIM lshi AS INTEGER
DIM startt AS STRING
DIM endt AS STRING
IF b$(0) = "" THEN RETURN
SELECT CASE a$
CASE "[Tel]"
FOR lshi = 0 TO MaxNum - 1
tel(lshi) = ""
NEXT lshi
lshi = 0
WHILE b$(lshi) <> ""
tel(lshi) = b$(lshi)
lshi = lshi + 1
WEND
CASE "[Reg]"
FOR lshi = 0 TO MaxNum - 1
reg(0, lshi) = "": reg(1, lshi) = "": reg(2, lshi) = "": reg(3, lshi) = ""
NEXT lshi
lshi = 0
WHILE b$(lshi) <> ""
str = b$(lshi)
reg(0, lshi) = LEFT$(str, INSTR(str, ",") - 1)
str = RIGHT$(str, LEN(str) - INSTR(str, ","))
reg(1, lshi) = LEFT$(str, INSTR(str, ",") - 1)
str = RIGHT$(str, LEN(str) - INSTR(str, ","))
reg(2, lshi) = LEFT$(str, INSTR(str, ",") - 1)
str = RIGHT$(str, LEN(str) - INSTR(str, ","))
reg(3, lshi) = str
lshi = lshi + 1
WEND
CASE "[Cen]"
CentralCode = b$(0)
PRINT "Setting centalcode!"
PRINT #12, "AT+CSCA=" + CHR$(34) + RTRIM$(LTRIM$(CentralCode)) + CHR$(34) + CHR$(13) 'SetupCenterCode
str = ""
startt = TIME$
DO
str = MsgFromPhone
endt = TIME$
IF (60 + VAL(RIGHT$(endt, 2)) - VAL(RIGHT$(startt, 2))) MOD 60 > MaxT THEN
PRINT "Set CentralCode failed!"
EXIT DO
END IF
LOOP UNTIL INSTR(str, "OK")
MsgFromPhone = ""
IF INSTR(str, "OK") THEN PRINT "Set CentralCode sucess!"
CASE "[Tim]"
interval = VAL(b$(0))
CASE ELSE
END SELECT
END SUB
SUB Dealmsg (phmsg$)
DIM lshi, lshj, lshk, lshc AS INTEGER
DIM str AS STRING
DIM a AS STRING
DIM b(0 TO 9) AS STRING
DIM c(0 TO 3, 0 TO 9) AS STRING
DIM d(0 TO 7) AS INTEGER
lshj = 0
DO WHILE phmsg$ <> ""
lshk = 0
str = ""
WHILE lshk < LEN(phmsg$) / 2
str = str + CHR$(VAL("&H" + MID$(phmsg$, lshk * 2 + 1, 2)))
lshk = lshk + 1
WEND
'str = "[Reg]" + CHR$(13) + "e000f" + STRING$(4, 0) + STRING$(4, 1)
a = LEFT$(str, 5)
str = RIGHT$(str, LEN(str) - 5)
SELECT CASE a
CASE "[Reg]"
lshi = 0
WHILE LEN(str) >= 8
b(lshi) = MID$(str, 2, ASC(LEFT$(str, 1)))
c(0, lshi) = LEFT$(b(lshi), 4)
c(1, lshi) = MID$(b(lshi), 5, 1)
SELECT CASE UCASE$(c(1, lshi))
CASE "F"
IF LEN(b(lshi)) <> 13 THEN EXIT DO
d(0) = ASC(MID$(b(lshi), 6, 1)): d(1) = ASC(MID$(b(lshi), 7, 1)): d(2) = ASC(MID$(b(lshi), 8, 1)): d(3) = ASC(MID$(b(lshi), 9, 1))
c(2, lshi) = LEFT$(STR$(Ieee2Float(d())), 8)
d(0) = ASC(MID$(b(lshi), 10, 1)): d(1) = ASC(MID$(b(lshi), 11, 1)): d(2) = ASC(MID$(b(lshi), 12, 1)): d(3) = ASC(MID$(b(lshi), 13, 1))
c(3, lshi) = LEFT$(STR$(Ieee2Float(d())), 8)
CASE "D"
IF LEN(b(lshi)) <> 21 THEN EXIT DO
d(0) = ASC(MID$(b(lshi), 6, 1)): d(1) = ASC(MID$(b(lshi), 7, 1)): d(2) = ASC(MID$(b(lshi), 8, 1)): d(3) = ASC(MID$(b(lshi), 9, 1))
d(4) = ASC(MID$(b(lshi), 10, 1)): d(5) = ASC(MID$(b(lshi), 11, 1)): d(5) = ASC(MID$(b(lshi), 12, 1)): d(6) = ASC(MID$(b(lshi), 13, 1))
c(2, lshi) = LEFT$(STR$(Ieee2Double(d())), 8)
d(0) = ASC(MID$(b(lshi), 14, 1)): d(1) = ASC(MID$(b(lshi), 15, 1)): d(2) = ASC(MID$(b(lshi), 16, 1)): d(3) = ASC(MID$(b(lshi), 17, 1))
d(4) = ASC(MID$(b(lshi), 18, 1)): d(5) = ASC(MID$(b(lshi), 19, 1)): d(5) = ASC(MID$(b(lshi), 20, 1)): d(6) = ASC(MID$(b(lshi), 121, 1))
c(3, lshi) = LEFT$(STR$(Ieee2Double(d())), 8)
CASE "B"
IF LEN(b(lshi)) <> 7 THEN EXIT DO
c(2, lshi) = MID$(b(lshi), 6, 1)
c(3, lshi) = MID$(b(lshi), 7, 1)
CASE ELSE
EXIT DO
END SELECT
b(lshi) = c(0, lshi) + "," + LTRIM$(c(1, lshi)) + "," + LTRIM$(c(2, lshi)) + "," + LTRIM$(c(3, lshi))
str = RIGHT$(str, LEN(str) - ASC(MID$(str, 1, 1)) - 1)
lshi = lshi + 1
WEND
CASE "[Tel]"
lshi = 0
WHILE LEN(str) >= 12
b(lshi) = MID$(str, 2, ASC(LEFT$(str, 1)))
IF LEN(LTRIM$(b(lshi))) <> 11 THEN EXIT DO
str = RIGHT$(str, LEN(str) - ASC(MID$(str, 1, 1)) - 1)
lshi = lshi + 1
WEND
CASE "[Cen]"
b(0) = RIGHT$(str, LEN(str) - 1)
IF LEN(LTRIM$(b(0))) <> ASC(LEFT$(str, 1)) THEN EXIT DO
CASE "[Tim]"
b(0) = RIGHT$(str, LEN(str) - 1)
IF VAL(b(0)) <= 60 OR VAL(b(0)) > &H7FFFFFFF THEN EXIT DO
IF LEN(LTRIM$(b(0))) <> ASC(LEFT$(str, 1)) THEN EXIT DO
CASE ELSE
END SELECT
IF b(0) <> "" THEN
PRINT "Changing m.txt!"
CALL ChangeFile(a, b())
PRINT "Changing Register!"
CALL ChangReg(a, b())
FOR lshc = 0 TO MaxNum - 1
IF tel(lshc) <> "" THEN
DSendMsg "Set" + a + "OK!", tel(lshc)
END IF
NEXT lshc
END IF
lshj = lshj + 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -