- 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 Feb 19, 2025@00:03:45 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