RGUTFTP ;CAIRO/DKM - FTP support (currently defined only for VMS);12-Oct-1998 15:49;DKM
;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
;=================================================================
; Should not be invoked directly, but through a call to FTP^RGUTOS
;=================================================================
VMS(RGIP,RGMODE,RGSRCF,RGTGTF,RGTGTD,RGUSER,RGPASS) ;
N RGZ,RGZ1,RGFIL,RGSRCD
D HOME^%ZIS
I IO=IO(0) D
.U IO
.I "@"[RGIP D
..S:RGIP="@" RGIP=$P($ZIO," ",2)
..I RGIP="" D Q:RGIP=""
...R "Enter target IP address: ",RGIP:DTIME,!
...S:RGIP[U RGIP=""
.I $G(RGSRCF)="" D Q:RGSRCF=""
..R "Enter source file name : ",RGSRCF:DTIME,!
..S:RGSRCF[U RGSRCF=""
.I $G(RGUSER)="" D Q:RGUSER=""
..R "Enter target user name : ",RGUSER:DTIME,!
..S:RGUSER[U RGUSER=""
.I $G(RGPASS)="" D Q:RGPASS=""
..R "Enter target password : ",RGPASS:DTIME,!
..S:RGPASS[U RGPASS=""
D:$G(RGIP)="" RAISE^RGUTOS("No IP address")
D:$G(RGSRCF)="" RAISE^RGUTOS("No source file")
D:$G(RGUSER)="" RAISE^RGUTOS("No target user")
D:$G(RGPASS)="" RAISE^RGUTOS("No target password")
S RGZ=$S(RGMODE["G":"get ",RGMODE["P":"put ",1:""),RGSRCF=$TR(RGSRCF,"\","/"),RGSRCD=""
S:RGSRCF["/" RGZ1=$L(RGSRCF,"/")-1,RGSRCD=$P(RGSRCF,"/",1,RGZ1)_"/",RGSRCF=$P(RGSRCF,"/",RGZ1+1)
D:RGZ="" RAISE^RGUTOS("Mode not specified")
W:IO=IO(0) !,"Beginning file transfer...",!!
I $$NEWERR^%ZTER N $ET S $ET=""
S @$$TRAP^RGUTOS("ERROR^RGUTFTP"),RGFIL="FTP"_$J_".TMP",RGMODE=$$UP^XLFSTR($G(RGMODE))
D OPEN^RGUTOS(.RGFIL,"W")
U RGFIL
W:RGSRCD'="" $S(RGMODE["G":"cd ",1:"lcd ")_RGSRCD,!
W:$G(RGTGTD)'="" $S(RGMODE["G":"lcd ",1:"cd ")_RGTGTD,!
W $S($G(RGTGTF)="":"m"_RGZ_RGSRCF,1:RGZ_RGSRCF_" "_RGTGTF),!
W:RGMODE["D"&(RGMODE["G") "mdelete "_RGSRCF,!
W "quit",!
D CLOSE^RGUTOS(.RGFIL)
U IO
S RGZ=$&ZLIB.%SPAWN("FTP "_RGIP_" /USER="""_RGUSER_"""/PASS="""_RGPASS_"""/INPUT="_RGFIL)
D DELETE^RGUTOS(RGFIL)
I RGMODE["P",RGMODE["D" D DELETE^RGUTOS(RGSRCF)
Q
ERROR I IO=IO(0) D
.U IO
.W $$EC^%ZOSV,!!
E D ^ZTER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGUTFTP 2068 printed Sep 23, 2025@20:13:36 Page 2
RGUTFTP ;CAIRO/DKM - FTP support (currently defined only for VMS);12-Oct-1998 15:49;DKM
+1 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
+2 ;=================================================================
+3 ; Should not be invoked directly, but through a call to FTP^RGUTOS
+4 ;=================================================================
VMS(RGIP,RGMODE,RGSRCF,RGTGTF,RGTGTD,RGUSER,RGPASS) ;
+1 NEW RGZ,RGZ1,RGFIL,RGSRCD
+2 DO HOME^%ZIS
+3 IF IO=IO(0)
Begin DoDot:1
+4 USE IO
+5 IF "@"[RGIP
Begin DoDot:2
+6 if RGIP="@"
SET RGIP=$PIECE($ZIO," ",2)
+7 IF RGIP=""
Begin DoDot:3
+8 READ "Enter target IP address: ",RGIP:DTIME,!
+9 if RGIP[U
SET RGIP=""
End DoDot:3
if RGIP=""
QUIT
End DoDot:2
+10 IF $GET(RGSRCF)=""
Begin DoDot:2
+11 READ "Enter source file name : ",RGSRCF:DTIME,!
+12 if RGSRCF[U
SET RGSRCF=""
End DoDot:2
if RGSRCF=""
QUIT
+13 IF $GET(RGUSER)=""
Begin DoDot:2
+14 READ "Enter target user name : ",RGUSER:DTIME,!
+15 if RGUSER[U
SET RGUSER=""
End DoDot:2
if RGUSER=""
QUIT
+16 IF $GET(RGPASS)=""
Begin DoDot:2
+17 READ "Enter target password : ",RGPASS:DTIME,!
+18 if RGPASS[U
SET RGPASS=""
End DoDot:2
if RGPASS=""
QUIT
End DoDot:1
+19 if $GET(RGIP)=""
DO RAISE^RGUTOS("No IP address")
+20 if $GET(RGSRCF)=""
DO RAISE^RGUTOS("No source file")
+21 if $GET(RGUSER)=""
DO RAISE^RGUTOS("No target user")
+22 if $GET(RGPASS)=""
DO RAISE^RGUTOS("No target password")
+23 SET RGZ=$SELECT(RGMODE["G":"get ",RGMODE["P":"put ",1:"")
SET RGSRCF=$TRANSLATE(RGSRCF,"\","/")
SET RGSRCD=""
+24 if RGSRCF["/"
SET RGZ1=$LENGTH(RGSRCF,"/")-1
SET RGSRCD=$PIECE(RGSRCF,"/",1,RGZ1)_"/"
SET RGSRCF=$PIECE(RGSRCF,"/",RGZ1+1)
+25 if RGZ=""
DO RAISE^RGUTOS("Mode not specified")
+26 if IO=IO(0)
WRITE !,"Beginning file transfer...",!!
+27 IF $$NEWERR^%ZTER
NEW $ETRAP
SET $ETRAP=""
+28 SET @$$TRAP^RGUTOS("ERROR^RGUTFTP")
SET RGFIL="FTP"_$JOB_".TMP"
SET RGMODE=$$UP^XLFSTR($GET(RGMODE))
+29 DO OPEN^RGUTOS(.RGFIL,"W")
+30 USE RGFIL
+31 if RGSRCD'=""
WRITE $SELECT(RGMODE["G":"cd ",1:"lcd ")_RGSRCD,!
+32 if $GET(RGTGTD)'=""
WRITE $SELECT(RGMODE["G":"lcd ",1:"cd ")_RGTGTD,!
+33 WRITE $SELECT($GET(RGTGTF)="":"m"_RGZ_RGSRCF,1:RGZ_RGSRCF_" "_RGTGTF),!
+34 if RGMODE["D"&(RGMODE["G")
WRITE "mdelete "_RGSRCF,!
+35 WRITE "quit",!
+36 DO CLOSE^RGUTOS(.RGFIL)
+37 USE IO
+38 SET RGZ=$&ZLIB.%SPAWN("FTP "_RGIP_" /USER="""_RGUSER_"""/PASS="""_RGPASS_"""/INPUT="_RGFIL)
+39 DO DELETE^RGUTOS(RGFIL)
+40 IF RGMODE["P"
IF RGMODE["D"
DO DELETE^RGUTOS(RGSRCF)
+41 QUIT
ERROR IF IO=IO(0)
Begin DoDot:1
+1 USE IO
+2 WRITE $$EC^%ZOSV,!!
End DoDot:1
+3 IF '$TEST
DO ^ZTER
+4 QUIT
