1 | XTKERM2 ;SF/RWF - Kermit Receive a file. ;11/8/93 11:50 ;
|
---|
2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
---|
3 | R I '$D(ZTQUEUED) U IO(0) D
|
---|
4 | . I IO=IO(0) W !,"Now start a KERMIT send from your system.",!,"Starting [REMOTE] KERMIT receive.",!
|
---|
5 | . E W !,"Starting a [LOCAL] KERMIT receive.",!
|
---|
6 | . Q
|
---|
7 | U IO S XTKET=$H
|
---|
8 | F XTKERR=0:0 D GET,@("R"_XTKR("PT")):'XTKERR Q:XTKERR!(XTKR("PT")="B")
|
---|
9 | D:XTKERR RB
|
---|
10 | S %=$H,XTKET=$H-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]")," receive, File transfer ",$S('XTKERR:"was successful. ("_XTKR("CCNT")_" bytes)",1:"failed. ("_XTKERR_")")
|
---|
13 | W:'XTKERR !,?10,"Bytes: ",XTKR("CCNT")," Sec: ",XTKET," cps: ",$J(XTKR("CCNT")/XTKET,3,1)
|
---|
14 | Q
|
---|
15 | RS S XTKS("PN")=XTKR("PN") D RPAR^XTKERM4,BSPAR^XTKERM4 S XTKS("PT")="Y" D SPACK,BUMP Q
|
---|
16 | RF D SEQ Q:X S X=XTKRDAT D FILE,ACK,BUMP Q
|
---|
17 | RD D SEQ Q:X D STORE,ACK,BUMP Q
|
---|
18 | RZ D SEQ G:X ABORT S XTKRDAT="" D STORE:XTKR("SA")]"",ACK,BUMP,CLOSE Q
|
---|
19 | RB D SEQ Q:X D ACK Q
|
---|
20 | RY ;
|
---|
21 | RN ;
|
---|
22 | RE G ABORT
|
---|
23 | SEQ S X=(XTKR("PN")'=XTKS("PN")) Q:'X D NAK S X=1 Q
|
---|
24 | Q
|
---|
25 | GET S XTKR("TRY")=XTKR("TRY")+1 I XTKR("TRY")>XTKR("MAXTRY") G ABORT
|
---|
26 | D RPACK^XTKERM3
|
---|
27 | I XTKERR D NAK G GET
|
---|
28 | I "SFEDNZYB"'[XTKR("PT") S XTKERR="6 Unknown packet type" Q
|
---|
29 | Q
|
---|
30 | ABORT S:'XTKERR XTKERR="5 Aborting receive operation" Q
|
---|
31 | BUMP S XTKR("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 XTKR("TRY")=0 Q
|
---|
35 | SPACK G SPACK^XTKERM3
|
---|
36 | RPACK G RPACK^XTKERM3
|
---|
37 | FILE ;See if need to change file name.
|
---|
38 | I XTKDIC["DIZ(8980,",XTKR("RFN")="y" S XTKFILE(0)=XTKFILE,XTKFILE=X
|
---|
39 | ;Other wise toss file name we don't need it.
|
---|
40 | ;I XTKDIC'["^DIZ(8980," S X="KERMIT File Name: "_X D PDATA ;Old, just store the file name.
|
---|
41 | Q
|
---|
42 | STORE ;Store the data (XTKRDAT) in file.
|
---|
43 | I 'XTKMODE S X=XTKRDAT D PDATA Q
|
---|
44 | F I=0:0 S I=$F(XTKRDAT,XTKR("QA"),I) Q:I<1 S X=$E(XTKRDAT,1,I-2),Y=$E(XTKRDAT,I) D TEXT:XTKMODE=2,REPLACE:XTKMODE=1
|
---|
45 | S X="" S:$L(XTKRDAT)+$L(XTKR("SA"))'>245 XTKR("SA")=XTKR("SA")_XTKRDAT,XTKRDAT="" S:$L(XTKRDAT)+$L(XTKR("SA"))>245 X=XTKR("SA"),XTKR("SA")=XTKRDAT,XTKRDAT="" S:XTKR("PT")="Z" X=XTKR("SA")
|
---|
46 | D:X]"" PDATA Q
|
---|
47 | ;Y=M end of line, L form feed, J line feed, other make into control
|
---|
48 | TEXT I "L"[Y D TX2 S X="|TOP|" D PDATA Q
|
---|
49 | I "M"'[Y S XTKRDAT=X_$S(Y=XTKR("QA"):Y,"J"[Y:"",1:$C($A(Y)-64))_$E(XTKRDAT,I+1,999),I=I-(Y'=XTKR("QA")) Q
|
---|
50 | TX2 I $L(XTKR("SA")) S X1=XTKR("SA"),X2=X,Z=245-$L(X1),X=X1_$E(X2,1,Z),XTKR("SA")=$E(X2,Z+1,999)
|
---|
51 | D PDATA S X="" G TX2:$L(XTKR("SA")) S XTKRDAT=$E(XTKRDAT,I+1,999),I=0 Q
|
---|
52 | PDATA ;Put data in global
|
---|
53 | S DWLC=DWLC+1,@(XTKDIC_"DWLC,0)")=X,XTKR("CCNT")=XTKR("CCNT")+$L(X) Q
|
---|
54 | Q
|
---|
55 | REPLACE S XTKRDAT=X_$S(Y=XTKR("QA"):Y,1:$C($A(Y)-64))_$E(XTKRDAT,I+1,999),I=$L(X)+(Y=XTKR("QA")) Q
|
---|
56 | Q
|
---|
57 | CLOSE ;Close and update the filename if file 8980
|
---|
58 | I XTKDIC["DIZ(8980,",XTKR("RFN")="y" S $P(^DIZ(8980,XTKDA,0),"^",1)=XTKFILE,^DIZ(8980,"B",$E(XTKFILE,1,30),XTKDA)="" K ^DIZ(8980,"B",XTKFILE(0),XTKDA)
|
---|
59 | S @("X=$S($D("_XTKDIC_"0)):^(0),1:"""")"),^(0)=$P(X_"^^",U,1,2)_U_DWLC_U_DWLC
|
---|
60 | Q
|
---|