OpenVMS Source Code Demos
BASIC_QIO_DEMO.BAS
1000 %title "BASIC-qio-demo_xxx.bas" !
%ident "101.1" ! <<<---+---
declare string constant k_version = "101.1" , ! <<<---+ &
k_program = "BASIC-qio-demo" !
!=========================================================================================================================
! Title : BASIC-QIO-demo_xxx.bas
! Author : Neil Rieck
! Created: 2003.11.23
! Purpose: To demo qio calls to an async port (this one dials a telephone pager service)
!=========================================================================================================================
! History:
! -------
! Ver Who When What
! --- --- ------ ---------------------------------------------------------------------------------------------------------
! 100 NSR 031123 1. Original code
! 101 NSR 110423 1. mini-cleanup prior to republishing to public domain
!=========================================================================================================================
option type=explicit ! no kid stuff
set no prompt ! no "?" at prompts
!
%include "[.inc]VMS_STRUCTURES.INC" ! records for system calls, etc.
%include "starlet" %from %library "sys$library:basic$starlet" ! system services
%include "$ssdef" %from %library "sys$library:basic$starlet" ! ss$
%include "$iodef" %from %library "sys$library:basic$starlet" ! io$
%include "$lnmdef" %from %library "sys$library:basic$starlet" ! lnm$
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$
%include "$libdef" %from %library "sys$library:basic$starlet" ! lib$_normal
!
! <<< home brewed functions >>>
!
external string function wcsm_dt_stamp() ! see end of this program
external string function wcsm_trnlnm(string,string) ! see end of this program
external long function wcsm_submit_to_batch(string,string,string, &
string,string,string,string,string,string,string,string,string)
!
! <<< constant declarations (non-system service) >>>
!
declare string constant CRLF = '13'C + '10'C , ! &
Ctrl_T = '20'C , ! control-t &
Ctrl_V = '22'C ! control-v
!
declare string constant STX = '02'C , ! set up control characters &
ETX = '03'C , ! &
EOT = '04'C , ! &
ACK = '06'C , ! &
XON = '17'C , ! ctrl-Q &
CAN = '30'C , ! &
NAK = '21'C , ! &
ESC1 = '27'C !
!
! <<< variable declarations >>>
!
declare string xmit_count$(400%) ! keeps track of xmit messages
declare string packet$(400%) ! up to 400 messagee can be sent at one time.
declare string illegal_num$(400%) ! keeps track of illegal pager numbers
declare long junk% , !&
applic_debug% , !&
sleep% , !&
string dump_string$ !
declare string junk$ , ! whatever &
default_node$ , ! &
pag_port$ , ! port to use for paging &
logging$ , ! logging level &
choice$ , ! menu choice &
current_dt$ , ! &
date_total$ , ! &
rename_time$ , ! renames pager file to .old &
tel_num$ , ! hold local phone number &
ssmr_comm$ , ! hold long distance number &
mail_filename$ , ! &
mail_address$ , ! &
area_code$ , ! used by the mail pcs section &
! for building pcs mail address &
long pass_count% , ! which number to call &
file_open81% , ! is pager_101.dat open &
illegal% , ! keeps track of illegal pager # &
xmit_ok% , ! number xmitt messages &
page_num% , ! which number to call &
ats10% , ! abandoning pag line error &
notify_staff% , ! alarm server notify &
test_page% , ! test message sent &
temp% , ! checks to see if message numeric &
sleeper% , ! heart beat &
watchdog% , ! counts watchdog &
message_count% , ! send another message &
total_message% , ! count total number of messages &
error_handler% , ! incase of erorr &
sleep_count% , ! keep modem wake &
sleep_set% , ! keep modem wake &
restart_count% , ! restart counter &
char_count , ! &
timeout_count , ! time out count &
polling_count , ! &
timeout_flag , ! 1=true &
comm_error , ! &
alloc_flag , ! 1=true &
event_flag_recv , ! event flags read &
event_flag_xmit , ! write &
word funct_bits_rtp , ! funct bits - read timed purge &
word funct_bits_rtnp , ! read timed no purge &
word funct_bits_recv , ! funct bits - read &
word funct_bits_xmit , ! funct bits - write &
string async_port$ , ! (change state) &
my_file$ , ! &
xmit_data , ! &
recv_data !
!
declare string line1$ ,&
line2$ ,&
packet$ ,&
checksum$ ,&
long i% ,&
checksum% ,&
char1% ,&
char2% ,&
char3%
declare rfa rfa_8x ! record file address
!
! <<< program constants >>>
!
declare long constant k_buf_siz = 132% ! for qio recv + qio xmit
declare string constant k_num_list = "0123456789"
!
! <<< device specific stuff >>>
!
map(neil) &
string dev_buf_xmit = k_buf_siz , ! xmit data buffer - xmit &
string dev_buf_Recv = k_buf_siz , ! recv data buffer - recv &
word dev_ch_xmit, ! xmit channel number - xmit &
dev_ch_recv, ! recv channel number - recv &
IosbRec iosb_xmit, ! i/o status block - xmit &
iosb_recv ! i/o status block - recv
!
declare long rc% , ! return code &
sys_line ! line number
!
! set up terminator descriptor block for qio_read
!
declare TDB_Rec TDB_Var ! create terminator descriptor block for qio_read
!
! fill in the descriptor block's fields
! note: see "OpenVMS_7.2-1 I/O User's Reference Manual"
! "5.4.1.2 Read Function Terminators"
!
TDB_Var::mask_type = 0% ! we only want the "short form" of this call
TDB_Var::mask = 2%^13% ! <CR> is the only terminator we wish to use
!
!=======================================================================
! Title: PAGERDB_101.REC
!=======================================================================
declare string constant pagerdb_fs$ = "csmis$dat:pagerdb_101.dat"
!=======================================================================
! Map used in the pager program
!
! key-0 ,primary key (d81_recv_date,d81_recv_time) duplicates descending
! key-1 ,alternate key d81_pager duplicates
! key-2 ,alternate key d81_status duplicates changes
! key-3 ,alternate key d81_last_name duplicates changes
!=======================================================================
map (my_disk81) &
string d81_whole_record= 170, ! 170 &
d81_align = 0 ! force alignment check
map (my_disk81) &
string d81_whole_data = 161, ! 161 &
filler81$ = 9, ! room to grow ... 170 &
d81_align = 0 ! force alignment check
map (my_disk81) &
string d81_last_name = 20, ! last name of pagee 20 &
d81_pager = 8, ! 28 &
d81_pager_type = 1, ! P=pcs 29 &
d81_message_buf = 96, ! message lines 1-5 125 &
d81_recv_date = 8, ! ccyymmdd 133 &
d81_recv_time = 6, ! hhmmss 139 &
d81_xmit_date = 8, ! ccyymmdd 147 &
d81_xmit_time = 6, ! hhmmss 153 &
d81_status = 1, ! page sent Y/N 154 &
d81_pin = 7, ! pin number 161 &
filler81$ = 9, ! room to grow ... &
d81_align = 0 ! force alignment check
map (my_disk81) &
string d81_last_name = 20, ! last name of pagee 20 &
d81_pager = 8, ! 28 &
d81_pager_type = 1, ! 29 &
d81_message1 = 16, ! message line #1 45 &
d81_message2 = 20, ! 2 65 &
d81_message3 = 20, ! 3 85 &
d81_message4 = 20, ! 4 105 &
d81_message5 = 20, ! 5 125 &
d81_recv_date = 8, ! ccyymmdd 133 &
d81_recv_time = 6, ! hhmmss 139 &
d81_xmit_date = 8, ! ccyymmdd 147 &
d81_xmit_time = 6, ! hhmmss 153 &
d81_status = 1, ! page sent Y/N 154 &
d81_pin = 7, ! pin number 161 &
filler81$ = 9, ! room to grow ... &
d81_align = 0 ! force alignment check
!
!=======================================================================
! Initialize
!=======================================================================
1300 on error goto error_trap ! get rid of this (when-error blocks are better)
!
! <<< set up function bits for QIO >>>
!
! Read, Timed, w/Purge
!
funct_bits_rtp = (IO$_READVBLK or &
IO$M_DSABLMBX or &
IO$M_Purge or &
IO$M_NoFILTR or &
IO$M_Timed or &
IO$M_NOECHO)
!
! Read, Timed, No Purge
!
funct_bits_rtnp = (IO$_READVBLK or &
IO$M_DSABLMBX or &
IO$M_NoFILTR or &
IO$M_Timed or &
IO$M_NOECHO)
!
! Write (unformatted)
!
funct_bits_xmit = (IO$_WRITEVBLK or &
IO$M_CanCtrlO or &
IO$M_NoFormat)
!
!=======================================================================
! Main
!=======================================================================
1500 main: !
margin #0, 132 ! limit wrapping of the log file
print k_program +"_"+ k_version
print string$(len(k_program +"_"+ k_version), asc("=")) ! underline previous line
applic_debug% = 999 ! start debugging with a high value
!
! /// get desired async port ///
!
! LIB$GET_LOGICAL logical-name [,resultant-string] [,resultant-length] [,table-name]
!
rc% = lib$get_logical("DEMO$ASYNC_PORT", async_port$,,"LNM$PROCESS")
if ((rc% and 7%) <> 1%) then
print "-e- error: "+ str$(rc%) +" while reading logical DEMO$ASYNC_PORT"
goto fini ! adios
end if
print "-i- using async port: ";async_port$
!
! /// get desired phone number ///
!
rc% = lib$get_logical("DEMO$TELEPHONE", tel_num$,,"LNM$PROCESS")
if ((rc% and 7%) <> 1%) then
print "-e- error: "+ str$(rc%) +" while reading logical DEMO$TELEPHONE"
goto fini ! adios
end if
print "-i- using telephone number: ";tel_num$
!
! <<< try to allocate the device >>>
!
1510 allocate_port:
rc% = sys$alloc( async_port$,,,,)
!
select rc%
case ss$_normal
alloc_flag = 1%
print "-i- Allocated Device: ";async_port$
case else
print "-e- Can't allocate device: ";async_port$
sys_line = 2100%
goto sys_error
end select
!
! <<< open a read channel >>>
!
1520 rc% = sys$assign( async_port$, dev_ch_recv,,)
if rc% <> ss$_normal then
sys_line = 2200%
goto sys_error
end if
print "-i- using channel(r): ";dev_ch_recv
!
! <<< open a write channel >>>
!
1530 rc% = sys$assign( async_port$, dev_ch_xmit,,)
if rc% <> ss$_normal then
sys_line = 2200%
goto sys_error
end if
print "-i- using channel(x): ";dev_ch_xmit
!
! <<< get an event flag for recv >>>
!
1540 rc% = lib$get_EF(event_flag_recv by ref)
if rc% <> ss$_normal then
sys_line = 2300%
goto sys_error
end if
print "-i- using EF(r): ";event_flag_recv
!
! <<< get an event flag for xmit >>>
!
1550 rc% = lib$get_EF(event_flag_xmit by ref)
if rc% <> ss$_normal then
sys_line = 2400%
goto sys_error
end if
print "-i- using EF(x): ";event_flag_xmit
!
sleep 1
print "-i- doing 1st read with purge "
gosub qio_recvp ! recv with purge (good for 1st time)
!
! <<< initialize the modem >>>
!
modem_init:
!
! set up modem option R1 (reset?)
!
ATR1:
sleep 1%
print "-i- Sending AT&R1" ! setting CTS
xmit_data = "AT&R1" + CR ! send AT&R1 to modem
gosub qio_xmit ! transmit section
!
polling_count = 0 !
while 1 !
gosub qio_recv ! recv
if edit$(recv_data,32+4+2) <> "" then !
print "-i- Dat-00>";recv_data;"<" !
end if
if comm_error=1 then !
print "-e- comm error; initing modem (modem cleanup 1)" !
print "-i- Sending '+++' to wake up the modem port" !
sleep 2 ! delay 2 seconds
xmit_data = "+++" ! send escape sequence to modem
gosub qio_xmit ! send escape sequence to modem
sleep 2 ! delay 2 more second2
goto modem_init !
end if
goto ATC0 if mid$(recv_data,1%,3%) = "OK" !
polling_count = polling_count + 1%
if polling_count > 10% then ! > 10 clean up modem
print "-i- waited in loop 10 times (modem cleanup 1)" !
print "-i- Sending '+++' to wake up the modem port" !
sleep 2 ! delay 2 seconds
xmit_data = "+++" ! send escape sequence to modem
gosub qio_xmit ! send escape sequence to modem
sleep 2 ! delay 2 more second2
goto modem_init ! try this again
end if
next
!
! set up modem option C0
!
atc0:
sleep 1%
!
! set up modem option C1
!
print "-i- Sending AT&C1" ! setting DCD
xmit_data = "AT&C0" + CR ! send AT&C0 to modem
gosub qio_xmit ! transmit section
!
polling_count = 0 !
while 1 ! will wait in this loop
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then ! print rec data if >
print "-i- Dat-01>";recv_data;"<" ! nothing
end if
if comm_error=1 then !
print "-e- comm error; initing modem (modem cleanup 2)" !
print "-i- Sending '+++' to wake up the modem port" !
sleep 2 ! delay 2 seconds
xmit_data = "+++" ! send escape sequence to modem
gosub qio_xmit ! send escape sequence to modem
sleep 2 ! delay 2 more second2
goto modem_init !
end if
goto ATD0 if mid$(recv_data,1%,3%) = "OK" ! checking rec data
polling_count = polling_count + 1%
if polling_count > 10% then ! > 10 clean up modem
print "-i- waited in loop 10 times (modem cleanup 2)" !
print "-i- Sending '+++' to wake up the modem port" !
sleep 2 ! delay 2 seconds
xmit_data = "+++" ! send escape sequence to modem
gosub qio_xmit ! send escape sequence to modem
sleep 2 ! delay another 2 seconds
goto modem_init ! try this again
end if !
next !
!
! set up modem option D0
!
ATD0:
!
! set up modem option W
!
ATW:
print "-i- Sending AT&W" ! send to memory
sleep 1%
xmit_data = "AT&W" + CR ! send AT&W to modem
gosub qio_xmit ! transmit section
!
polling_count = 0 !
while 1 ! will wait in this loop
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then ! print rec data if >
print "-i- Dat-02>";recv_data;"<" !
end if
if comm_error=1 then !
print "-e- comm error; initing modem (modem cleanup 3)" !
print "-i- Sending '+++' to wake up the modem port" !
sleep 2 ! delay 2 seconds
xmit_data = "+++" ! send escape sequence to modem
gosub qio_xmit ! send escape sequence to modem
sleep 2 ! delay 2 more second2
goto modem_init !
end if
goto modem_set if mid$(recv_data,1%,3%) = "OK" ! checking rec data
polling_count = polling_count + 1%
if polling_count > 10% then ! > 10 clean up modem
print "-i- waited in loop 10 times (modem cleanup 3)" !
print "-i- Sending '+++' to wake up the modem port" !
sleep 2 ! delay 2 seconds
xmit_data = "+++" ! send escape sequence to modem
gosub qio_xmit ! send escape sequence to modem
sleep 2 ! delay another 2 seconds
goto modem_init ! try this again
end if
next
modem_set:
!
!
print "-i- ========== modem initialized; entering main while/next block =========="
pass_count% = 1% ! init (prep for 1st pass thru)
!
!====================================================================================================
! <<< stay in this loop forever >>>
!
! note: no code should reference applic_debug% prior to this point
! (but modem initialization does so debugging is always enabled before this point)
!====================================================================================================
!
while 1 ! This program will run every xx seconds.
!
! support for logging/tracing
!
! LIB$GET_LOGICAL logical-name [,resultant-string] [,resultant-length] [,table-name]
!
rc% = lib$get_logical("CSMIS$APPL_PAG_SERVER_LOG", logging$,,"LNM$SYSTEM_TABLE")
logging$ = ""
if ((rc% and 7%) <> 1%) then
logging$ = ""
else
logging$ = edit$(logging$,32+2) !
logging$ = "2" if left$(logging$,1) = "Y" ! eg. Y/es -> 2
end if
when error in
junk% = integer(logging$)
use
junk% = 0
end when
if applic_debug% <> junk% then
applic_debug% = junk%
print "-i- switching to debug mode: ";applic_debug%
end if
!
! <<< start >>>
!
line1$ = "" !
line2$ = "" !
total_message% = 0% !
message_count% = 0% !
page_num% = 0% ! clear pager_num
gosub pager_packet ! get pager number and messages
!
if applic_debug% > 0 then !
if total_message% > 0% then !
print "-i- The total number of messages = "; !
print total_message% !
end if !
end if !
goto no_data if total_message% = 0% ! no messages to send
!
restart_count% = 0% ! clear counter
!=======================================================================
! <<< Restart modem >>>
!=======================================================================
1560 restart:
restart_count% = restart_count% + 1% !
xmit_data = XON ! send XON to port
gosub qio_xmit !
sleep 1 ! kill some time
!
gosub qio_recvp ! clean up the incoming buffer
print "-i- Sending ATH0 (going-on-hook)" if applic_debug% > 0 ! making sure modem is on hook
xmit_data = "ATH0" + CR ! send ATH0 to modem
gosub qio_xmit ! transmit section
!
polling_count = 0 ! clear polling counter
while 1 !
gosub qio_recv ! recv (waits for '<cr>' or '2 second timeout')
if edit$(recv_data,32+4+2) <> "" then ! any data?
print "-i- Dat-03>";recv_data;"<"
end if
if comm_error=1 then !
print "-e- comm error; restarting (modem cleanup 4)" !
print "-i- Sending '+++' to wake up the modem port" !
sleep 2 ! delay 2 seconds
xmit_data = "+++" ! send escape sequence to modem
gosub qio_xmit ! send escape sequence to modem
sleep 2 ! delay 2 more second2
goto restart !
end if
goto ATH0 if mid$(recv_data,1%,3%) = "OK" ! jump if we got an OK
polling_count = polling_count + 1 !
if polling_count > 10 then ! > 10 clean up modem
print "-i- waited in loop 10 times (modem cleanup 4)" !
print "-i- Sending '+++' to wake up the modem port" !
sleep 2 ! delay 2 seconds
xmit_data = "+++" ! send escape sequence to modem
gosub qio_xmit ! send escape sequence to modem
sleep 2 ! delay another 2 seconds
goto restart ! try this again
end if !
next
!
! modem is now on-hook
!
ATH0:
sleep 2% ! let modem settle down
print "-i- Sending AT (attention)" if applic_debug% > 0 ! displays next command
xmit_data = "AT" + cr ! send AT to modem
gosub qio_xmit ! transmit section
!
timeout_count = 0% ! clears counter
while 1 ! wait for response
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then ! print rec data if > nothing
print "-i- Dat-04>";recv_data;"<" if applic_debug% > 0
end if
if comm_error=1 then !
print "-e- comm error; restarting" !
goto restart !
end if
goto AT_OK if mid$(recv_data,1%,3%) = "OK" ! check for ok
if timeout_flag=1% then ! timeout flag set
timeout_count = timeout_count + 1%
if timeout_count > 20% then ! 20 tries
print "-i- waited 20 times; restarting"
goto restart
end if
end if
next
at_ok:
!
! Send the phone number of other modem
!
! If page_num% is set to 0% the local Bell Mobility number will be used. If it is set to a 1%,
! then the program tries to dump the messages to the Bell Mobility data base in Toronto.
!
xmit_data = "ATDT" + tel_num$ + cr ! prep to dial the telephone
sleep 2%
gosub qio_xmit ! transmit number to modem
!
timeout_count = 0%
while 1 ! wait for rec data
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then
print "-i- Dat-05>";recv_data;"<" if applic_debug% > 0
end if
if comm_error=1 then !
print "-e- comm error; restarting" !
goto restart !
end if
goto restart if mid$(recv_data,1%,2%) = "OK"
goto restart if mid$(recv_data,1%,4%) = "BUSY"
goto connected if mid$(recv_data,1%,4%) = "CONN"
!~~~ goto restart if mid$(recv_data,2%,1%) = "N" x ???
!~~~ goto restart if mid$(recv_data,1%,1%) = "N" x ???
goto restart if mid$(recv_data,1%,10) = "NO CARRIER" !
goto restart if mid$(recv_data,1%,13) = "NO CONNECTION" !
if mid$(recv_data,1%,05%) = "ATS10" then
ats10% = 1%
goto reset_3plus
end if
timeout_count = timeout_count + 1%
goto restart if timeout_count > 20%
next
!
! Connected to other modem
!
connected:
!
print "-i- Msg> Connected to pager company #"; pass_count% if applic_debug% > 0
timeout_count = 0%
!
!
!------------------------------------------------------------------------------------------------------------------------
! bf_122 Notes: (980316)
! ======================
! when we moved this application from the uVAX-4300 to the VAX-6420, this section of code stopped working. We had to add
! an extra call to qio_recv which eats the echoed <cr> which we just sent. Then we call qio_recv to test for the "ID="
! prompt from the other end.
!
! Note: We believe this echo stuff started to happen when Bell Mobility added a mux between their modems and their paging
! computer. At that same time they required that a <cr> be periodically sent to hold up the line when their computer is
! slow to respond (I guess the mux can actually drop an idle line)
!------------------------------------------------------------------------------------------------------------------------
while 1 ! wait for rec data
sleep 2% ! let modem settle down
xmit_data = cr !
gosub qio_xmit ! send <cr> to modem
timeout_count = 0 !
gosub qio_recv ! recv "echoed <cr>" or "ID="
if edit$(recv_data,32+4+2) = "" then ! if just an echoed <cr>...
gosub qio_recv ! then wait for "ID="
end if !
if edit$(recv_data,32+4+2) <> "" then
print "-i- Dat-06>";recv_data;"<" if applic_debug% > 0
end if
if comm_error=1 then !
print "-e- comm error; restarting" !
goto restart !
end if
goto ID if mid$(recv_data,1%,2%) = "ID" ! this is what we want so jump to next section
goto ID if mid$(recv_data,1%,2%) = "TDD" ! Quebec response ?
!~~~ goto restart if mid$(recv_data,2%,1%) = "N" x
if mid$(recv_data,1%,05%) = "ATS10" then
ats10% = 1%
goto reset_3plus
end if
goto restart if mid$(recv_data,1%,10) = "NO CARRIER" !
goto restart if mid$(recv_data,1%,13) = "NO CONNECTION" !
print " timeout_count = " + str$(timeout_count) ! added line to monitor missing pages
timeout_count = timeout_count + 1% !
if timeout_count > 60% then !
notify_staff% = notify_staff% + 1% !
if notify_staff% > 10% then ! if not send after 10 minute notify admin/CTL
PRINT "-i- Entered alarm section" !
!~~~ mail alarm message to system admin x
end if !
goto at_cleanup !
end if !
next !
!
! We just received the 'ID=' prompt so send '<esc>PG1' to Bell Mobility
!
id:
print "-i- Msg> Sending <esc>PG1 <<<---***" if applic_debug% > 0
if edit$( WCSM_TrnLnm( "CSMIS$PROV", "LNM$SYSTEM_TABLE" ),32+4+2) = "QUEBEC"
then
xmit_data = ESC1 + "PG1Bell01" + cr ! starting pager dialog (Quebec)
else
xmit_data = ESC1 + "PG1" + cr ! starting pager dialog (Ontario)
end if
gosub qio_xmit ! transmit section
!
timeout_count = 0%
while 1 ! wait for rec data
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then
print "-i- Dat-07>";recv_data;"<" if applic_debug% > 0
end if
if comm_error=1 then !
print "-e- comm error; restarting" !
goto restart !
end if
goto send_packet if mid$(recv_data,1%,2%) = "[p" ! this is what we want...
!~~~ goto restart if mid$(recv_data,2%,1%) = "N" x ???
!~~~ goto restart if mid$(recv_data,1%,1%) = "N" x ???
goto restart if mid$(recv_data,1%,10) = "NO CARRIER" !
goto restart if mid$(recv_data,1%,13) = "NO CONNECTION" !
if mid$(recv_data,1%,05%) = "ATS10" then
ats10% = 1%
goto reset_3plus
end if
timeout_count = timeout_count + 1%
goto restart if timeout_count > 20%
next
!
send_packet:
!
if total_message% > 0% then ! if > 0 the program
message_count% = message_count% + 1% ! has a message to
goto send_dis if message_count% > total_message% ! deliver
print "-i- Sending message "; + message_count% if applic_debug% > 0
end if ! the screen
!
print "-i- Msg> Sending Packet" if applic_debug% > 0
xmit_data = packet$(message_count%)
gosub qio_xmit ! sending message
1580 ! to Bell Molility
timeout_count = 0%
while 1
gosub qio_recv ! check receiver
if applic_debug% > 0 then
if pos( recv_data, NAK, 1%) > 0%
then
print "-i- Dat-08>NAK< Len:";len(recv_data)
else
print "-i- Dat-08>";recv_data;"< Len:";len(recv_data)
if len(recv_data) = 1% then
print "-i- Dat-08>";ASC(recv_data);"< Len:";len(recv_data)
end if
end if
end if !
if comm_error=1 then !
print "-e- comm error; goto NAK" !
goto NAK !
end if !
!
! Moved this piece of code down below the test for NAKs. This is to satisfy Quebec Bell Mobility
!
!if mid$(recv_data, 1%, 1%) = ACK then x message ack'ed
! xmit_ok% = message_count% x keeps track of
! goto send_packet x number of messages
!end if x sent
goto NAK if pos( recv_data, NAK, 1%) > 0% !
goto NAK if mid$(recv_data,1%,1%) = CAN ! added AGD 1996-03-14
goto NAK if mid$(recv_data,1%,5%) = "Illeg" !
goto NAK if mid$(recv_data,1%,5%) = "Too S" !
goto NAK if mid$(recv_data,1%,10) = "NO CARRIER" !
goto NAK if mid$(recv_data,1%,13) = "NO CONNECTION" !
!
if mid$(recv_data,1%,05%) = "ATS10" then !
ats10% = 1% !
goto reset_3plus !
end if !
if mid$(recv_data, 1%, 1%) = ACK then ! message ack'ed
xmit_ok% = message_count% ! keeps track of
goto send_packet ! number of messages
end if ! sent
timeout_count = timeout_count + 1% !
print "Waiting for ACK timeout_count = " + str$(timeout_count) !
goto send_dis if timeout_count > 40% !
iterate !
next !
!+
! Message was not OK
!-
NAK:
print "-e- Something is wrong please try again later..." !
print "-i- Dat-09>";recv_data;"<" !
illegal% = illegal% + 1% ! keeps track of failed
illegal_num$(illegal%) = str$(message_count%) ! messages
xmit_ok% = message_count% !
goto ACK if mid$(recv_data,1%,10) = "NO CARRIER" !
goto ACK if mid$(recv_data,1%,13) = "NO CONNECTION" !
goto send_packet !
!
! Message was OK
!
ACK:
send_dis:
message_count% = 0% !
total_message% = 0% !
print "-i- Msg> Sending disconnect" if applic_debug% > 0 !
xmit_data = EOT + cr ! backing away from Bell
gosub qio_xmit ! Mobility
!
timeout_count = 0% !
while 1 !
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then !
print "-i- Dat-10>";recv_data;"<" if applic_debug% > 0 !
end if !
if comm_error=1 then ! bf_130.1
print "-e- comm error; goto reset_3plus" !
goto reset_3plus !
end if !
1590 goto at_cleanup if mid$(recv_data,1%,03%) = "+++" !
goto at_cleanup if mid$(recv_data,1%,10) = "NO CARRIER" !
goto at_cleanup if mid$(recv_data,1%,13) = "NO CONNECTION" !
if mid$(recv_data,1%,05%) = "ATS10" then !
ats10% = 1% !
goto reset_3plus !
end if !
timeout_count = timeout_count + 1% !
goto reset_3plus if timeout_count > 20% !
next !
!
! send 3 plus signs to the modem (to get it out of data mode)
!
reset_3plus: !
sleep 2% !
print "-i- Sending +++ cleaning up modem port" if applic_debug% > 0 !
sleep 2 ! produce a 2 second silent period
xmit_data = "+++" ! send escape sequence to modem
gosub qio_xmit !
sleep 2 ! produce a 2 second silent period
!
timeout_count = 0% !
while 1 !
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then !
print "-i- Dat-11>";recv_data;"<" if applic_debug% > 0 !
end if !
!
! we're probably in trouble so just ignore comm errors
!
if comm_error=1 then ! bf_130.1
comm_error=0 !
end if !
!
!~~~ goto at_cleanup if mid$(recv_data,2%,1%) = "N" x ??? bf_128.7
!~~~ goto at_cleanup if mid$(recv_data,1%,1%) = "N" x ??? bf_128.7
goto at_cleanup if mid$(recv_data,1%,10) = "NO CARRIER" !
goto at_cleanup if mid$(recv_data,1%,13) = "NO CONNECTION" !
goto at_cleanup if mid$(recv_data,1%,3%) = "OK" !
goto at_cleanup if mid$(recv_data,1%,3%) = "+++" !
timeout_count = timeout_count + 1% !
goto at_cleanup if timeout_count > 3% !
next !
!
! now send the ATTENTION command
!
at_cleanup: !
sleep 2% !
print "-i- Sending AT cleaning up modem port" if applic_debug% > 0 !
xmit_data = "AT" + cr ! send AT to modem
gosub qio_xmit !
!
timeout_count = 0% !
while 1 !
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then !
print "-i- Dat-12>";recv_data;"<" if applic_debug% > 0 !
end if !
if comm_error=1 then ! bf_130.1
print "-e- comm error; restarting" !
goto restart !
end if !
goto atz_cleanup if mid$(recv_data,1%,3%) = "OK" !
goto atz_cleanup if mid$(recv_data,1%,10) = "NO CARRIER" !
goto atz_cleanup if mid$(recv_data,1%,13) = "NO CONNECTION" !
if mid$(recv_data,1%,05%) = "ATS10" then !
ats10% = 1% !
print "-e- looping to reset_3plus" !
goto reset_3plus !
end if !
timeout_count = timeout_count + 1% !
goto atz_cleanup if timeout_count > 20% !
next !
!
1600 atz_cleanup: !
sleep 2% !
print "-i- Sending ATZ cleaning up modem port" if applic_debug% > 0 !
xmit_data = "ATZ" + cr ! send AT to modem
gosub qio_xmit !
!
timeout_count = 0% !
while 1 !
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then !
print "-i- Dat-13>";recv_data;"<" if applic_debug% > 0 !
end if !
!
! we're trying to get control so just ignore errors
!
if comm_error=1 then ! bf_130.1
comm_error=0 !
end if !
goto ATH0_cleanup if mid$(recv_data,1%,3%) = "OK" !
if mid$(recv_data,1%,05%) = "ATS10" then !
ats10% = 1% !
goto reset_3plus !
end if !
timeout_count = timeout_count + 1% !
goto ath0_cleanup if timeout_count > 20% !
next !
!
! now go on hook
!
ATH0_cleanup: !
sleep 2% !
print "-i- Sending ATH0 (going on-hook) cleaning up modem port" if applic_debug% > 0
!
xmit_data = "ATH0" + cr ! send ATH0 to modem
gosub qio_xmit !
!
timeout_count = 0% !
while 1 !
gosub qio_recv ! check receiver
if edit$(recv_data,32+4+2) <> "" then
print "-i- Dat-14>";recv_data;"<" if applic_debug% > 0
end if
!
! we're trying tro regain control so ignore errors
!
if comm_error=1 then ! bf_130.1
comm_error=0 !
end if
goto pager_update if mid$(recv_data,1%,3%) = "OK"
if mid$(recv_data,1%,05%) = "ATS10" then
ats10% = 1%
goto reset_3plus
end if
timeout_count = timeout_count + 1%
goto pager_update if timeout_count > 20%
next
!
1700 pager_update:
!
! The following section is used to update the pagerdb_101.dat file.
! The data file is updated with the time and date the pager was paged.
! Also a status flag is set from "N" to "Y" to tell the program the message has been delivered.
!
goto no_data if ats10% = 1% ! abandoning page update
goto no_data if test_page% = -99% ! test message sent
gosub open_file81 ! opening file
notify_staff% = 0%
if file_open81% = 0% then ! file failed to open
print "-e- File pagerdb_101.dat didn't open"
goto fini !
end if
illegal% = 1%
!
while (xmit_ok% > message_count%) ! stay in loop until all messages are updated
message_count% = message_count% + 1% !
when error in !
print "-i- message_count: ";xmit_count$(message_count%) if applic_debug% > 0
!
get #81,key#0 eq xmit_count$(message_count%),regardless !
error_handler% = 0% ! show that GET worked
duplicate_rec_time: ! does another search if
if d81_status = "Y" then ! duplicate rec time.
get #81%, regardless !
goto duplicate_rec_time !
else !
rfa_8x = getrfa(81%) !
get #81%,rfa rfa_8x ! locks record number
end if !
!
!if d81_status = "Y" then
! find #81%, regardless
! rfa_8x = getrfa(81%)
! get #81%,rfa rfa_8x x locks record number
!else
! get #81%,rfa rfa_8x x locks record number
!end if
error_handler% = 0% ! show that FIND/GET worked
1900 !
! If the page passed, the following data is sent to the pagerdb_101.dat file
!
if str$(message_count%) <> illegal_num$(illegal%) !
then !
current_dt$ = wcsm_dt_stamp !
d81_xmit_date = left$(current_dt$,8) !
d81_xmit_time = right$(current_dt$,9) !
d81_status = "Y" !
else !
illegal% = illegal% + 1 !
d81_xmit_date = "PagerErr" !
d81_status = "E" !
!d81_message2 = "This is an invalid" !
!d81_message3 = "pager number" !
end if !
update #81% ! update file
error_handler% = 0% ! show that UPDATE worked
xmit_count$(message_count%) = "" ! clear count
use
error_handler% = err
print "-e- error: "+ str$( error_handler% ) +" at line 1900" if error_handler% <> 11%
end when
!
goto no_data if error_handler% = 11% ! no more data
restore #81%,key# 0% ! go for another record
next
!
no_data:
mat illegal_num$ = nul$ ! added to clear illegal page array
xmit_ok% = 0%
ats10% = 0%
!
close #81% ! close file
!
if pass_count% = 3% then ! if on last pass
!
! run faster (sleep less) from 07:00 through 17:59
!
junk$ = wcsm_dt_stamp ! ccyymmddhhmmss
select mid$(junk$,9,2)
case "07" to "17"
sleep% = 10
case else
sleep% = 60
end select
!
print "-i- Sleeping for "+str$(sleep%)+" seconds: ";left$(junk$,8) +"."+ mid$(junk$,9,6)
sleep sleep%
pass_count% = 1% ! prep for first pass
else
pass_count% = pass_count% + 1% ! prep for next pass
end if
total_message% = 0%
illegal% = 0%
sleeper% = 0%
test_page% = 0%
next
!
!=======================================================================
! Qio_Xmit
!=======================================================================
qio_xmit:
!
dev_buf_xmit = xmit_data ! xfer data to mapped string
char_count = len(xmit_data) ! get length of string for qio
!
! <<< xmit data >>>
!
! SYS$QIO [efn] ,chan ,func ,[iosb] ,[astadr] ,[astprm] ,[p1] ,[p2] ,[p3] ,[p4] ,[p5] ,[p6]
!
8000 rc% = sys$qio( event_flag_xmit by value, ! efn &
dev_ch_xmit by value, ! chan &
funct_bits_xmit by value, ! func &
iosb_xmit::quad_0 by ref, ! iosb &
, ! ast addr &
, ! ast param &
dev_buf_xmit by ref, ! p1=buf addr &
char_count by value, ! p2=buf size &
, ! p3=ignored &
, ! p4=cr spec &
, ! p5=N/A &
) ! p6=N/A
!
select rc% !
case ss$_normal !
case else !
sys_line = 8000% !
goto sys_error !
end select !
!
if applic_debug% > 0 then !
dump_string$ = xmit_data !
gosub hex_dump_of_dump_string !
end if
!
return
!=======================================================================
! Qio_Receive w/Purge
!=======================================================================
qio_recvp:
!
funct_bits_recv = funct_bits_rtp ! read, timed, purge
!
goto qio_recv_common !
!=======================================================================
! Qio_Receive
!=======================================================================
qio_recv:
!
funct_bits_recv = funct_bits_rtnp ! read, timed, no purge
qio_recv_common:
!
dev_buf_Recv = "" ! init buffer for next qio
!
! <<< read next line >>>
!
! SYS$QIO [efn] ,chan ,func ,[iosb] ,[astadr] ,[astprm] ,[p1] ,[p2] ,[p3] ,[p4] ,[p5] ,[p6]
!
9000 rc% = sys$qiow( event_flag_recv by value , ! efn &
dev_ch_recv by value , ! chan &
funct_bits_recv by value , ! func &
iosb_recv::quad_0 by ref , ! iosb &
, ! ast addr &
, ! ast param &
dev_buf_Recv by ref , ! p1=buf addr &
k_buf_siz by value , ! p2=buf size &
2% by value , ! p3=timeout &
loc(TDB_Var::mask_type) by value , ! p4=read term &
, ! p5=prompt addr &
) ! p6=prompt size
!
timeout_flag = 0% ! always reset this
comm_error = 0% ! ditto
!
if (rc% and 7%) = 1 ! if we queued ok...
then
select iosb_recv::rc ! then test the completion status bf_129.1
case ss$_normal ! we must have detected a <cr>
case ss$_timeout ! we timed out (might have data, but no <cr>)
timeout_flag = 1 ! ...raise timeout flag
case ss$_parity ! we have a parity error
print "-e- parity error (recv)"
comm_error = 1 !
case else ! not sure but we'll try to cope with this
print "-e- ??? (recv) iosb-rc:";iosb_recv::rc !
end select !
else !
sys_line = 9000% !
goto sys_error !
end if !
!
timeout_count = 0 if timeout_flag = 0 ! always reset count on no-time-out
!
recv_data = left$(dev_buf_Recv, iosb_recv::xfer_count) ! extract data from buffer
!
if applic_debug% > 0 then
if timeout_flag=1% then !
print " (Recv timeout)" !
else !
print !
end if !
print " "; !
dump_string$ = left$(dev_buf_Recv, iosb_recv::xfer_count) !
gosub hex_dump_of_dump_string !
end if !
!
recv_data = edit$(recv_data, 128%+4%) ! drop trailing, drop controls (optional)
!
return
!=======================================================================
! dump the data string in hex for analysis by humans
!=======================================================================
hex_dump_of_dump_string:
declare string constant hex_string$ = "0123456789abcdef"
declare long dump_i% ,&
dump_j% ,&
dump_k% ,&
dump_hi% ,&
dump_lo% ,&
string hex_data_string$
!
dump_i% = 0% ! init for 'no source data'
dump_j% = len(dump_string$) ! test our data source
hex_data_string$ = "" !
while (dump_i% < dump_j%) ! if not done...
dump_i% = dump_i% + 1% ! advance index
dump_k% = asc(mid$(dump_string$,dump_i%,1%)) ! extract byte
dump_hi%= integer(dump_k% / 16%) ! get high nibble
dump_lo%= mod(dump_k%, 16%) ! get low nibble
hex_data_string$ = hex_data_string$ + &
mid$(hex_string$,dump_hi%+1%,1%)+ &
mid$(hex_string$,dump_lo%+1%,1%)+ &
" " !
next !
print "Hex dump>";hex_data_string$ !
return !
!====================================================================================
! This section retrieves the messages from the pager data base.
! It also builds the packet to send Bell Mobility and generates the checksum.
!====================================================================================
pager_packet:
!
if pass_count% = 1% then !
if mid$(current_dt$,9%,4%) = rename_time$ then
gosub open_file81
when error in
error_handler% = 0%
open pagerdb_fs$ as file #82% &
,access modify &
,allow modify &
,contiguous &
,organization indexed &
,map my_disk81 &
,connect 81
use
error_handler% = err
end when
select error_handler%
case 0%
case else
print "-e- error Opening second channel on pagerdb.dat " + str$(error_handler%)
goto delete_data_skip
end select
!
when error in
error_handler% = 0%
while 1
get #81%,regardless
rfa_8x = getrfa(81%)
get #82%,rfa rfa_8x ! locks record number
delete #82%
next
use
error_handler% = err
end when
select error_handler%
case 0%
case 11%
print "-i- info Deleted yesterday's data"
case else
print "-e- error Deleting yesterday's data " + str$(error_handler%)
end select
close #81%
close #82%
gosub open_file81
d81_last_name = "DOHERTY"
d81_pager = "339885"
rset d81_pager = d81_pager
d81_pager_type = "A"
d81_message1 = "Removed old Pages "
d81_message2 = left$(current_dt$,8)
d81_message3 = " "
d81_message4 = " "
d81_message5 = " "
current_dt$ = wcsm_dt_stamp
d81_recv_date = left$(current_dt$,8)
d81_recv_time = right$(current_dt$,9)
!~~~ d81_status = "N"
!
d81_xmit_date = left$(current_dt$,8)
d81_xmit_time = right$(current_dt$,9)
d81_status = "Y"
d81_pin = "N194943"
put #81%
close #81%
end if
end if
!
delete_data_skip:
!
gosub open_file81
!
current_dt$ = wcsm_dt_stamp
if file_open81% = 0% then ! file failed to open
print "-e- File pagerdb_101.dat didn't open"
goto fini
end if
!
! <<< get packet >>>
!
get_packet:
d81_whole_data = ""
when error in
!print "-i- info: total_message% count = " +str$(total_message%)
goto new_message if total_message% > 0%
select pass_count%
case = 1%
total_message% = 0%
restore #81%,key# 2% ! go for another record
error_handler% = 0%
d81_whole_data = ""
get #81%, key# 2% eq "N", regardless ! now use it to search
rfa_8x = getrfa(81%) !
if d81_pager_type = "P" then !
gosub pcs_page !
goto get_packet !
end if !
rset d81_pager = d81_pager !
select left$(d81_pager,1) ! Only test first character
case "4" ! used for paging SSMR
case "2" ! used for paging Sudbury
case else ! used for paging everyone else
line1$ = "416"+edit$(d81_pager,32+4+2) ! Bell Mobility going to 10 digit dialing
line2$ = d81_message1 + d81_message2 + d81_message3 + d81_message4 + d81_message5
end select
case = 2%
total_message% = 0%
restore #81%,key# 2% ! go for another record
error_handler% = 0%
d81_whole_data = ""
get #81%, key# 2% eq "N", regardless ! now use it to search
rfa_8x = getrfa(81%)
if d81_pager_type = "P" then
gosub pcs_page
goto get_packet
end if
rset d81_pager = d81_pager
!~~~ select left$(d81_pager,2%)
select left$(d81_pager,1%) ! all 705 pagers start with 2
!~~~ case "11"
case "2" ! paging Sudbury 705
line1$ = right$(d81_pager,2%) ! subtracking the number 2
line2$ = d81_message1 + d81_message2 + d81_message3 + d81_message4 + d81_message5
end select
case = 3%
total_message% = 0%
restore #81%,key# 2% ! go for another record
error_handler% = 0%
d81_whole_data = ""
get #81%, key# 2% eq "N", regardless ! now use it to search
rfa_8x = getrfa(81%)
if d81_pager_type = "P" then
gosub pcs_page
goto get_packet
end if
rset d81_pager = d81_pager
rfa_8x = getrfa(81%)
!~~~ select left$(d81_pager,2%)
select left$(d81_pager,1%)
case "4" ! used for paging SSMR
line1$ = right$(d81_pager,2%)
line2$ = d81_message1 + d81_message2 + d81_message3 + d81_message4 + d81_message5
end select
end select
use
error_handler% = err
end when
!
select error_handler%
case 0%
case else
!print "-e- error: "+str$( error_handler% ) +" during get #81, key 2 eq 'N'"
error_handler% = 0%
line1$ = ""
line2$ = ""
total_message% = 0%
message_count% = 0%
close #81%
return
end select
goto build_packet
!
! <<< new message >>>
!
new_message:
line1$ = ""
line2$ = ""
when error in
select pass_count%
case = 1%
error_handler% = 0%
d81_whole_data = ""
get #81%, regardless ! now use it to search
rfa_8x = getrfa(81%)
if d81_pager_type = "P" then
gosub pcs_page
goto new_message
end if
rset d81_pager = d81_pager
rfa_8x = getrfa(81%)
!~~~ select left$(d81_pager,2%)
select left$(d81_pager,1%)
!~~~ case "11"
!~~~ case "22"
case "4" ! used for paging SSMR
case "2" ! used for paging Sudbury
case else ! used for paging everyone else
line1$ = "416"+edit$(d81_pager,32+4+2) ! Bell Mobility going to 10 digit dialing
!~~~ line1$ = edit$(d81_pager,32+4+2)
line2$ = d81_message1 + d81_message2 + d81_message3 + d81_message4 + d81_message5
end select
case = 2%
error_handler% = 0%
d81_whole_data = ""
get #81%,regardless ! now use it to search
rfa_8x = getrfa(81%)
if d81_pager_type = "P" then
gosub pcs_page
goto new_message
end if
rset d81_pager = d81_pager
!~~~ select left$(d81_pager,2%)
select left$(d81_pager,1%)
!~~~ case "11"
case "2" ! paging Sudbury 705
line1$ = right$(d81_pager,2%) ! subtracking the number 2
line2$ = d81_message1 + d81_message2 + d81_message3 + d81_message4 + d81_message5
case else
goto new_message
end select
case = 3%
error_handler% = 0%
d81_whole_data = ""
get #81%,regardless ! now use it to search
rfa_8x = getrfa(81%)
if d81_pager_type = "P" then
gosub pcs_page
goto new_message
end if
rset d81_pager = d81_pager
select left$(d81_pager,1%)
case "4" ! used for paging SSMR
line1$ = right$(d81_pager,2%)
line2$ = d81_message1 + d81_message2 + d81_message3 + d81_message4 + d81_message5
case else
goto new_message
end select
end select
use
error_handler% = err
d81_status = "E" ! when set to "E" end of
end when
!
select error_handler%
case 0%
case else
if applic_debug% > 0 then
print "-i- info: "+str$( error_handler% ) +" during get #81, regardless"
print "-i- info: pass count "+str$( pass_count% )
end if
error_handler% = 0%
line1$ = ""
line2$ = ""
total_message% = message_count%
message_count% = 0%
return
end select
!
! <<< build packet >>>
! modified the next few lines to stop search if page is blank
!
build_packet:
if edit$(d81_pager,32+4+2) = "" then ! if pager field is blank...
print "-i- info: pager field blank" if applic_debug% > 0
when error in
get #81%,rfa rfa_8x ! lock record
delete #81% ! blow it away
use
print "-e- error: Deleting record no pager number " + str$(err)
end when
line1$ = ""
line2$ = ""
total_message% = message_count%
message_count% = 0%
return
end if
!
if line1$ + line2$ = "" then
print "-w- both line1$ + line2$ are blank" if applic_debug% > 0
line1$ = "blank"
line2$ = "blank"
total_message% = message_count%
message_count% = 0%
return
end if
!
if d81_status <> "N" then
print "-i- status <> 'N', no more messages to send " + "d81_status = " + d81_status if applic_debug% > 0
line1$ = ""
line2$ = ""
total_message% = message_count%
message_count% = 0%
return
end if
!
if d81_pager_type = "N" then ! checking the first char
print "-i- pager type = 'N'" if applic_debug% > 0
page_num% = 1% ! is a "1"
select left$(d81_pager,1%)
case "4" ! used for paging SSMR (Sault Saint Marie)
line1$ = right$(d81_pager,2%)
case "2" ! used for paging Sudbury
line1$ = right$(d81_pager,2%)
case else ! used for paging everyone else
line1$ = "416"+edit$(d81_pager,32+4+2) ! Bell Mobility going to 10 digit dialing
!~~ line1$ = edit$(d81_pager,32+4+2)
end select
!~~~ line1$ = d81_pager
line2$ = left$(line2$,12%)
line2$ = edit$(line2$,32+4+2)
end if
!
! <<< wake >>>
!
wake:
!
! 940524, added edit$(4%) to prevent junk paging text
!
packet$ = STX + edit$(line1$,4%) + cr + edit$(Line2$,4%) + cr + ETX
!packet$ = STX + line1$ + cr + Line2$ + cr + ETX
!
message_count% = message_count% + 1%
!
total_message% = message_count%
!
checksum%=0%
for i% = 1% to len( packet$ )
checksum% = checksum% + asc( mid$(packet$,i%,1%) )
next i%
char1% = checksum% / 256% ! 1st char
checksum% = checksum% - char1% * 256%
!
char2% = checksum% / 16% ! 2cd char
checksum% = checksum% - char2% * 16%
!
char3% = checksum% ! 3rd char
!
checksum$ = chr$(48% + char1% ) + chr$(48% + char2% ) + chr$(48% + char3% )
!
packet$(message_count%) = STX + line1$ + cr + Line2$ + cr + ETX + checksum$ + cr
!
! 'd81_recv_date' and 'd81_recv_time' are used to to find a record in the pagerdb_101.dat file.
!
xmit_count$(message_count%) = d81_recv_date + d81_recv_time
if applic_debug% > 0 then
print "-i- line : ";line1$
print "-i- packet: ";packet$
end if
!
goto new_message
!=======================================================================
! Paging a PCS phone is done via smtp mail the phone number is the
! mailing address [email protected]
!=======================================================================
pcs_page:
when error in
error_handler% = 0%
open pagerdb_fs$ as file #82 &
,access modify &
,allow modify &
,contiguous &
,organization indexed &
,map my_disk81 &
,connect 81
use
error_handler% = err
end when
get #82%,rfa rfa_8x ! lock record number
current_dt$ = wcsm_dt_stamp
d81_xmit_date = left$(current_dt$,8)
d81_xmit_time = right$(current_dt$,9)
d81_status = "Y"
rset d81_pager = edit$(d81_pager,32+4+2) !
! when error in
update #82%
! use
! end when
close #82%
select left$(d81_pager,1%)
case "A"
Area_code$ = "416"
case "B"
Area_code$ = "613"
case "C"
Area_code$ = "514"
case "D"
Area_code$ = "519"
case "E"
Area_code$ = "705"
case "F"
Area_code$ = "905"
case "G"
Area_code$ = "819"
case "H"
Area_code$ = "418"
end select
!
mail_filename$ = "CSMIS$ROOT1:[spool]"+Area_code$+mid$(d81_pager,2%,7%)+".spl"
open mail_filename$ for output as file #1%, &
recordsize 132
print #1,d81_message1
print #1,d81_message2
print #1,d81_message3
print #1,d81_message4
print #1,d81_message5
close #1
mail_address$ = "smtp%" + '"""' + Area_code$+mid$(d81_pager,2%,7%)+"@txt.bellmobility.ca" + '"""'
junk% = wcsm_submit_to_batch( &
"CSMIS$BATCH" ,! batch queue &
"CSMIS$COM:mail_queue_server.com" ,! batch program &
"mail_queue_server.log" ,! batch logfile NSR 96.0813 &
"" ,! user &
mail_filename$ ,! p1$ print file &
mail_address$ ,! p2$ print queue &
"" ,! p3$ print option &
"" ,! p4$ &
"" ,! p5$ &
"" ,! p6$ &
"" ,! p7$ &
"" ! p8$ &
)
!~~~ junk% = lib$delete_file(mail_filename$ + ";*")
return
20000 !=======================================================================
! Open section
!=======================================================================
open_file81: !
when error in !
!~~~ %include "[.fil]PAGERDB_101_OPEN81.opn" x open pager database
open ( default_node$ + pagerdb_fs$ ) as #81 &
,access modify &
,allow modify &
,contiguous &
,organization indexed &
,map my_disk81 &
,primary key (d81_recv_date,d81_recv_time) duplicates descending &
,alternate key d81_pager duplicates &
,alternate key d81_status duplicates changes &
,alternate key d81_last_name duplicates changes
!
file_open81% = 1% ! show open
use !
print "-e- error: "+ str$(err) +" opening pager data file" !
file_open81% = 0% ! show not open
end when !
!
return !
!=======================================================================
! BASIC Error Routine
!=======================================================================
31000 Error_Trap: !
print
print "-e- BASIC Error:"
print "-e- Error = "+ str$( Err )
print "-e- Line = "+ str$( Erl )
PRINT "-e- Text = "+ ERT$( Err )
print
!
resume Fini ! fix stack
!
! System Error Routine (note: 'rc%' must be setup before this call)
!
sys_error: !
print !
print "========================================" !
print "-e- System Error:"
print "-e- SysError = "+ str$( rc% )
print "-e- Line = "+ str$( sys_line )
print "========================================" !
resume fini !
!
31100 Fini: !
end !
!###################################################################################################################
!
! <<< external functions >>>
!
31110 %include "[.fun]wcsm_trnlnm.fun" !
!
31120 %include "[.fun]WCSM_submit_to_batch.fun" !
!
31130 %include "[.fun]Wcsm_DT_Stamp.fun"
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.