|
Jerry, Nice clean code... If I'd a known it was THAT easy, I'd a just thrown somethin together myself... (NOT!) Any special compile options? I thought the ICF needed some stuff about *IRS, or whatever... | -----Original Message----- | From: midrange-l-admin@midrange.com | [mailto:midrange-l-admin@midrange.com]On Behalf Of Jerry Sprout | Sent: Thursday, November 29, 2001 8:03 PM | To: midrange-l@midrange.com | Subject: Re: Cmd to read from a comm LINE - pt to pt BSC | | | Since your connection is pt-to-pt, you can remove the autodial stuff. | ----- Original Message ----- | From: "jt" <jt@ee.net> | To: <midrange-l@midrange.com> | Sent: Thursday, November 29, 2001 4:05 PM | Subject: RE: Cmd to read from a comm LINE - pt to pt BSC | | | > 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') | > -- | > | > _______________________________________________ | > This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing | list | > To post a message email: MIDRANGE-L@midrange.com | > To subscribe, unsubscribe, or change list options, | > visit: http://lists.midrange.com/cgi-bin/listinfo/midrange-l | > or email: MIDRANGE-L-request@midrange.com | > Before posting, please take a moment to review the archives | > at http://archive.midrange.com/midrange-l. | | | _________________________________________________________ | Do You Yahoo!? | Get your free @yahoo.com address at http://mail.yahoo.com | | _______________________________________________ | This is the Midrange Systems Technical Discussion (MIDRANGE-L) | mailing list | To post a message email: MIDRANGE-L@midrange.com | To subscribe, unsubscribe, or change list options, | visit: http://lists.midrange.com/cgi-bin/listinfo/midrange-l | or email: MIDRANGE-L-request@midrange.com | Before posting, please take a moment to review the archives | at http://archive.midrange.com/midrange-l. |
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
midrange.com
