|
This is a multi-part message in MIME format.
--
Joe,
Jerry's tied up, so he asked me to look over the attached code he started.
I'm backed up myself, so will try to take a look this evening... Needless
to say this is "As is" software. (I didn't know if it's considered okay to
send code attachments, but will try... The RPGLE is a little long to paste
into an e-mail...)
BscSendR.txt - RPGLE
BscSendD.txt - DDS (BSCF)
BscSendC.txt - CMD
jt
--
FBscSend CF E Workstn infds(BscFbk) devid(BscDev)
F maxdev(*file) usropn
FDBFfile IF A F 512 Disk usropn
D ExecuteCmd PR extpgm('QCMDEXC')
D Command 250 const
D CommandLen 15P 5 const
D BscFbk DS
D Device 273 282
D RcvLen 372 375B 0
D Acquired 279 279
D Invited 280 280
D InputData 281 281
D MajorMinor 401 404
D MajorCode 2 overlay(MajorMinor)
D MinorCode 2 overlay(MajorMinor:3)
D BscDev S 10A
D Action S 1A
D FileName S 20A
D Member S 10A
D CnnNumber S 16A
D Status S 1A
IDBFfile NS
I 1 512 DBFdata
C *entry Plist
C Parm Action
C Parm FileName
C Parm Member
C Parm CnnNumber
C Parm Status
* Process Action
C Select
* Close
C When Action = 'C'
C Exsr CloseBsc
* Send
C When Action = 'S'
C Exsr SendFile
* Receive
C When Action = 'R'
C Exsr ReceiveFile
C Endsl
C Eval *inrt = *on
**********************************************************************
C SendFile Begsr
**********************************************************************
* Open data base file
C Exsr OpenDBF
* request permission to write
C Eval Status = *on
C Eval SndDta = *blanks
C Eval SndLen = 0
C Eval *in32 = *on
C Write Send
C Eval *in32 = *off
* start writing file
C Read DBFfile
C Dow not %eof(DBFfile)
C Eval SndDta = DBFdata
C Eval SndLen = %len(%trimr(SndDta))
C Write Send
C Read DBFfile
C Enddo
* send EOT to allow other side to send
C Eval SndDta = *blanks
C Eval SndLen = 0
C Eval *in31 = *on
C Write Send
C Eval *in31 = *off
C Eval Status = *off
* close the file when done
C Close DBFfile
C Endsr
**********************************************************************
C ReceiveFile Begsr
**********************************************************************
* Open data base file
C Exsr OpenDBF
* start receiving data
C Read Receive
C Dow not *in90 and MajorMinor <> '0302'
C Eval DBFdata = RcvDta
C Except DBFout
C Read Receive
C Enddo
* close the file when done
C Close DBFfile
C Endsr
**********************************************************************
C OpenDBF Begsr
**********************************************************************
* if BSC not open, make the connection
C If not %open(BscSend)
C Exsr Connect
C Endif
* overide the data base file
C Callp ExecuteCmd('ovrdbf dbffile tofile ('
C + %trim(%subst(FileName:1:10)) + '/'
C + %trim(%subst(FileName:11:10))
C + ') mbr(' + %trim(Member) + ')':250)
C Open DBFfile
C Endsr
**********************************************************************
C Connect Begsr
**********************************************************************
* open the bisync line
C Callp ExecuteCmd('vrycfg ncb *lin *on '
C + 'vrywait(15)':250)
C Open BscSend
* acquire the device
C Eval BscDev = 'BSCSEND'
C BscDev Acq(e) BscSend
* send the phone number to the modem (Using turn around)
C Eval SndDta = 'D' + %trim(CnnNumber) + '@'
C Eval SndLen = %len(%trimr(SndDta))
C Eval *in31 = *on
C Write Send
C Eval *in31 = *off
* read call progress until done. When 'A' is returned,
* the connection is good. D=Dialing, R=Ringing
* Anything else is bad. If turn around then read again
C Read Receive
C Dow MajorMinor <> '0302'
C and (%subst(RcvDta:1:1) = 'D'
C or %subst(RcvDta:1:1) = 'R'
C or *in90)
C Read Receive
C Enddo
* receive turn around
C Dow not *in90
C Read Receive
C Enddo
* if the 'A' not received, close and exit
C Eval Status = %subst(RcvDta:1:1)
C If Status <> 'A'
C Exsr CloseBsc
C Endif
C Endsr
**********************************************************************
C CloseBsc Begsr
**********************************************************************
C If %open(BscSend)
C Close BscSend
C Callp ExecuteCmd('vrycfg ncb *lin *off':250)
C Endif
C Eval *inlr = *on
C Return
C Endsr
ODBFfile EADD DBFout
O DBFdata 512
--
A R SEND
A 31 ALWWRT
A 32 RQSWRT
A VARLEN(&SNDLEN)
A SNDDTA 1024A
A SNDLEN 5 0P
A R RECEIVE
A RCVTRNRND(90)
A RCVDTA 1024A
--
CMD PROMPT('Send/Receive File using BSC')
PARM KWD(ACTION) TYPE(*CHAR) LEN(8) RSTD(*YES) +
DFT(*CLOSE) SPCVAL((*CLOSE C) (*SEND S) +
(*RECEIVE R)) PROMPT('BSC action')
PARM KWD(FILE) TYPE(FILENAM) PROMPT('File')
FILENAM: QUAL TYPE(*NAME) LEN(10) DFT(*NONE)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL +
*LIBL) (*FILLST *FILLST)) PROMPT('Library')
PARM KWD(MBR) TYPE(*NAME) LEN(10) DFT(*FIRST) +
SPCVAL((*FIRST *FIRST)) PROMPT('Member')
PARM KWD(CNNNBR) TYPE(*CHAR) LEN(16) DFT(*NONE) +
PROMPT('Connection Number')
PARM KWD(STATUS) TYPE(*CHAR) LEN(1) PROMPT('BSC +
Status')
--
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.