| [613] | 1 | XTKERM1 ;SF/RWF - Kermit Send a file. ;8/30/94 10:52
|
|---|
| 2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
|---|
| 3 | S D BSPAR^XTKERM4,STO S XTKS("PT")="S",F1=0
|
|---|
| 4 | I '$D(ZTQUEUED) U IO(0) D
|
|---|
| 5 | . I IO=IO(0) W !,"Now start a KERMIT receive on your system.",!,"Starting [REMOTE] KERMIT send.",! H 5
|
|---|
| 6 | . E W !,"Starting a [LOCAL] KERMIT send.",!
|
|---|
| 7 | . Q
|
|---|
| 8 | U IO S XTKET=$H
|
|---|
| 9 | F XTKERR=0:0 D @("S"_XTKS("PT")) Q:XTKERR!(XTKS("PT")="")
|
|---|
| 10 | S %=$H,XTKET=%-XTKET*86400+$P(%,",",2)-$P(XTKET,",",2)
|
|---|
| 11 | I '$D(ZTQUEUED) U IO(0) D
|
|---|
| 12 | . W !,"Done with ",$S(IO=IO(0):"[REMOTE]",1:"[LOCAL]")," send, File transfer ",$S('XTKERR:"was successful.",1:"failed. ("_XTKERR_")")
|
|---|
| 13 | . W:'XTKERR !,?10,"Bytes: ",XTKS("CCNT")," Sec: ",XTKET," cps: ",$J(XTKS("CCNT")/XTKET,3,1)
|
|---|
| 14 | Q
|
|---|
| 15 | SS S XTKS("PN")=0 D SEND,RTO S XTKSDAT=XTKRDAT D SPAR^XTKERM4 S XTKS("PT")="F" Q
|
|---|
| 16 | SF S XTKSDAT=XTKFILE D SEND,RACK:(XTKR("PN")'=XTKS("PN")) S XTKS("PT")="D" Q
|
|---|
| 17 | SD D GDATA I 'F1 D SZ Q
|
|---|
| 18 | D SDATA Q
|
|---|
| 19 | SZ S XTKSDAT="",XTKS("PT")="Z" D SEND S XTKS("PT")="B" Q:XTKERR
|
|---|
| 20 | Q ;MARK FILE AS SENT.
|
|---|
| 21 | SB S XTKSDAT="",XTKS("PT")="B" D SEND S XTKS("PT")="" Q
|
|---|
| 22 | SEND D:XTKS("PT")'="S" BUMP D SPACK ;Fall into RACK
|
|---|
| 23 | RACK S XTKS("TRY")=XTKS("TRY")+1 I XTKS("TRY")>XTKS("MAXTRY") G ABORT
|
|---|
| 24 | D RPACK^XTKERM3 I "EY"'[XTKR("PT")!XTKERR D SPACK G RACK
|
|---|
| 25 | I XTKR("PN")'=XTKS("PN") D SPACK G RACK
|
|---|
| 26 | S:"E"=XTKR("PT") XTKERR="8 Error packet" Q
|
|---|
| 27 | Q
|
|---|
| 28 | SEQ S X=(XTKS("PN")'=XTKS("PN")) Q:'X D NAK S X=1 Q
|
|---|
| 29 | Q
|
|---|
| 30 | ABORT S:'XTKERR XTKERR="7 Aborting send operation" Q
|
|---|
| 31 | BUMP S XTKS("TRY")=0,XTKS("PN")=XTKS("PN")+1#64 Q
|
|---|
| 32 | PREV S XTKS("PN")=$S(XTKS("PN"):XTKS("PN")-1,1:63) Q
|
|---|
| 33 | NAK S XTKS("PT")="N",XTKSDAT="" D SPACK Q
|
|---|
| 34 | ACK S XTKS("PT")="Y",XTKSDAT="" D SPACK S XTKS("TRY")=0 Q
|
|---|
| 35 | SPACK G SPACK^XTKERM3
|
|---|
| 36 | RPACK G RPACK^XTKERM3
|
|---|
| 37 | SDATA ;Send the data from the file.
|
|---|
| 38 | S XTKSDAT="",XTKS("SA")=X G IDATA:'XTKMODE
|
|---|
| 39 | I X'[XTKS("QA")&(X?1.ANP) S XTKSDAT=$E(X,1,XTKS("SIZ")),I=XTKS("SIZ")+1 G SD2
|
|---|
| 40 | F I=1:1:$L(XTKS("SA")) S %1=$E(XTKS("SA"),I),%2=(%1[XTKS("QA")!(%1?1C)) Q:$L(XTKSDAT)+1+%2>XTKS("SIZ") D
|
|---|
| 41 | . S XTKSDAT=XTKSDAT_$S('%2:%1,%1[XTKS("QA"):%1_%1,1:XTKS("QA")_$C($A(%1)+64)),%2=0
|
|---|
| 42 | . Q
|
|---|
| 43 | S:'%2&(I=$L(XTKS("SA"))) I=I+1
|
|---|
| 44 | SD2 S XTKS("SA")=$E(XTKS("SA"),I,999) D SEND Q:XTKERR S X=XTKS("SA") G SDATA:X]""
|
|---|
| 45 | Q
|
|---|
| 46 | IDATA F F3=0:0 S X=$E(XTKS("SA"),1,XTKS("SIZ")),XTKS("SA")=$E(XTKS("SA"),XTKS("SIZ")+1,999) D SEND Q:XTKS("SA")=""
|
|---|
| 47 | Q
|
|---|
| 48 | Q
|
|---|
| 49 | GDATA ;Get data from global
|
|---|
| 50 | S @("F1=$O("_XTKDIC_"F1))") Q:F1'>0 S X=@(XTKDIC_"F1,0)"),XTKS("CCNT")=XTKS("CCNT")+$L(X) S:XTKMODE=2 X=X_$C(13) S:XTKMODE=3 X=X_$C(13,10) Q
|
|---|
| 51 | Q
|
|---|
| 52 | STO ;Save timeout data for startup
|
|---|
| 53 | S XTKR("TOS")=XTKR("TO"),XTKR("TO")=5,XTKS("MAXTRY")=30
|
|---|
| 54 | Q
|
|---|
| 55 | RTO ;Restore saved timeout
|
|---|
| 56 | S XTKR("TO")=XTKR("TOS"),XTKS("MAXTRY")=10 K XTKR("TOS")
|
|---|
| 57 | Q
|
|---|
