OS/2 Shareware BBS: 8 Other/08-Other.zip/HPTDEM.ZIP/HRECV.RXC

Text File | 1992-03-17 | 9KB | 217 lines

/* HRECV.CMD    (c) Copyright HeteroGenius Systems Ltd 1991     */
CALL RXFUNCADD "DISPLAY","HRXDLL","HRXDSPL"
CALL RXFUNCADD "TBDISPL","HRXDLL","HRXDSPT"
CALL RXFUNCADD "HRXVGET","HRXDLL","HRXVPRF"
CALL RXFUNCADD "HRXVPUT","HRXDLL","HRXVPRF"
CALL RXFUNCADD "HRXPAUSE","HRXDLL","HRXPAUSE"
CALL RXFUNCADD "HAPLIST","HDPDDM","HDPFLRQ"
CALL RXFUNCADD "HAPRECV","HDPDDM","HDPFTSR"
/* Get the profile variables */
profvars = "hostlu recvdsn lfname fclass repopt zscfl"
CALL HRXVGET "HPTSO",profvars
/* Get the LU name override */
ARG lu .
IF lu <> '' THEN hostlu = lu
DO m=1 BY 0
   /* Prompt user for LU name and file mask */
   msg = ''
   cursor = "RECVDSN"
   DO UNTIL msg = ''
      CALL DISPLAY "HBPRCVP1", cursor, msg
      IF result = "END" THEN SIGNAL finish
      IF result <> "ENTER" THEN EXIT 12
      msg = ''
      IF hostlu = ''  THEN DO
         msg = 'ENTER HOST NAME'
         cursor = "HOSTLU"; ITERATE; END
      IF recvdsn = '' THEN DO
         msg = 'ENTER HOST DATASET NAME'
         cursor = "RECVDSN"; ITERATE; END
   END /* DO */
   flrqname = recvdsn;
   DO w=1 BY 0
      /* Obtain a list of files or members from the host system */
      tempfile = aloctemp()
      CALL HAPLIST hostlu,tempfile,flrqname
      IF result <> 0 THEN DO
         ADDRESS CMD '@DEL' tempfile; CALL HRXPAUSE "***";ITERATE m;END
      /* Read the list into a table and close the file */
      DO k = 1 WHILE LINES(tempfile) > 0
         PARSE VALUE LINEIN(tempfile) WITH hdsn.k '00'X hddata.k
      END
      CALL LINEOUT tempfile
      ADDRESS CMD '@DEL' tempfile
      count = k - 1
      /* Display the table of file or member names */
      PARSE VAR flrqname flrqdsn '(' flrqmem ')'
      IF flrqmem = '' THEN tbpanel = "HBPRCVT1"
      ELSE tbpanel = "HBPRCVT2"
      tbselect. = ''; caption = flrqname 'at' hostlu
      next = 1; msg = ''; pause = 'N'
      DO FOREVER
         IF pause = 'Y' THEN DO; CALL HRXPAUSE "***"; pause = 'N'; END
         CALL TBDISPL tbpanel,count,next,,msg,caption; msg = ''
         IF result = "END" THEN LEAVE w
         IF result <> "ENTER" THEN EXIT 12
         prompt = 'Y'
         firstsel = 0
         /* Search the array for selected files or members */
         DO k = 1 TO count
            PARSE VALUE hddata.k WITH dsorg .
            pds = ( dsorg='PO' | dsorg='PF-SRC' )
            IF tbselect.k = 'S' THEN DO
               next = k
               IF firstsel = 0 THEN firstsel = k
               SELECT
               WHEN dsorg = 'PCDIR' THEN flrqname = hdsn.k'\*.*'
               WHEN dsorg = 'PO' | LEFT(dsorg,2) = 'PF' | dsorg = 'LF'
                  THEN flrqname = hdsn.k'(*)'
               OTHERWISE
                  msg = "'S' IS NOT VALID FOR TYPE" dsorg; LEAVE k
               END /* SELECT */
               ITERATE w
            END
            IF tbselect.k = 'R' THEN DO
               next = k
               IF firstsel = 0 THEN firstsel = k
               IF flrqmem = '' THEN rfname = hdsn.k
               ELSE rfname = flrqdsn'('hdsn.k')'
               IF pds & prompt = 'N' THEN
                  IF POS('&MEMBER',TRANSLATE(lfname))=0 THEN
                     prompt = 'Y'
               IF prompt = 'Y' & pause='Y' THEN DO
                  CALL HRXPAUSE "***"; pause = 'N'; END
               cursor = "LFNAME"
               /* Prompt the user for the local file name */
               IF prompt = 'Y' THEN DO UNTIL msg = ''
                  CALL DISPLAY "HBPRCVP2",cursor,msg; msg = ''
                  IF result = "END" THEN DO
                     tbselect.k = ''; LEAVE k; END
                  IF result <> "ENTER" THEN EXIT 12
                  IF prompt <> 'Y' & prompt <> 'N' THEN DO
                     msg = 'INVALID PROMPT VALUE. SPECIFY Y OR N'
                     cursor = "PROMPT"; ITERATE; END
                  IF lfname = '' THEN DO
                     msg = 'ENTER FILE NAME'
                     cursor = "LFNAME"; ITERATE; END
                  IF pds THEN IF POS('&MEMBER',TRANSLATE(lfname))=0
                  THEN DO
                     msg = 'FILE NAME MUST CONTAIN &MEMBER'
                     cursor = "LFNAME"; ITERATE; END
                  lfile = fnbuild(lfname,rfname)
                  IF VERIFY(lfile,'<>|&"','M') <> 0 THEN DO
                     msg = 'INVALID CHARACTERS IN FILE NAME'
                     cursor = "LFNAME"; ITERATE; END
                  x = TRANSLATE(LEFT(fclass,1))
                  SELECT
                  WHEN x = 'T' THEN fclass = 'TEXT'
                  WHEN x = 'B' THEN fclass = 'BINARY'
                  OTHERWISE
                     msg = 'INVALID FILE CLASS'
                     cursor = "FCLASS"; ITERATE
                  END
                  x = TRANSLATE(LEFT(repopt,1))
                  SELECT
                  WHEN x = 'R' THEN repopt = 'REPL'
                  WHEN x = 'N' THEN repopt = 'NOREPL'
                  WHEN x = 'L' THEN repopt = 'LATER'
                  OTHERWISE
                     msg = 'INVALID REPLACE OPTION'
                     cursor = "REPOPT"; ITERATE
                  END
               END /* IF */
               ELSE lfile = fnbuild(lfname,rfname)
               IF pds THEN
                  /* Receive all members from the host system */
                  CALL recvpds hostlu,lfname,rfname,fclass,repopt
               ELSE DO
                  /* Retrieve one file or member from the host */
                  SAY "HAPRECV" hostlu lfile rfname fclass repopt
                  CALL HAPRECV hostlu,lfile,rfname,fclass,repopt
               END
               pause = 'Y'
               IF result <> 0 & result <> 4 THEN LEAVE k
               tbselect.k = '*'
            END /* IF */
         END k
         IF k > count THEN next = firstsel
      END /* DO FOREVER */
   END w
