| |
PA3BNX > ALL 19.01.06 23:46l 530 Lines 9619 Bytes #999 (0) @ EU
BID : 6707_PI8SHB
Read: GUEST SP6FIG
Subj: Rem lpt tsthost source.
Path: DB0FHN<DB0FOR<DB0SIF<DB0EA<DB0RES<ON0AR<PI8ZAA<PI8SHB
Sent: 060119/2033Z @:PI8SHB.#NBO.NLD.EU #:6707 ['s-Hertogenbosch] $:6707_PI8SHB
From: PA3BNX@PI8SHB.#NBO.NLD.EU
To : ALL@EU
DECLARE FUNCTION searchold$ (newlptpins AS STRING)
DECLARE SUB welcome ()
DECLARE SUB readcall ()
DECLARE FUNCTION StripSSID$ (effe AS STRING)
DECLARE FUNCTION reverse$ (effe AS STRING)
DECLARE SUB logging ()
DECLARE SUB setlpt ()
DECLARE SUB helponscreen ()
DECLARE FUNCTION dec2bin$ (dec AS INTEGER)
DECLARE FUNCTION bin2dec! (bin AS STRING)
DECLARE SUB checkcall ()
DECLARE SUB getlpt ()
DECLARE SUB Extractcommand ()
DECLARE SUB datacall ()
DECLARE FUNCTION Deviceextract! ()
DECLARE SUB datadevicelist ()
''((C)) PA3BNX LPT-PROGRAM for TSTHost143c 29-12-2005.
''Constants.
CONST ve$ = "((C))PA3BNX LPT Remote Version 1.08"
''Where is the pg dir.
CONST path = "c:\tst\pg\"
CONST lptlog$ = "lptlog.txt"
CONST callsfile$ = "lptcall.txt"
CONST progname$ = " REM "''Think of spaces begin and end in helponscreen.
CONST count = 12''Aantal device names.
''Arrays.
DIM SHARED Allowedcalls(1 TO 10) AS STRING ''Call list.
DIM SHARED tekst(1 TO 10) AS STRING ''The extracted command$tring.
DIM SHARED device(1 TO count) AS STRING
DIM SHARED deviceadress(1 TO count) AS STRING
''Variables.
COMMON SHARED port AS INTEGER
COMMON SHARED port1 AS INTEGER ''Names port number
COMMON SHARED nopath AS INTEGER
COMMON SHARED nolist AS INTEGER
COMMON SHARED callsign AS STRING
COMMON SHARED sessie AS STRING
COMMON SHARED commando AS STRING
COMMON SHARED lptpins AS STRING
IF COMMAND$ = "" THEN
PRINT "Use it in TSTHOST143c"
END
END IF
''Test routines.
CLS
'PRINT COMMAND$
ON ERROR GOTO 500
''Main program.
'=========================================================
CALL logging ''Logging all recieved commands.
Start:
CALL Extractcommand ''Extract callsign, sessie and command.
CALL readcall ''Reading permission calls from file.
Further:
CALL datadevicelist ''Device list
CALL checkcall ''Check for call permissie.
CALL welcome ''Gives welcome + undeline.
CALL helponscreen ''Help text and or stop <lpt1 and >lpt4.
CALL getlpt
CALL setlpt
PRINT
PRINT ve
BEEP
SYSTEM
'==========================================================
''Error trap.
500 :
IF ERR = 53 OR ERR = 76 THEN
IF nopath = 0 THEN
CALL datacall ''No callsfile$ found.
GOTO Further
ELSEIF nopath = 1 THEN ''Path found.
GOTO Start
END IF
ELSE
PRINT "Error" + STR$(ERR) + " occurred."
END IF
'==========================================================
SYSTEM
FUNCTION bin2dec (bin AS STRING)
''Convert string binair to decimaal long.
DIM x AS INTEGER
DIM y AS INTEGER
DIM z AS INTEGER
DIM length AS INTEGER
DIM j AS INTEGER
bin = LTRIM$(bin)
bin = RTRIM$(bin)
length = LEN(bin)
FOR j = length TO 1 STEP -1
x = VAL(MID$(bin, j, 1))
IF x = 1 AND j = length THEN
x = 0
ELSEIF x = 1 THEN
x = 2
ELSE
GOTO under
END IF
y = y + (x ^ z)
under:
z = z + 1
NEXT j
bin2dec = y
END FUNCTION
SUB checkcall
''Check here for calls allowed.
DIM x AS INTEGER
DIM y AS INTEGER
y = UBOUND(Allowedcalls)
FOR x = 1 TO y
IF UCASE$(StripSSID$(Allowedcalls(x))) = StripSSID$(callsign) THEN
EXIT SUB
END IF
NEXT x
PRINT "No permission to do that " + callsign + "."
END
END SUB
SUB datacall
''All calls allowed to set the lptport.
Allowedcalls(1) = StripSSID$(callsign)
''Specified calls only allowed.
'allowedcalls(1) = "PA3BNX"
'allowedcalls(2) = "G8MNY"
'allowedcalls(3) = "PA0CVW"
'allowedcalls(4) = "PA0PDO"
END SUB
SUB datadevicelist
''Port to switch remote.
'port1 = 888
'port1 = 956
port1 = 632
''Adjust here the table.
device(1) = "Off"
deviceadress(1) = "00000000"
device(2) = "All"
deviceadress(2) = "00001111"
device(5) = "12Volt"
deviceadress(5) = "xxxx1xxx"
device(6) = "Lamp1"
deviceadress(6) = "xxxxx1xx"
device(7) = "Radio"
deviceadress(7) = "xxxxxx1x"
device(8) = "Lamp2"
deviceadress(8) = "xxxxxxx1"
''Off
device(9) = "-12Volt"
deviceadress(9) = "xxxx0xxx"
device(10) = "-Lamp1"
deviceadress(10) = "xxxxx0xx"
device(11) = "-Radio"
deviceadress(11) = "xxxxxx0x"
device(12) = "-Lamp2"
deviceadress(12) = "xxxxxxx0"
END SUB
FUNCTION dec2bin$ (dec AS INTEGER)
''Convert here decimal integer to bin string
''Like 10 = "01001000"
'' lsb>msb
''Max 255. Always length 8 string
'From decimal to binairy methode.
'46/2=23 rest 0
'23/2=11 rest 1
'11/2=5 rest 1
' 5/2=2 rest 1
' 2/2=1 rest 0
' 1/2 = 0 rest 1
'So 46 = 101110
DIM rest(0 TO 20) AS INTEGER
DIM x AS INTEGER
DIM y AS INTEGER
DIM effe AS INTEGER
DIM b AS STRING
FOR x = 0 TO 20
rest(x) = 0
NEXT x
x = 0
effe = dec
DO UNTIL effe = 0
rest(x) = effe MOD 2
effe = effe \ 2
x = x + 1
LOOP
FOR y = 7 TO 0 STEP -1
b = b + LTRIM$(STR$(rest(y)))
NEXT y
dec2bin = b
END FUNCTION
FUNCTION Deviceextract
''Switch here by just names.
DIM x AS INTEGER
DIM y AS INTEGER
IF LEN(tekst(3)) = 0 THEN EXIT FUNCTION
FOR x = 1 TO UBOUND(device)
IF tekst(3) = UCASE$(device(x)) THEN
port = port1
lptpins = deviceadress(x)
lptpins = reverse$(deviceadress(x))
IF LCASE$(device(x)) = "off" THEN
PRINT "All switched off."
ELSEIF MID$(device(x), 1, 1) = "-" THEN
PRINT device(x) + " = switched off."
ELSE
PRINT device(x) + " = switched on."
END IF
Deviceextract = 1
EXIT FUNCTION
END IF
NEXT x
END FUNCTION
SUB Extractcommand
''Extract here call, sessie and command from tsthost.
''PA3BNX-1 0 %1
DIM i AS INTEGER
DIM x AS INTEGER
DIM y AS INTEGER
DIM z AS INTEGER
DIM effe AS STRING
y = 1
z = LEN(COMMAND$)
''Search for spaces.
DO
i = i + 1
FOR x = y TO z
IF MID$(COMMAND$, x, 1) <> " " THEN
tekst(i) = tekst(i) + MID$(COMMAND$, x, 1)
ELSE
EXIT FOR
END IF
NEXT x
IF x < z AND i < 10 THEN
y = x + 1
ELSE
EXIT DO
END IF
LOOP
''Assign the datafields.
callsign = tekst(1)
sessie = tekst(2)
commando = tekst(3)
''No more then 8 chars.
''No less then 8 chars hi.
''Or empty
z = LEN(tekst(4))
IF z > 8 THEN tekst(4) = MID$(tekst(4), 1, 8)
IF z < 8 AND z <> 0 THEN
DO UNTIL LEN(tekst(4)) = 8
tekst(4) = tekst(4) + "x"
LOOP
END IF
lptpins = reverse$(tekst(4))
END SUB
SUB getlpt
PRINT "Old LPT &h" + HEX$(port) + " = " + reverse$(dec2bin(INP(port)))
END SUB
SUB helponscreen
''Here some print routines for help.
DIM z AS INTEGER
z = LEN(commando)
''Check this function.
IF Deviceextract = 1 THEN EXIT SUB
IF commando = "?" THEN
PRINT "Possible devices:"
FOR x = 1 TO UBOUND(device)
IF LEN(device(x)) > 0 THEN
PRINT device(x)
END IF
NEXT x
PRINT ve
END
END IF
IF MID$(commando, 1, 3) <> "LPT" OR LEN(commando) <= 3 THEN
PRINT "Use" + progname$ + "LPT1 xxx0xxxx to set the lptpins remotely."
PRINT "xxxxxxxx means pin 2 > pin 9 of a db25 lpt connector."
PRINT "So x means does not care, 1 = on and 0 = off."
PRINT LTRIM$(progname$) + "LPT1 just gives the status of lpt1."
PRINT
PRINT ve
END
END IF
''To short string.
IF z < 4 AND MID$(commando, 1, 3) <> "LPT" THEN END
''Out of range.
IF VAL(MID$(commando, 4, 1)) > 3 OR VAL(MID$(commando, 4, 1)) < 1 THEN END
''Select lpt portnumber.
SELECT CASE VAL(MID$(commando, 4, 1))
CASE 1
port = 888
CASE 2
port = 956
CASE 3
port = 632
END SELECT
''Just show the lptstatus.
IF z = 4 AND lptpins = "" THEN
CALL getlpt
END
END IF
END SUB
SUB logging
''Here logging of all cmd's.
nopath = 0''Path not found yet.
OPEN path + lptlog$ FOR APPEND AS #1
WRITE #1, COMMAND$, DATE$, TIME$
CLOSE #1
nopath = 1 ''Path found.
END SUB
SUB readcall
''Read here the permission calls.
DIM x AS INTEGER
DIM effe AS STRING
'PRINT path + callsfile$
nopath = 0 ''Path not found yet.
nolist = 0''List not found yet.
OPEN path + callsfile$ FOR INPUT AS #1
DO
x = x + 1
INPUT #1, effe
Allowedcalls(x) = UCASE$(effe)
LOOP UNTIL EOF(1) OR x = UBOUND(Allowedcalls)
CLOSE #1
nopath = 1''Path found.
nolist = 1''List found.
END SUB
FUNCTION reverse$ (effe AS STRING)
''Reverse a string here.
DIM x AS INTEGER
DIM effe2 AS STRING
FOR x = LEN(effe) TO 1 STEP -1
effe2 = effe2 + MID$(effe, x, 1)
NEXT x
reverse$ = effe2
END FUNCTION
FUNCTION searchold$ (newlptpins AS STRING)
''Returns a string
''Search Old lptpins and new and combine them.
DIM x AS INTEGER
DIM oldpins AS STRING
DIM effe AS STRING
DIM myval AS STRING
''Get old lptpins.
''Get new lptpins.
''Combine lptpins.
''Search for x,0,1
''Oldpins does only contain 0 and 1's.
oldpins = dec2bin(INP(port))
FOR x = 1 TO 8
myval = LCASE$(MID$(newlptpins, x, 1))
IF myval = "x" OR myval = "." THEN effe = effe + MID$(oldpins, x, 1)
IF myval = "1" THEN effe = effe + "1"
IF myval = "0" THEN effe = effe + "0"
IF myval <> "1" AND myval <> "0" AND myval <> "." AND myval <> "x" THEN
effe = effe + "0"
END IF
NEXT x
searchold = effe
END FUNCTION
SUB setlpt
''Set here the lptport.
DIM x AS INTEGER
''Limit to max 8.
IF LEN(lptpins) > 8 THEN lptpins = MID$(lptpins, 1, 8)
x = bin2dec(searchold(lptpins))
OUT (port), x''Set the pins.
'Show the user te settings
'Reverse it again hi...
PRINT "New LPT &h" + HEX$(port) + " = " + reverse$(dec2bin(x))
END SUB
FUNCTION StripSSID$ (effe AS STRING)
'Strip here ssid from calls
'pa3bnx-2 becomes pa3bnx
DIM x AS INTEGER
DIM effe2 AS STRING
FOR x = 1 TO LEN(effe)
IF MID$(effe, x, 1) <> "-" THEN
effe2 = effe2 + MID$(effe, x, 1)
ELSE
EXIT FOR
END IF
NEXT x
StripSSID$ = effe2
END FUNCTION
SUB welcome
DIM effe AS STRING
DIM effe1 AS STRING
IF nolist = 0 THEN effe1 = " All welcome."
effe = "Hello " + callsign + " @ " + TIME$ + "." + effe1
PRINT effe
FOR x = 1 TO LEN(effe)
PRINT "-";
NEXT x
PRINT
END SUB
Read previous mail | Read next mail
| |