END m
finish:
CALL HRXVPUT "HPTSO",profvars
EXIT 0
/* Procedure to receive all members of host dataset */
recvpds: PROCEDURE
   PARSE ARG hostlu,lfname,pdsname,fclass,repopt
   /* Obtain list of members from the host system */
   tempfile = aloctemp()
   CALL HAPLIST hostlu,tempfile,pdsname'(*)'
   IF result <> 0 THEN DO
      ADDRESS CMD '@DEL' tempfile; RETURN result; END
   /* Read the list into a table and close the file */
   DO k = 1 WHILE LINES(tempfile) > 0
      PARSE VALUE LINEIN(tempfile) WITH hmem.k '00'X .
   END
   CALL LINEOUT tempfile
   ADDRESS CMD '@DEL' tempfile
   count = k - 1
   /* Retrieve each member from the host dataset */
   DO k = 1 TO count
      rfname = pdsname'('hmem.k')'
      lfile = fnbuild(lfname,rfname)
      SAY "HAPRECV" hostlu lfile rfname fclass repopt
      ft = HAPRECV(hostlu,lfile,rfname,fclass,repopt)
      IF ft <> 0 & ft <> 4 THEN RETURN ft
   END
   RETURN 0
/* Procedure to construct local filename from remote filename */
fnbuild: PROCEDURE
   PARSE ARG lfname,rfname
   PARSE VAR rfname dsname '(' member ')'
   SELECT
   WHEN POS('\',dsname) <> 0 THEN DO
      drive = FILESPEC('D',dsname); path = FILESPEC('P',dsname)
      PARSE VAR path '\' qual1 '\' qual2 '\' qual3 '\' qual4 '\',
          qual5 '\' qual6 '\' qual7 '\' qual8 '\' qual9 '\'
      PARSE VALUE FILESPEC('N',dsname) WITH fname '.' ftype
      END
   WHEN POS('/',dsname) <> 0 THEN DO
      PARSE VAR dsname qual1 '/' qual2 '' qual3 qual4 qual5,
          qual6 qual7 qual8 qual9
      drive = ''; path= ''; fname = qual2; ftype = ''
      END
   OTHERWISE
      PARSE VAR dsname qual1 '.' qual2 '.' qual3 '.' qual4 '.',
          qual5 '.' qual6 '.' qual7 '.' qual8 '.' qual9 '.'
      drive = ''; path = ''; fname = ''; ftype = ''
   END
   lfile = replace(lfname,"&QUAL1",qual1)
   lfile = replace(lfile,"&QUAL2",qual2)
   lfile = replace(lfile,"&QUAL3",qual3)
   lfile = replace(lfile,"&QUAL4",qual4)
   lfile = replace(lfile,"&QUAL5",qual5)
   lfile = replace(lfile,"&QUAL6",qual6)
   lfile = replace(lfile,"&QUAL7",qual7)
   lfile = replace(lfile,"&QUAL8",qual8)
   lfile = replace(lfile,"&QUAL9",qual9)
   lfile = replace(lfile,"&MEMBER",member)
   lfile = replace(lfile,"&DRIVE",drive)
   lfile = replace(lfile,"&PATH",path)
   lfile = replace(lfile,"&FNAME",fname)
   lfile = replace(lfile,"&FTYPE",ftype)
   RETURN lfile
/* Procedure to replace one substring by another */
replace: PROCEDURE
   PARSE ARG source,string1,string2
   PARSE UPPER ARG usource,ustring1
   i = POS(ustring1,usource)
   IF i = 0 THEN RETURN source
   RETURN INSERT(string2,DELSTR(source,i,LENGTH(string1)),i-1)
/* Procedure to allocate a temporary file name */
aloctemp: PROCEDURE
   DO UNTIL STREAM(tempfile,'C','QUERY EXISTS') = ''
      tempfile = 'ZZZ' || TIME('S') || '.R' || SUBSTR(TIME('L'),10,2)
   END
   RETURN tempfile