/* REXX */ /*******************************************************************/ /* */ /* PROGRAMMNAME : FTPCOPY (new Version with FTPAPI ) */ /* AUFRUF : TSO FTPCOPY FOR z/OS */ /* AUTHER : ULRICH BRAEUER */ /* DATUM : 03.08.1998 */ /* FUNKTION : Copy Member(PO, PS, DUMPFILE, USS, ...) */ /* */ /* AENDERUNGEN */ /* JULI 2001 : Copy USSFILE */ /* August 2003 : Copy PSFILE also ADRDSSU Dump File */ /* M„rz 2014 : New Version with FTPAPI */ /* September 2016 : Adaptation for LOAD MODULE */ /* Februar 2018 : MVSPUT/MVSGET */ /* */ /* */ /*******************************************************************/ SIGNAL ON HALT SIGNAL OFF SYNTAX SIGNAL OFF FAILURE SIGNAL OFF ERROR LIBDEF = "N" LIBDEF = "Y" PARSE SOURCE SRC.1 , /* ENVIRONMENT (TSO) */ SRC.2 , /* Calld as (COMMAND) */ SRC.3 , /* PROGRAM NAME (FTPCOPY) */ SRC.4 , /* SYS00186 (TEMP FILE) */ SRC.5 , /* call from Library (x.X.CLIST) */ SRC.6 , /* ? */ SRC.7 , /* TSO */ SRC.8 , /* ISPF */ SRC.9 , /* ? */ . If src.3 = "?" Then Src.3 = "FTPCOPY" ENV = "TSO" USER = USERID() X = MSG('ON') CONNECTED = 'N' WAIT = 'w' WAIT = "n" wm_def = wait wm = wait Show_command = "N" SUID = USERID() TUID = USERID() TRMODE = "BIN" TLIBDD = "'MGDB05.ISPF.ISPTLIB'" TLIBCHK = listdsi(TLIBDD) IPLIST = "FTPCPY00" if TLIBCHK = 0 , ! TLIBCHK = 4 , ! TLIBCHK = 16 & ( SYSREASON = 8 , ! SYSREASON = 9 , ! SYSREASON = 19 , ! SYSREASON = 22 , ! SYSREASON = 25 , ! SYSREASON = 26 , ! SYSREASON = 27 , ! SYSREASON = 30 , ) Then DO TLIBDD = "" NOP End Else Do Call copy_to_my_table IPLIST TLIBDD = "" End PARSE VALUE MVSVAR(SYSOPSYS) With System Version FMID Parse value Version with zVersion "." zRelease "." zModlevel /* AB zOS 2.2 geht der MVSCOPY */ call syscalls 'ON' TSOCMD = "NETSTAT HOME" DROP TAB. B = OUTTRAP('TAB.') ADDRESS TSO TSOCMD If RC <> 0 Then Do Say "Fehler beim ermitteln der Home Adresse " RC Say " Das Wars und Tschuess " Return End IPADDR = "" PORT = "21" PANZ = 3 DO I = 1 TO TAB.0 Zeile = Translate(tab.i) If pos('ADDRESS', ZEILE) > 0 , & pos('LINK', ZEILE) > 0 , & pos('FLG', ZEILE) > 0 Then Do PANZ = Words(Zeile) End If PANZ > 3 Then Do /* Mit Message */ PArse value tab.i with Message IP LINK FLAG . End Else Do /* Ohne Message*/ PArse value tab.i with IP LINK FLAG . End Parse value IP With First "." Rest If Datatype(First) = "NUM" Then Do If Flag = 'P' Then Do IPADDR = IP Leave End End END If IPADDR = "" Then Do Say "Fehler beim ermitteln der Home Adresse " Say " Das Wars und Tschuess " Return End call Init_site_Parm IPLIST = "FTPCPY00" MEMLIST = "FTPCPY01" ADDRESS ISPEXEC 'VGET (ZSCREEN) ' SCRNR = ZSCREEN If LIBDEF = "Y" then Do DSNAME = Space(USERID()"."MVSVAR("SYSNAME")"."SRC.3".TMPFIL",0) DSNAME = Space(USERID() "." , MVSVAR("SYSNAME") SCRNR "." , SRC.3 "." , TMPFIL,0) PLIBDS = "'" !! DSNAME !! "'" ADDRESS "TSO" ADDRESS "TSO" "FREE FI(PLIB)" ADDRESS TSO "DELETE " !! PLIBDS X = MSG('ON') resp = OUTTRAP(errycos.,"*","NOCONCAT") ADDRESS "TSO" "ALLOC F(PLIB) DA("PLIBDS") NEW CATALOG " , "SPACE(1,20) CYL DIR(100) " , "LRECL(80) UNIT(SYSDA) RECFM(F,B)" , "DSNTYPE(LIBRARY) " , "" IF rc <> 0 THEN DO SAY "Error on ALLOC Input File" PLIBDS ", RC =" rc DO i=1 to errycos.0 SAY errycos.i END ADDRESS "TSO" "ALLOC F(PLIB) DA("PLIBDS") MOD DELETE DELETE " ADDRESS "TSO" "FREE FI(PLIB)" ADDRESS TSO "DELETE " !! PLIBDS EXIT END DROP WLine. Call PAN_FTPIPED MemName = "FTPIPED" Call Write_Mem DROP WLine. Call PAN_FTPIPLI MemName = "FTPIPLI" Call Write_Mem DROP WLine. Call PAN_FTPCOPY MemName = 'FTPCOPY' Call Write_Mem DROP WLine. Call PAN_FTPCOPYH MemName = 'FTPCOPYH' Call Write_Mem DROP WLine. Call PAN_FTPCOPYS MemName = 'FTPCOPYS' Call Write_Mem DROP WLine. Call PAN_FTPCOPYU MemName = 'FTPCOPYU' Call Write_Mem X = MSG('OFF') ADDRESS "TSO" "FREE FI(PLIB)" ADDRESS ISPEXEC "LIBDEF ISPPLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID( )" End ADDRESS ISPEXEC 'TBOPEN 'IPLIST 'SHARE' if rc /= 0 then Do ADDRESS ISPEXEC "TBCREATE "IPLIST , " NAMES(SFILE, " , " TFILE, " , " TUID, " , " TADDR, " , " TRMODE, " , " PORT, " , " Beschr, " , " AKTIVE, " , " Sortkz, " , " SITEP, " , " PARM1, " , " PARM2, " , " PARM3, " , " PARM4, " , " PARM5, " , " TEXT1, " , " TEXT2, " , " TEXT3, " , " TEXT4, " , " TEXT5 ) " , " REPLACE" , "" If RC <> 0 Then do SAY "TBCREATE RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM ="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM ="ZERRSM return End SFILE = " " TUID = USER TFILE = " " TADDR = IPADDR TRMODE = "BIN" PORT = "21" ADDRESS ISPEXEC 'TBADD 'IPLIST If RC <> 0 Then do SAY "TBPUT RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM ="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM ="ZERRSM End End If LIBDEF = "Y" then Do ADDRESS ISPEXEC "LIBDEF ISPPLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPPLIB DATASET ID("PLIBDS") UNCOND STACK" If TLIBDD <> "" Then Do ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID("TLIBDD") UNCOND STACK" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID("TLIBDD") UNCOND STACK" End End ADDRESS ISPEXEC 'TBCLOSE 'IPLIST IPMSG = 'MSG( )' IPCUR = 'CURSOR(ZCMD)' CSRROW1 = 'CSRROW(1)' ZTDSELS = 0 ZTDTOP = 0 LNR = 1 CRP = 1 LAUFNR = 1 DO FOREVER IPSEL = " " PANEL = "FTPIPLI" SCAVAR = "ALL" TOP = 1 IPCUR = 'CURSOR(IPSEL)' address ISPEXEC 'TBOPEN 'IPLIST 'SHARE' address ISPEXEC 'TBTOP 'IPLIST address ISPEXEC 'TBSKIP 'IPLIST' NUMBER('ZTDTOP')' address ispexec 'TBDISPL 'IPLIST' PANEL('PANEL')', IPMSG IPCUR 'CSRROW('LAUFNR')' , 'AUTOSEL(NO) POSITION(CRP)' If rc > 4 then do Say "*** Fehler beim Display Alter RC="rc Say " ZERRSM =" ZERRSM Say " ZERRLM =" ZERRLM exit End COMMAND = ZCMD /* PF Tasten Pruefen */ Select WHEN Word(COMMAND, 1) = "SORT" THEN DO address ISPEXEC 'TBSORT 'IPLIST' FIELDS(Sortkz,C,A ', ',AKTIVE,C,A ' , ',Beschr,C,A) ' End WHEN SUBSTR(COMMAND,1,3) = "CAN" THEN DO address ispexec 'TBCLOSE 'IPLIST LEAVE end When PF = 'PF03' THEN DO address ispexec 'TBCLOSE 'IPLIST LEAVE end When PF = 'PF04' THEN DO address ispexec 'TBCLOSE 'IPLIST LEAVE end /* When PANELRC = 8 THEN DO address ispexec 'TBCLOSE 'IPLIST LEAVE end */ Otherwise NOP End if ZTDSELS > 0 Then LAUFNR = crp DO while ZTDSELS > 0 Select When IPSEL = "S" Then Do STOP = ZTDTOP SLNR = LAUFNR SSELS = ZTDSELS Call FTP_COPY_EXECUTE ZTDTOP = STOP LAUFNR = SLNR ZTDSELS = SSELS IPSEL = "" Leave End When IPSEL = "E" Then Do Call EDIT_IPLISTE IPSEL = "" Leave End When IPSEL = "I" Then Do Call INSERT_IPLISTE IPSEL = "" Leave End When IPSEL = "DEL" Then Do IPSEL = "" TUID = "" TADDR = "" Port = "" TRMODE = "" Sortkz = "" AKTIVE = "" SFILE = "" TFILE = "" ADDRESS ISPEXEC 'TBDELETE 'IPLIST If RC <> 0 Then do SAY "TBDELETE RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM ="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM ="ZERRSM End End When IPSEL = "C" Then Do CURSOR = 'CURSOR(ZCMD)' IPSEL = "" COMMAND = ZCMD ADDRESS ISPEXEC 'TBADD 'IPLIST If RC <> 0 Then do SAY "TBADD RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM ="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM ="ZERRSM End Call EDIT_IPLISTE LEAVE End OTHERWISE NOP End ADDRESS ISPEXEC 'TBSKIP 'IPLIST if ZTDSELS = 1 then Leave end If PANELRC = 8 THEN DO address ispexec 'TBCLOSE 'IPLIST LEAVE end /* address ispexec 'TBDISPL 'IPLIST */ address ispexec 'TBCLOSE 'IPLIST End exit_all : ADDRESS ISPEXEC "TBSTATS" IPLIST "STATUS1(s1) STATUS2(s2)" if s2 > 1 Then ADDRESS ISPEXEC 'TBCLOSE 'IPLIST If LIBDEF = "Y" then Do ADDRESS ISPEXEC "LIBDEF ISPPLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID( )" ADDRESS "TSO" "FREE F(PLIB)" ADDRESS "TSO" "DELETE " !! PLIBDS End Return EDIT_IPLISTE: ADDRESS ISPEXEC "DISPLAY PANEL(FTPIPED) " IPSEL = "" COMMAND = ZCMD If Substr(TFILE, 1, 1) = "=" Then TFILE = SFILE If Substr(SFILE, 1, 1) <> "/" Then SFILE = Translate(SFILE) If Substr(TFILE, 1, 1) <> "/" Then TFILE = Translate(TFILE) IF DATATYPE(PORT) <> "NUM" Then PORT = "21" IF SUBSTR(TRMODE, 1, 1) = "A" Then TRMODE = "ASCII" ELSE TRMODE = "BIN" ADDRESS ISPEXEC 'TBPUT 'IPLIST If RC <> 0 Then do SAY "TBMOD RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM ="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM ="ZERRSM End TUID = "" TADDR = "" Port = "" TRMODE = "" Sortkz = "" AKTIVE = "" Beschr = "" SFILE = "" TFILE = "" Return INSERT_IPLISTE: TUID = "" TADDR = "" Port = "" TRMODE = "" Sortkz = "" AKTIVE = "" Beschr = "" SFILE = "" TFILE = "" ADDRESS ISPEXEC "DISPLAY PANEL(FTPIPED) " IPSEL = "" COMMAND = ZCMD If Substr(TFILE, 1, 1) = "=" Then TFILE = SFILE If Substr(SFILE, 1, 1) <> "/" Then SFILE = Translate(SFILE) If Substr(TFILE, 1, 1) <> "/" Then TFILE = Translate(TFILE) IF DATATYPE(PORT) <> "NUM" Then PORT = "21" IF SUBSTR(TRMODE, 1, 1) = "A" Then TRMODE = "ASCII" ELSE TRMODE = "BIN" ADDRESS ISPEXEC 'TBADD 'IPLIST If RC <> 0 Then do SAY "TBADD RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM ="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM ="ZERRSM End Return FTP_COPY_EXECUTE: If Length(strip(SITEP)) = 0 Then siteparm = "" Else siteparm = SITEP If LIBDEF = "Y" then Do ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID("PLIBDS") UNCOND STACK" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID("PLIBDS") UNCOND STACK" End X = MSG('OFF') ADDRESS ISPEXEC 'TBERASE 'MEMLIST ADDRESS ISPEXEC 'TBOPEN 'MEMLIST 'SHARE' if rc /= 0 then Do ADDRESS ISPEXEC "TBCREATE "MEMLIST , " NAMES(LNR, SEL, ,MEMLI1, MEMLI2, ", " MCDATE, MMDATE, CRC, ", " mgrp, muser, msize, mtype ) ", " REPLACE" , "" End ADDRESS ISPEXEC "TBSTATS "MEMLIST , " ROWCURR(ROWS) ", "" ADDRESS ISPEXEC 'TBCLOSE 'MEMLIST CURSOR = 'SFILE' CSRROW = 'CSRROW(1)' RETCODE = RC MESSAGE = 'MSG( )' MSGLINE = '' CONNECTED = 'N' INIT_OK = 'N' ZTDSELS = 0 ZTDTOP = 0 LNR = 1 CRP = 1 SMEM1 = "*" SMEM2 = "*" oSMEM1 = "*" oSMEM2 = "*" LAUFNR = 1 SCAVAR = "ALL" scm = Show_command SAVE_SADDR = IPADDR SADDR = IPADDR SAVE_PORT = '' SAVE_UID = '' SAVE_PWD = '' SAVE_SFILE = '' SAVE_TADDR = '' SAVE_TFILE = '' TPWD = '' PANEL = "FTPCOPY" DU = "No" VARS = "SFILE TFILE " If SFILE = "" Then ADDRESS ISPEXEC 'VGET (SFILE) PROFILE' If TFILE = "" Then ADDRESS ISPEXEC 'VGET (TFILE) PROFILE' If TUID = "" Then TUID = USERID() DSSYSTEM = "" Select When SFILE = "" Then CURSOR = 'SFILE' When TFILE = "" Then CURSOR = 'TFILE' When TADDR = "" Then CURSOR = 'TADDR' When TUID = "" Then CURSOR = 'TUID' When TPWD = "" Then CURSOR = 'TPWD' Otherwise CURSOR = 'TPWD' End DO FOREVER address ISPEXEC 'TBOPEN 'MEMLIST 'SHARE' address ISPEXEC 'TBTOP 'MEMLIST Call Search_TABLE address ISPEXEC 'TBSKIP 'MEMLIST' NUMBER('ZTDTOP')' address ispexec 'TBDISPL 'MEMLIST' PANEL('PANEL')', MESSAGE 'CURSOR('CURSOR')' , 'AUTOSEL(NO) POSITION(CRP)' If rc > 4 then do Say "*** Fehler beim Display Alter RC="rc Say " ZERRSM =" ZERRSM Say " ZERRLM =" ZERRLM exit End COMMAND = ZCMD MSGLINE = "" SCM = STRIP(SCM) Select when SUBSTR(SCM, 1, 1) = 'N' Then Show_command = 'N' when SUBSTR(SCM, 1, 1) = 'Y' Then Show_command = 'Y' Otherwise Show_command = 'N' End LISTFILE = "" MVSPUT = "" If Substr(SFILE, 1, 1) = "/" Then Do DSSYSTEM = "USS" SYSDSORG = "" End Else Do SFILE = Translate(SFILE) DSSYSTEM = "" End If Substr(SFILE, 1, 1) = "*" Then DO LISTFILE = "YES" MVSPUT = "" End If Substr(TFILE, 1, 1) = "=" Then TFILE = SFILE If Substr(TFILE, 1, 1) <> "/" Then TFILE = Translate(TFILE) /* PF Tasten Pruefen */ Select WHEN SUBSTR(COMMAND,1,3) = "CAN" THEN DO LEAVE end WHEN Word(COMMAND, 1) = "SORT" THEN DO Select WHEN Word(COMMAND, 2) = 1 THEN DO address ISPEXEC 'TBSORT 'MEMLIST' FIELDS(LNR,C,A ' , ',MEMLI1,C,A ' , ',MEMLI2,C,A) ' End WHEN Word(COMMAND, 2) = 2 THEN DO address ISPEXEC 'TBSORT 'MEMLIST' FIELDS(MEMLI1,C,A ' , ',MEMLI2,C,A) ' End WHEN Word(COMMAND, 2) = 3 THEN DO address ISPEXEC 'TBSORT 'MEMLIST' FIELDS(MEMLI2,C,A ' , ',MEMLI1,C,A) ' End OTHERWISE Do address ISPEXEC 'TBSORT 'MEMLIST' FIELDS(LNR,C,A ' , ',MEMLI1,C,A ' , ',MEMLI2,C,A) ' End end end When PF = 'PF03' THEN DO LEAVE end When PF = 'PF04' THEN DO LEAVE end /* When PANELRC = 8 THEN DO LEAVE end */ Otherwise NOP End REFRESH_LISTE = '' IF DATATYPE(PORT) <> "NUM" Then PORT = "21" IF SUBSTR(TRMODE, 1, 1) = "A" Then TRMODE = "ASCII" ELSE TRMODE = "BIN" IF SUBSTR(DU , 1, 1) = "Y" Then DU = "YES" ELSE DU = "NO" Select When wm = "W" Then wait = "w" When wm = "N" Then wait = "n" Otherwise Do Wait = wm_def End End If SFILE <> SAVE_SFILE , ! TFILE <> SAVE_TFILE Then do REFRESH_LISTE = 'Y' End If SFILE = "" Then do MSGLINE = "Bitte Source File eingeben " CURSOR = 'SFILE' address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End If TFILE = "" Then do MSGLINE = "Bitte Target File eingeben " CURSOR = 'TFILE' address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End If TADDR = "" Then do MSGLINE = "Bitte IP Adresse eingeben " CURSOR = 'TADDR' address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End If Length(TPWD) = 0 Then do MSGLINE = "Bitte Password eingeben " CURSOR = 'TPWD' address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End If TUID <> SAVE_UID Then do SAVE_UID = TUID FTP_RECONNECT = 'Y' REFRESH_LISTE = 'Y' End If TPWD <> SAVE_PWD Then do SAVE_PWD = TPWD FTP_RECONNECT = 'Y' REFRESH_LISTE = 'Y' End If TADDR <> SAVE_TADDR Then do SAVE_TADDR = TADDR FTP_RECONNECT = 'Y' REFRESH_LISTE = 'Y' End If PORT <> SAVE_PORT Then do SAVE_PORT = PORT FTP_RECONNECT = 'Y' REFRESH_LISTE = 'Y' End If SFILE <> SAVE_SFILE Then do SAVE_SFILE = SFILE REFRESH_LISTE = 'Y' End If TFILE <> SAVE_TFILE Then do SAVE_TFILE = TFILE REFRESH_LISTE = 'Y' End If REFRESH_LISTE = 'Y' Then Do If Length(PORT) = 0 Then do PORT = "21" End If Length(SUID) = 0 Then do MSGLINE = "Bitte UserID eingeben " CURSOR = 'SUID' address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End If Length(TUID) = 0 Then do MSGLINE = "Bitte UserID eingeben " CURSOR = 'TUID' address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End If Length(TADDR) = 0 Then do MSGLINE = "Bitte to IPAdresse eingeben " CURSOR = 'TADDR' address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End If Length(TPWD) = 0 Then do MSGLINE = "Bitte Password eingeben " CURSOR = 'TPWD' address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End CheckOK = Check_File(STRIP(SFILE,B,"'") ) If CheckOK > 0 Then Do MSGLINE = "Source File Existiert nicht " CURSOR = 'SFILE' address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End End If REFRESH_LISTE = 'Y' Then Do LNR = 0 If FTP_RECONNECT = 'Y' Then Do Call FTP_FTPAPI_CLOSE Call FTP_FTPAPI_OPEN End If CONNECTED = "Y" Then Do FTP_RECONNECT = '' Call Memlist_Neu_lesen End ELSE Do address ISPEXEC 'TBCLOSE 'MEMLIST Iterate End Call FTP_FTPAPI_CHDIR End DROP WorkList. WorkList.0 = 0 DO while ZTDSELS > 0 ANZ = 1 SEL_NEW = SEL ADDRESS ISPEXEC 'TBGET 'MEMLIST SEL = SEL_NEW Select When SEL = "C" , /*COPY */ ! SEL = "P" , /*PUT */ ! SEL = "PUT" , ! SEL = "COPY" Then Do MEMLI2 = MEMLI1 WorkList.0 = 1 WLI = WorkList.0 select When SYSDSORG = 'PS' Then do WorkList.WLI = "MVSPUT "MEMLI1 MEMLI2 End Otherwise Do WorkList.WLI = "PUT "MEMLI1 MEMLI2 End End Call FTP_FTPAPI_DO_IT SEL = "" CRC = "" IF MAXRC = 0 Then CRC = "CPY" ELSE CRC = "ERR" ADDRESS ISPEXEC 'TBPUT 'MEMLIST End When SEL = "G" , ! SEL = "GET" Then Do MEMLI1 = MEMLI2 WorkList.0 = 1 WLI = WorkList.0 select When SYSDSORG = 'PS' Then do WorkList.WLI = "MVSGET "MEMLI1 MEMLI2 End Otherwise Do WorkList.WLI = "GET "MEMLI1 MEMLI2 End End Call FTP_FTPAPI_DO_IT SEL = "" CRC = "" IF MAXRC = 0 Then CRC = "GET" ELSE CRC = "ERR" ADDRESS ISPEXEC 'TBPUT 'MEMLIST End Otherwise nop End ADDRESS ISPEXEC 'TBSKIP 'MEMLIST if ZTDSELS = 1 then Leave SEL = "" address ispexec 'TBDISPL 'MEMLIST end IF CLOSE <> "Y" Then Address ispexec 'TBCLOSE 'MEMLIST CLOSE = "N" End Call FTP_FTPAPI_CLOSE If LIBDEF = "Y" then Do ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID( )" If TLIBDD <> "" Then Do ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID("TLIBDD") UNCOND STACK" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID("TLIBDD") UNCOND STACK" End /* "FREE F(PLIB)" ADDRESS TSO "DELETE " !! PLIBDS */ End /* ADDRESS ISPEXEC 'VPUT (SFILE) PROFILE' ADDRESS ISPEXEC 'VPUT (TUID) PROFILE' ADDRESS ISPEXEC 'VPUT (TFILE) PROFILE' ADDRESS ISPEXEC 'VPUT (TADDR) PROFILE' ADDRESS ISPEXEC 'VPUT (TRMODE) PROFILE' ADDRESS ISPEXEC 'VPUT (PORT) PROFILE' */ ADDRESS ISPEXEC 'VPUT (&VARS) PROFILE' address ispexec 'TBCLOSE 'MEMLIST ADDRESS ISPEXEC 'TBERASE 'MEMLIST PF = "" Return Memlist_Neu_lesen: SMEM1 = "*" SMEM2 = "*" oSMEM1 = "*" oSMEM2 = "*" CURSOR = "SMEM1" ADDRESS ISPEXEC "TBCLOSE "MEMLIST ADDRESS ISPEXEC "TBERASE "MEMLIST ADDRESS ISPEXEC "TBCREATE "MEMLIST , " NAMES(LNR, SEL, ,MEMLI1, MEMLI2, ", " MCDATE, MMDATE, CRC, ", " mgrp, muser, msize, mtype ) ", " REPLACE" , "" Drop MemList. MemList.0 = 0 If Length(SFILE) > 0 Then do select When DSSYSTEM = "USS" Then Do Call LOCAL_Get_memlist_USS SFILE End When SYSDSORG = 'PO' Then Do Call LOCAL_Get_memlist SFILE End When SYSDSORG = 'PS' Then Do Call LOCAL_Get_memlist SFILE End Otherwise Call LOCAL_Get_memlist SFILE End End If Length(TADDR) > 0 & Length(TFILE) > 0 Then do select When DSSYSTEM = "USS" Then Do Call FTP_Get_memlist TADDR, TFILE, TUID, TPWD, 2 End When SYSDSORG = 'PO' Then Do Call FTP_Get_memlist TADDR, TFILE, TUID, TPWD, 2 End When SYSDSORG = 'PS' Then Do Call FTP_Get_memlist TADDR, SFILE, TUID, TPWD, 2 End Otherwise NOP End End memli1 = "" memli2 = "" Do mi = 1 to MemList.0 LNR = mi sel = "" crc = "" memli1 = MemList.mi.mem1 memli2 = MemList.mi.mem2 MCDATE = MemList.mi.CDATE MMDATE = MemList.mi.MDATE mgrp = MemList.mi.grp muser = MemList.mi.user msize = MemList.mi.size mtype = MemList.mi.type Call ADD_TABLE end Return LOCAL_Get_memlist: IF POS('*', DSNAME) > 0 Then Do SYSDSORG = "PS" DSSYSTEM = "" End select When SYSDSORG = 'PO' Then Do Call LOCAL_Get_memlist_PO SFILE End When SYSDSORG = 'PS' Then Do Call LOCAL_Get_memlist_PS SFILE End Otherwise NOP End Return LOCAL_Get_memlist_PS: DSN = ARG(1) QUAL = DSN MemList.0 = 0 DROP DSVAR DROP IDV "ISPEXEC LMDINIT LISTID(IDV) LEVEL(&QUAL)" DO FOREVER "ISPEXEC LMDLIST LISTID("IDV") OPTION(LIST) DATASET(DSVAR) STATS(YES)" IF RC <> 0 Then Leave MemList.0 = MemList.0 + 1 MI = MemList.0 MemList.mi.mem1 = DSVAR MemList.mi.CDATE = "" MemList.mi.MDATE = "" MemList.mi.mem2 = "" END /* END OF FOREVER LOOP */ "ISPEXEC LMDFREE LISTID("IDV")" Return LOCAL_Get_memlist_PO: PODSN = ARG(1) Address tso dsn = PODSN "ALLOC F(AREAD) DS('"DSN"') SHR REUSE DSORG(PS) LRECL(256) RECFM(F B)" "EXECIO * DISKR AREAD ( FINIS STEM ENTRY." "FREE F(AREAD)" changed_members = 0 Do IX = 1 to ENTRY.0 part = ENTRY.IX Parse Var ENTRY.IX bl 3 part part = substr(part,1,c2d(bl)-2) DO WHILE part <> "" Parse Var part MEMBER 9 ttr 12 c 13 part C = C2D(BITAND(C,'1F'X)) If MEMBER='FFFFFFFFFFFFFFFF'x Then Leave IX IF C=15 & SYSRECFM <> "U" THEN DO Direntry = substr(part,1,30) PARSE VAR DIRENTRY, VV 2 , MM 3 , FLAGS 4 , SS 5 , CRECC 6 , CRDATE 9 , MODCC 10 , MODDATE 13 , HH 14 , TM 15 , LINES 17 , INIT 19 , MOD 21 , UID 28 , . Parse Value c2x(crdate) with cyy 3 cjjj 6 . Parse Value c2x(moddate) with myy 3 mjjj 6 . VVMM = leftd(vv) '.' leftd(mm) CRDATE = 19+c2x(crecc)cyy'.'cjjj CRDATE = Datum_Aufbereiten(CRDATE) MODDATE = 19+c2x(modcc)myy'.'mjjj MODDATE = Datum_Aufbereiten(MODDATE) MODTIME = leftx(hh)':'leftx(tm)':'leftx(ss) LINES = right(c2d(lines),5) INITIAL = right(c2d(init),5) MODLINE = right(c2d(mod),5) UID = userid END Else do VVMM = "" CRDATE = "" MODDATE = "" MODTIME = "" LINES = "" INITIAL = "" MODLINE = "" UID = "" END MemList.0 = MemList.0 + 1 mi = MemList.0 MemList.mi.mem1 = member MemList.mi.CDATE = CRDATE MemList.mi.MDATE = MODDATE MemList.mi.mem2 = "" IF UID = "" THEN MemList.mi.MEMU = "" ELSE MemList.mi.memU = "U" part=delstr(part,1,c*2) End End Return leftd: return right(c2d(arg(1)),2,'0') leftx: return right(c2x(arg(1)),2,'0') Datum_Aufbereiten: ADATE = Arg(1) PARSE VAR ADATE 1 CC 3 YY '.' DDD . JDATE = YY !! DDD GDATE = DATE('U',JDATE,'J') PARSE Value GDATE WITH MM '/' DD '/' YY GDATE = DD !! "." !!MM !!"." !! CC !! YY Return GDate LOCAL_Get_memlist_USS: FileNAME = Arg(1) stdin.0 = 0 stdout.0 = 0 stderr.0 = 0 rc=bpxwunix("ls -l "FileName,stdin.,output.,stderr.) If stderr.0 <> 0 Then do i = 1 to stderr.0 ; say stderr.i; end do oi=1 to output.0 parse value output.oi with perm , test , gruppe , benutzer , groesse , month , day , time , member , . if perm = 'total' Then Iterate if perm = '.' Then Iterate if perm = '..' Then Iterate MemList.0 = MemList.0 + 1 mi = MemList.0 MemList.mi.mem1 = member MemList.mi.grp = gruppe MemList.mi.user = benutzer MemList.mi.size = groesse Select When Substr(translate(perm), 1, 1) = "D" Then Do MemList.mi.type = "Dir" End When Substr(translate(perm), 1, 1) = "L" Then Do MemList.mi.type = "Syml" End Otherwise Do MemList.mi.type = "File" End End MemList.mi.CDATE = "" MemList.mi.MDATE = "" MemList.mi.mem2 = "" end "FREE F(INPUT OUTPUT)" do queued() ; pull rest; End ; Return FTP_Get_memlist: AADDR = Arg(1) AFILE = Arg(2) AUID = Arg(3) APWD = Arg(4) ANR = Arg(5) select When DSSYSTEM = 'USS' Then Do Call FTP_Get_memlist_USS AADDR, AFILE, AUID, APWD, ANR End When SYSDSORG = 'PO' Then Do Call FTP_Get_memlist_PO AADDR, AFILE, AUID, APWD, ANR End When SYSDSORG = 'PS' Then Do Call FTP_Get_memlist_PS AADDR, AFILE, AUID, APWD, ANR End Otherwise NOP End Return FTP_Get_memlist_PO: Hostname = Arg(1) FileNAME = Arg(2) LOGIN = Arg(3) PASSWORD = Arg(4) MEM = Arg(5) If Length(Strip(LOGIN)) = 0 Then Return If Length(Strip(PASSWORD)) = 0 Then Return drop lines. lines.0 = 0 cmds = "cd '"Strip(FileNAME)"'" OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return cmds = "LS " OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return rc = ftpapi('fcai.', 'getl_copy', 'lines.', 'L') do oi=1 to lines.0 member = strip(Word(Lines.oi, 1)) if mem = 1 Then Do MemList.0 = MemList.0 + 1 mi = MemList.0 MemList.mi.mem1 = member MemList.mi.mem2 = "" End found = "N" if mem = 2 Then Do Do mi2 = 1 to MemList.0 If Member = MemList.mi2.mem1 Then Do MemList.mi2.mem2 = member found = "Y" Leave End End IF Found = "N" Then do MemList.0 = MemList.0 + 1 mi = MemList.0 MemList.mi.mem1 = "" MemList.mi.CDATE = "" MemList.mi.MDATE = "" MemList.mi.mem2 = member End End end Return FTP_Get_memlist_PS: Hostname = Arg(1) FileNAME = Arg(2) LOGIN = Arg(3) PASSWORD = Arg(4) MEM = Arg(5) If Length(Strip(LOGIN)) = 0 Then Return If Length(Strip(PASSWORD)) = 0 Then Return drop lines. lines.0 = 0 cmds = "ls '"Strip(FileNAME)"'" OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return rc = ftpapi('fcai.', 'getl_copy', 'lines.', 'L') do oi=1 to lines.0 member = strip(Word(Lines.oi, 1)) member = STRIP(member,B,"'" ) member = Substr(member, 2) if mem = 1 Then Do MemList.0 = MemList.0 + 1 mi = MemList.0 MemList.mi.mem1 = member MemList.mi.grp = "" MemList.mi.user = "" MemList.mi.size = "" MemList.mi.CDATE = "" MemList.mi.MDATE = "" MemList.mi.mem2 = "" End found = "N" if mem = 2 Then Do Do mi2 = 1 to MemList.0 If Member = MemList.mi2.mem1 Then Do MemList.mi2.mem2 = member found = "Y" Leave End End IF Found = "N" Then do MemList.0 = MemList.0 + 1 mi = MemList.0 MemList.mi.mem1 = "" MemList.mi.grp = "" MemList.mi.user = "" MemList.mi.size = "" MemList.mi.type = "" MemList.mi.CDATE = "" MemList.mi.MDATE = "" MemList.mi.mem2 = member End End end Return FTP_Get_memlist_USS: Hostname = Arg(1) FileNAME = Arg(2) LOGIN = Arg(3) PASSWORD = Arg(4) MEM = Arg(5) If Length(Strip(LOGIN)) = 0 Then Return If Length(Strip(PASSWORD)) = 0 Then Return drop lines. lines.0 = 0 cmds = "cd '"Strip(FileNAME)"'" OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return cmds = "LS " OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return rc = ftpapi('fcai.', 'getl_copy', 'lines.', 'L') do oi=1 to lines.0 member = strip(Word(Lines.oi, 1)) if perm = 'total' Then Iterate found = "N" Do mi2 = 1 to MemList.0 If Member = MemList.mi2.mem1 Then Do MemList.mi2.mem2 = member found = "Y" Leave End End IF Found = "N" Then do MemList.0 = MemList.0 + 1 mi = MemList.0 MemList.mi.mem1 = "" MemList.mi.grp = "" MemList.mi.user = "" MemList.mi.size = "" MemList.mi.type = "" MemList.mi.CDATE = "" MemList.mi.MDATE = "" MemList.mi.mem2 = member End end Return FTP_FTPAPI_OPEN: HOSTNAME = Strip(TADDR) Strip(PORT) LOGIN = TUID PASSWORD = TPWD OTRMODE = "" CONNECTED = "N" If Length(Strip(LOGIN)) = 0 Then Return If Length(Strip(PASSWORD)) = 0 Then Return ftp_rc = ftpapi('fcai.', 'create') if ftp_rc < 0 then Do SAY "error on Create " If Datatype(fcai.0) <> "NUM" Then fcai.0 = 0 do ftp_erri = 1 to fcai.0; Say ftp_erri fcai.ftp_erri ; End ; Call ftperr Return End ftp_rc = FtpApi('fcai.', 'init') /* ftp_rc = FtpApi('fcai.', 'init') */ if ftp_rc < 0 then Do SAY "error on INIT " Call ftperr Return End INIT_OK = "Y" cmds = "open" hostname OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Do Call FTP_FTPAPI_CLOSE Return End cmds = "user" LOGIN OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Do Call FTP_FTPAPI_CLOSE Return End /* Call fcai_map_Info */ cmds = "pass" PASSWORD /* OK = EX_ftpapi(cmds, wait) */ OK = EX_ftpapi(cmds, "w" ) if OK <> 0 Then do SAY "error on pass ******** " Call ftperr MSGLINE = "wrong Password enter correct password " TPWD = "" SAVE_PWD = TPWD CURSOR = 'TPWD' Call FTP_FTPAPI_CLOSE Return End CONNECTED = "Y" Return FTP_FTPAPI_CHDIR: If CONNECTED = "N" Then Do /* not yet connected */ say "FTPAPI NOT CONNECTED " Return End MAXRC = 0 SFileNAME = space("'" SFILE "'" ,0) TFileNAME = space("'" TFILE "'" ,0) Hostname = TADDR LOGIN = TUID PASSWORD = TPWD IF SYSDSORG <> 'PS' Then Do cmds = "lcd" SFileName OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return cmds = "cd" TFileName OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return End Select When DU = "YES" THEN TRMODE = "ebcdic" When SUBSTR(TRMODE, 1, 1) = "A" Then TRMODE = "ASCII" Otherwise TRMODE = "BIN" End cmds = TRMODE OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return OTRMODE = TRMODE Return FTP_FTPAPI_DO_IT: If CONNECTED = "N" Then Do /* not yet connected */ say "FTPAPI NOT CONNECTED " Return End MAXRC = 0 SFileNAME = space("'" SFILE "'" ,0) TFileNAME = space("'" TFILE "'" ,0) Do WLI = 1 To Worklist.0 ftp_rc = 0 Parse value worklist.wli with doit MEMLI1 MEMLI2 . select when doit = "MVSPUT" Then Do replace = "(REAllocate" MEMLI1 = space("'" MEMLI1 "'" ,0) MEMLI2 = space("'" MEMLI2 "'" ,0) End when doit = "MVSGET" Then Do replace = "(REAllocate" MEMLI1 = space("'" MEMLI1 "'" ,0) MEMLI2 = space("'" MEMLI2 "'" ,0) End when doit = "GET" & MEMLI1 = MEMLI2 Then Do replace = "(REPLACE" End otherwise Replace = "" end If siteparm <> "" Then Do cmds = "quote site " siteparm OK = EX_ftpapi(cmds, wait) /* IF OK <> 0 Then Return */ End Select When DU = "YES" THEN TRMODE = "ebcdic" When SUBSTR(TRMODE, 1, 1) = "A" THEN TRMODE = "ASCII" Otherwise TRMODE = "BIN" End If OTRMODE <> TRMODE Then do cmds = TRMODE OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return OTRMODE = TRMODE End If DU = "YES" THEN Do /* ADRDSSU DUMP FILE */ cmds = "mode B" OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return End cmds = doit MEMLI1 MEMLI2 Replace OK = EX_ftpapi(cmds, wait) IF OK <> 0 Then Return MEMLI1 = Strip(MEMLI1, 'B', "'" ) MEMLI2 = Strip(MEMLI2, 'B', "'" ) End Return FTP_FTPAPI_CLOSE: If INIT_OK = "N" Then Do /* not yet connected */ Return End cmds = "QUIT" OK = EX_ftpapi(cmds, wait) ftp_rc = FtpApi('fcai.', 'term') INIT_OK = "N" Return ftperr: MAXRC = 8 if ftp_rc <> 0 then Do say 'fpt error codes:' ftp_rc fcai.FCAI_Result FCAI_Result_ie, fcai.FCAI_ie say ' RC =' fcai.FCAI_ReturnCode say ' Reason =' fcai.FCAI_ReasonCode say ' Status =' fcai.FCAI_Status End ln.0 = 0 rm = ftpapi('fcai.','getl_copy','ln.') if rm < 0 then Do say 'get text error:' ftp_rc fcai.FCAI_Result FCAI_Result_ie, fcai.FCAI_ie End do ftp_err_i = 1 to ln.0 say ln.ftp_err_i end return ftp_rc fcai_map_Info: rc=ftpapi('fcai.', 'get_fcai_map', 'fcaiMap.') say "fcaiMap.FCAI_EyeCatcher ="fcaiMap.FCAI_EyeCatcher say "fcaiMap.FCAI_Size ="fcaiMap.FCAI_Size say "fcaiMap.FCAI_Version ="fcaiMap.FCAI_Version say "fcaiMap.FCAI_PollWait ="fcaiMap.FCAI_PollWait say "fcaiMap.FCAI_ReqTimer ="fcaiMap.FCAI_ReqTimer say "fcaiMap.FCAI_TraceIt ="fcaiMap.FCAI_TraceIt say "fcaiMap.FCAI_TraceID ="fcaiMap.FCAI_TraceID say "fcaiMap.FCAI_TraceCAPI ="fcaiMap.FCAI_TraceCAPI say "fcaiMap.FCAI_TraceStatus ="fcaiMap.FCAI_TraceStatus say "fcaiMap.FCAI_TraceSClass ="fcaiMap.FCAI_TraceSClass say "fcaiMap.FCAI_TraceName ="fcaiMap.FCAI_TraceName say "fcaiMap.FCAI_Token ="fcaiMap.FCAI_Token say "fcaiMap.FCAI_RequestID ="fcaiMap.FCAI_RequestID say "fcaiMap.FCAI_Result ="fcaiMap.FCAI_Result say "fcaiMap.FCAI_IE ="fcaiMap.FCAI_IE say "fcaiMap.FCAI_CEC ="fcaiMap.FCAI_CEC say "fcaiMap.FCAI_ReplyCode ="fcaiMap.FCAI_ReplyCode say "fcaiMap.FCAI_SCMD ="fcaiMap.FCAI_SCMD say "fcaiMap.FCAI_ReturnCode ="fcaiMap.FCAI_ReturnCode say "fcaiMap.FCAI_ReasonCode ="fcaiMap.FCAI_ReasonCode say "fcaiMap.FCAI_NumberLines ="fcaiMap.FCAI_NumberLines say "fcaiMap.FCAI_LongestLine ="fcaiMap.FCAI_LongestLine say "fcaiMap.FCAI_SizeAll ="fcaiMap.FCAI_SizeAll say "fcaiMap.FCAI_SizeMessages ="fcaiMap.FCAI_SizeMessages say "fcaiMap.FCAI_SizeReplies ="fcaiMap.FCAI_SizeReplies say "fcaiMap.FCAI_SizeList ="fcaiMap.FCAI_SizeList say "fcaiMap.FCAI_SizeTrace ="fcaiMap.FCAI_SizeTrace say "fcaiMap.FCAI_PID ="fcaiMap.FCAI_PID return ADD_TABLE: ADDRESS ISPEXEC 'TBADD 'MEMLIST If RC <> 0 Then do SAY "RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM="ZERRSM End Return Search_TABLE: if ZTDSELS > 0 Then LAUFNR = crp if OSMEM1 <> SMEM1 & OSMEM2 <> SMEM2 Then Do ZTDTOP = 1 End OSMEM1 = SMEM1 OSMEM2 = SMEM2 if SMEM1 = "" Then SMEM1 = "*" if SMEM2 = "" Then SMEM2 = "*" If SMEM1 = "*" & SMEM2 = "*" Then do SCAVAR = "ALL" End Else Do IF POS("*", SMEM1) = 0 Then SMEM1 = SMEM1 !! "*" IF POS("*", SMEM2) = 0 Then SMEM2 = SMEM2 !! "*" SCAVAR = "SCAN" ADDRESS ISPEXEC 'TBTOP 'MEMLIST ADDRESS ISPEXEC 'TBVCLEAR 'MEMLIST MEMLI1 = SMEM1 MEMLI2 = SMEM2 ADDRESS ISPEXEC 'TBSARG 'MEMLIST , ' NAMECOND(MEMLI1,EQ,MEMLI2,EQ)' End ADDRESS ISPEXEC /* do while rc = 0;say dataset aktive ;'TBSKIP 'MEMLIST; end; */ Return Check_File: DSNAME = Arg(1) MaxRC = 0 STAT = MSG('OFF') RC = LISTDSI("'" !! DSNAME !! "'") IF POS('*', DSNAME) > 0 Then Do RC = 0 SYSDSORG = 'PS' End IF RC < 16 THEN MaxRC = 0 ELSE MaxRC = RC STAT = MSG('ON') Select When SYSDSORG = 'PO' Then PANEL = 'FTPCOPY' When SYSDSORG = 'PS' Then PANEL = 'FTPCOPYS' When DSSYSTEM = 'USS' Then Do PANEL = 'FTPCOPYU' MAXRC = 0 End Otherwise PANEL = 'FTPCOPY' END Return MaxRC EX_ftpapi: cmds = arg(1) warten = arg(2) ftp_rc = 0 Start_Zeit = time('L') ftp_rc = ftpapi('fcai.', 'scmd', cmds, warten) If warten = "" ! warten = "n" ! warten = "N" Then do ftp_prc = 0 fcaiMap.FCAI_PollWait = 0 poll_wait = fcaiMap.FCAI_PollWait Do while ftp_prc > -1 ftp_prc = ftpapi('fcai.', 'poll', Poll_Wait) if ftp_prc = 0 Then leave if ftp_prc < 1 Then leave End End ftp_prc = 0 End_Zeit = time('L') cm = translate(cmds) If Word(cm, 1) = "PASS" Then do cmds = Word(cmds, 1) "***************" End If Show_command = "Y" Then do cm = translate(cmds) cmda = cmds If Word(CM, 1) = "PASS" Then cmda = "pass ********" say "ftp_rc = ftpapi('fcai.', 'scmd', " cmda ","warten")" , "RC="ftp_rc , Start_Zeit End_Zeit End if ftp_rc < 0 then Do SAY "error on "cmds "RC="ftp_rc Call ftperr Return 8 End Return 0 PAN_FTPIPLI: Z=")ATTR DEFAULT(%+_)" OK=WL(Z) Z=" % TYPE(TEXT ) INTENS(HIGH) SKIP(ON)" OK=WL(Z) Z=" + TYPE(TEXT ) INTENS(LOW ) SKIP(ON)" OK=WL(Z) Z=" _ TYPE(INPUT) INTENS(HIGH) CAPS(ON) JUST(LEFT) HILITE(USCORE)" OK=WL(Z) Z=" õ TYPE(INPUT) INTENS(HIGH) CAPS(ON ) JUST(LEFT)" OK=WL(Z) Z=" ` TYPE(INPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT)" OK=WL(Z) Z=" $ TYPE(INPUT) INTENS(NON) CAPS(OFF)" OK=WL(Z) Z=" HILITE(USCORE)" OK=WL(Z) Z=" ! TYPE(OUTPUT) INTENS(LOW ) CAPS(OFF) JUST(LEFT) PAD(' ')" OK=WL(Z) Z=" ø TYPE(OUTPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT) PAD(' ')" OK=WL(Z) Z=" ^ TYPE(OUTPUT) INTENS(HIGH) CAPS(OFF) HILITE(USCORE) JUST(RIGHT" !!, ") " OK=WL(Z) Z=")Body Expand(//)" OK=WL(Z) Z="%Command ==>_zcmd / / %S" !!, "croll ===>_AMT +" OK=WL(Z) Z="+ +" OK=WL(Z) Z="+ S=SELECT E=EDIT C=COPY I=INSERT DEL=DELETE +" OK=WL(Z) Z="+IPSEL+TUID +TADDR +PORT +", "Beschreibung " OK=WL(Z) Z="+----- ------------------ ---------------------- ----- ", "------------------------" OK=WL(Z) Z=")MODEL ROWS(&SCAVAR)" OK=WL(Z) Z="_IPSEL!TUID !TADDR !PORT +" !!, "!Beschr " OK=WL(Z) Z=")INIT" OK=WL(Z) Z=" &ZCURSOR = .CURSOR" OK=WL(Z) Z=" .HELP = FTPCOPYH" OK=WL(Z) Z=" &MSGLINE = &MSGLINE" OK=WL(Z) Z=")REINIT" OK=WL(Z) Z=" REFRESH(*)" OK=WL(Z) Z=" &ZCURSOR = .CURSOR" OK=WL(Z) Z=")PROC" OK=WL(Z) Z=" &PF = .PFKEY" OK=WL(Z) Z=" &PFINHALT = TRUNC(&PFTASTE,2)" OK=WL(Z) Z=" &PFINHALT = .TRAIL" OK=WL(Z) Z=" &PFINHALT = PFK(&PFINHALT)" OK=WL(Z) Z="" OK=WL(Z) Z=" &PANELRC = 0" OK=WL(Z) Z="&PANELRC = 0" OK=WL(Z) Z="IF (.RESP = END,RETURN)" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" &PANELRC = 8" OK=WL(Z) Z="IF (&ZCMD = CAN,CANCEL)" OK=WL(Z) Z=" &PANELRC = 9" OK=WL(Z) Z=" IF (.RESP = END,RETURN)" OK=WL(Z) Z=" &PANELRC = 4" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" IF (&PFINHALT = RETURN)" OK=WL(Z) Z=" &PANELRC = 8" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" IF (&ZCMD = CAN,CANCEL)" OK=WL(Z) Z=" &PANELRC = 9" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" &VZCMD1 = TRUNC(&ZCMD,' ')" OK=WL(Z) Z=" &VZCMD2 = .TRAIL" OK=WL(Z) Z=")End" OK=WL(Z) RETURN PAN_FTPIPED: Z=")ATTR" OK=WL(Z) Z=" + TYPE(TEXT) INTENS(LOW) SKIP(ON) color(WHITE)" OK=WL(Z) Z=" $ TYPE(TEXT) INTENS(HIGH) SKIP(ON) color(pink)" OK=WL(Z) Z=" ` TYPE(INPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT)" OK=WL(Z) Z=" * TYPE(OUTPUT) INTENS(LOW) SKIP(ON)" OK=WL(Z) Z=" ! TYPE(OUTPUT) INTENS(HIGH) SKIP(ON)" OK=WL(Z) Z=")BODY EXPAND(áá)" OK=WL(Z) Z="%á-á Edit Execute Statement á-á" OK=WL(Z) Z="%Command ===>_ZCMD " !!, " + " OK=WL(Z) Z="+" OK=WL(Z) Z="+" OK=WL(Z) Z="+" OK=WL(Z) Z="+ Source FILE :`SFILE " OK=WL(Z) Z=" " OK=WL(Z) Z="+ " OK=WL(Z) Z="+ Target FILE :`TFILE " OK=WL(Z) Z=" " OK=WL(Z) Z="+" OK=WL(Z) Z="+ Target Userid :+_TUID" OK=WL(Z) Z="+" OK=WL(Z) Z="+ Target IP :+_TADDR" OK=WL(Z) Z="+" OK=WL(Z) Z="+ Port :+_Port" OK=WL(Z) Z="+" OK=WL(Z) Z="+ Transfermode :+_TRMODE + ASCI/B" !!, "IN " OK=WL(Z) Z="+" OK=WL(Z) Z="+ Sorting :+_Sortkz + Sort i" !!, "n Liste " OK=WL(Z) Z="+" OK=WL(Z) Z="+ Active mark :+_AKTIVE +" OK=WL(Z) Z="+" OK=WL(Z) Z="+ description :+_Beschr" OK=WL(Z) Z="+" OK=WL(Z) Z="+ site Parm :+_SITEP" OK=WL(Z) Z=" " OK=WL(Z) Z=" " OK=WL(Z) Z="+" OK=WL(Z) Z="+!Z " !!, " + " OK=WL(Z) Z="%á-á E n d e á-á" OK=WL(Z) Z=")INIT" OK=WL(Z) Z=" .ZVARS = '(MSGLINE )'" OK=WL(Z) Z=" &USER = &USER" OK=WL(Z) Z=" &MSGLINE = &MSGLINE" OK=WL(Z) Z=")PROC" OK=WL(Z) Z="&PF = .PFKEY" OK=WL(Z) Z=")END" OK=WL(Z) RETURN PAN_FTPCOPY: Z=")ATTR DEFAULT(%+_)" OK=WL(Z) Z=" % TYPE(TEXT ) INTENS(HIGH) SKIP(ON)" OK=WL(Z) Z=" + TYPE(TEXT ) INTENS(LOW ) SKIP(ON)" OK=WL(Z) Z=" _ TYPE(INPUT) INTENS(HIGH) CAPS(ON) JUST(LEFT) HILITE(USCORE)" OK=WL(Z) Z=" õ TYPE(INPUT) INTENS(HIGH) CAPS(ON ) JUST(LEFT)" OK=WL(Z) Z=" ` TYPE(INPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT)" OK=WL(Z) Z=" $ TYPE(INPUT) INTENS(NON) CAPS(OFF)" OK=WL(Z) Z=" HILITE(USCORE)" OK=WL(Z) Z=" ! TYPE(OUTPUT) INTENS(LOW ) CAPS(OFF) JUST(LEFT) PAD(' ')" OK=WL(Z) Z=" ø TYPE(OUTPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT) PAD(' ')" OK=WL(Z) Z=" ^ TYPE(OUTPUT) INTENS(HIGH) CAPS(OFF) HILITE(USCORE) JUST(RIGHT" !!, ") " OK=WL(Z) Z=")Body Expand(//)" OK=WL(Z) Z="%Command ==>_zcmd / / %S" !!, "croll ===>_AMT +" OK=WL(Z) Z="+ +" OK=WL(Z) Z="%Source +Addr.%>øSADDR +USERID%>!SUID +%wait", "_wm+ n or w" OK=WL(Z) Z="+File%>`SFILE" OK=WL(Z) Z="%Target + show commands _SCM + " OK=WL(Z) Z="+File%>`TFILE " !!, " +" OK=WL(Z) Z="+Addr. %>_TADDR +Port %>_PORT +" OK=WL(Z) Z="+USERID%>_TUID +" OK=WL(Z) Z="+PASSWD%>$TPWD +" OK=WL(Z) Z="+Transfere Mode%>_TRMODE+ B=BIN, A=ASC +Dumpfile%>_DU +ADRDSSU Y" !!, " N +" OK=WL(Z) Z="+MSG %>øz" OK=WL(Z) Z="+SEL+Source +CRDATE +MODDATE +TARGET +RC +" OK=WL(Z) Z="+ õSMEM1 + õSMEM2 +" OK=WL(Z) Z="+--- -------- ---------- ----------- --------+----" OK=WL(Z) Z=")MODEL ROWS(&SCAVAR)" OK=WL(Z) Z="_SEL!MEMLI1 !MCDATE !MMDATE _MEMLI2 ^CRC+" OK=WL(Z) Z=")INIT" OK=WL(Z) Z=" .ZVARS = '( +" OK=WL(Z) Z=" MSGLINE +" OK=WL(Z) Z=" ) '" OK=WL(Z) Z=" &ZCURSOR = .CURSOR" OK=WL(Z) Z=" .HELP = FTPCOPYH" OK=WL(Z) Z=" &MSGLINE = &MSGLINE" OK=WL(Z) Z=")REINIT" OK=WL(Z) Z=" REFRESH(*)" OK=WL(Z) Z=" &ZCURSOR = .CURSOR" OK=WL(Z) Z=")PROC" OK=WL(Z) Z=" &PF = .PFKEY" OK=WL(Z) Z=" &PFINHALT = TRUNC(&PFTASTE,2)" OK=WL(Z) Z=" &PFINHALT = .TRAIL" OK=WL(Z) Z=" &PFINHALT = PFK(&PFINHALT)" OK=WL(Z) Z="" OK=WL(Z) Z=" &PANELRC = 0" OK=WL(Z) Z="IF (.RESP = END,RETURN)" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" &PANELRC = 8" OK=WL(Z) Z=" IF (.RESP = END,RETURN)" OK=WL(Z) Z=" &PANELRC = 4" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" IF (&PFINHALT = RETURN)" OK=WL(Z) Z=" &PANELRC = 8" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" IF (&ZCMD = CAN,CANCEL)" OK=WL(Z) Z=" &PANELRC = 9" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" &VZCMD1 = TRUNC(&ZCMD,' ')" OK=WL(Z) Z=" &VZCMD2 = .TRAIL" OK=WL(Z) Z=")End" OK=WL(Z) RETURN PAN_FTPCOPYH: Z=")ATTR DEFAULT(%+_)" OK=WL(Z) Z=" % TYPE(TEXT ) INTENS(HIGH) SKIP(ON)" OK=WL(Z) Z=" + TYPE(TEXT ) INTENS(LOW ) SKIP(ON)" OK=WL(Z) Z=" ! TYPE(TEXT ) INTENS(HIGH) CAPS(ON) JUST(LEFT ) HILITE(USCORE" !!, ") " OK=WL(Z) Z=")BODY WIDTH(&ZSCREENW)" OK=WL(Z) Z="%Command ==>_zcmd" OK=WL(Z) Z="+" OK=WL(Z) Z="+Source" OK=WL(Z) Z="+File%>!Sourcefile" OK=WL(Z) Z="+Addr.%>!Source IP +USERID>!Source Userid +" OK=WL(Z) Z="%Target + show commands _SCM + " OK=WL(Z) Z="+File%>!Target File " !!, " +" OK=WL(Z) Z="+Addr.% >!Target IP +Port %>!PORT +" OK=WL(Z) Z="+USERID%!TO Userid +" OK=WL(Z) Z="+PASSWD%>!TO Password +" OK=WL(Z) Z="+Transfere Mode>!B/A B=BIN, A=ASC" OK=WL(Z) Z="+MSG >!Messages" OK=WL(Z) Z="+SEL+Source +CRDATE +MODDATE +TARGET +RC +" OK=WL(Z) Z="+ !Serch Member !Search Member" OK=WL(Z) Z="+--- -------- ---------- ----------- --------+----" OK=WL(Z) Z="!P/G !SRC Mem !Creation Date!Change date !Target Member" OK=WL(Z) Z="!C= Copy to remote File" OK=WL(Z) Z="!P= Copy(PUT) to remote File" OK=WL(Z) Z="!G= Get From remote File" OK=WL(Z) Z=")PROC" OK=WL(Z) Z=")END" OK=WL(Z) RETURN PAN_FTPCOPYS: Z=")ATTR DEFAULT(%+_)" OK=WL(Z) Z=" % TYPE(TEXT ) INTENS(HIGH) SKIP(ON)" OK=WL(Z) Z=" + TYPE(TEXT ) INTENS(LOW ) SKIP(ON)" OK=WL(Z) Z=" _ TYPE(INPUT) INTENS(HIGH) CAPS(ON) JUST(LEFT ) HILITE(USCORE" !!, ") " OK=WL(Z) Z=" õ TYPE(INPUT) INTENS(HIGH) CAPS(ON ) JUST(LEFT)" OK=WL(Z) Z=" $ TYPE(INPUT) INTENS(NON) CAPS(OFF)" OK=WL(Z) Z=" ` TYPE(INPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT)" OK=WL(Z) Z=" HILITE(USCORE)" OK=WL(Z) Z=" ! TYPE(OUTPUT) INTENS(LOW ) CAPS(OFF) JUST(LEFT) PAD(' ')" OK=WL(Z) Z=" ø TYPE(OUTPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT) PAD(' ')" OK=WL(Z) Z=" ^ TYPE(OUTPUT) INTENS(HIGH) CAPS(OFF) HILITE(USCORE) JUST(RIGHT" !!, ") " OK=WL(Z) Z=")Body Expand(//)" OK=WL(Z) Z="%Command ==>_zcmd / / %S" !!, "croll ===>_AMT +" OK=WL(Z) Z="+ +" OK=WL(Z) Z="%Source +Addr.%>øSADDR +USERID%>!SUID +" OK=WL(Z) Z="+File%>`SFILE" OK=WL(Z) Z="%Target + show commands _SCM + " OK=WL(Z) Z="+File%>`TFILE " !!, " +" OK=WL(Z) Z="+Addr.% >_TADDR +Port %>_PORT +" OK=WL(Z) Z="+USERID%>_TUID +" OK=WL(Z) Z="+PASSWD%>$TPWD +" OK=WL(Z) Z="+Transfere Mode%>_TRMODE+ B=BIN, A=ASC +Dumpfile%>_DU +ADRDSSU Y" !!, " N +" OK=WL(Z) Z="+MSG %>øz" OK=WL(Z) Z="+SEL+Source +RC +" OK=WL(Z) Z="+ õSMEM1 +" OK=WL(Z) Z="+--- -------------------------------------------------+" OK=WL(Z) Z=")MODEL ROWS(&SCAVAR)" OK=WL(Z) Z="_SEL!MEMLI1 +" OK=WL(Z) Z=" !MEMLI2 ^CRC+" OK=WL(Z) Z=")INIT" OK=WL(Z) Z=" .ZVARS = '( +" OK=WL(Z) Z=" MSGLINE +" OK=WL(Z) Z=" ) '" OK=WL(Z) Z=" &ZCURSOR = .CURSOR" OK=WL(Z) Z=" .HELP = FTPCOPYH" OK=WL(Z) Z=" &MSGLINE = &MSGLINE" OK=WL(Z) Z=")REINIT" OK=WL(Z) Z=" REFRESH(*)" OK=WL(Z) Z=" &ZCURSOR = .CURSOR" OK=WL(Z) Z=")PROC" OK=WL(Z) Z=" &PF = .PFKEY" OK=WL(Z) Z=" &PFINHALT = TRUNC(&PFTASTE,2)" OK=WL(Z) Z=" &PFINHALT = .TRAIL" OK=WL(Z) Z=" &PFINHALT = PFK(&PFINHALT)" OK=WL(Z) Z="" OK=WL(Z) Z=" &PANELRC = 0" OK=WL(Z) Z="IF (.RESP = END,RETURN)" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" &PANELRC = 8" OK=WL(Z) Z="IF (&ZCMD = CAN,CANCEL)" OK=WL(Z) Z=" &PANELRC = 9" OK=WL(Z) Z=" IF (.RESP = END,RETURN)" OK=WL(Z) Z=" &PANELRC = 4" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" IF (&PFINHALT = RETURN)" OK=WL(Z) Z=" &PANELRC = 8" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" IF (&ZCMD = CAN,CANCEL)" OK=WL(Z) Z=" &PANELRC = 9" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" &VZCMD1 = TRUNC(&ZCMD,' ')" OK=WL(Z) Z=" &VZCMD2 = .TRAIL" OK=WL(Z) Z=")End" OK=WL(Z) RETURN PAN_FTPCOPYU: Z=")ATTR DEFAULT(%+_)" OK=WL(Z) Z=" % TYPE(TEXT ) INTENS(HIGH) SKIP(ON)" OK=WL(Z) Z=" + TYPE(TEXT ) INTENS(LOW ) SKIP(ON)" OK=WL(Z) Z=" _ TYPE(INPUT) INTENS(HIGH) CAPS(ON) JUST(LEFT ) HILITE(USCORE" !!, ") " OK=WL(Z) Z=" õ TYPE(INPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT)" OK=WL(Z) Z=" ` TYPE(INPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT)" OK=WL(Z) Z=" $ TYPE(INPUT) INTENS(NON) CAPS(OFF)" OK=WL(Z) Z=" HILITE(USCORE)" OK=WL(Z) Z=" ! TYPE(OUTPUT) INTENS(LOW ) CAPS(OFF) JUST(LEFT) PAD(' ')" OK=WL(Z) Z=" ø TYPE(OUTPUT) INTENS(HIGH) CAPS(OFF) JUST(LEFT) PAD(' ')" OK=WL(Z) Z=" ^ TYPE(OUTPUT) INTENS(HIGH) CAPS(OFF) HILITE(USCORE) JUST(RIGHT" !!, ") " OK=WL(Z) Z=")Body Expand(//)" OK=WL(Z) Z="%Command ==>_zcmd / / %S" !!, "croll ===>_AMT +" OK=WL(Z) Z="+ +" OK=WL(Z) Z="%Source +Addr.%>øSADDR +USERID%>!SUID +" OK=WL(Z) Z="+File%>`SFILE" OK=WL(Z) Z="%Target + show commands _SCM + " OK=WL(Z) Z="+File%>`TFILE " !!, " +" OK=WL(Z) Z="+Addr.% >_TADDR +Port %>_PORT +" OK=WL(Z) Z="+USERID%>_TUID +" OK=WL(Z) Z="+PASSWD%>$TPWD +" OK=WL(Z) Z="+Transfere Mode%>_TRMODE+ B=BIN, A=ASC +Dumpfile%>_DU +ADRDSSU Y" !!, " N +" OK=WL(Z) Z="+MSG %>øz" OK=WL(Z) Z="+SEL+Source +Type +grp +user +size +TARGET " !!, " +RC + " OK=WL(Z) Z="+ õSMEM1 + õSMEM2 " !!, " + " OK=WL(Z) Z="+--- -------- ------- -------- -------- +--------- ---------" OK=WL(Z) Z=")MODEL ROWS(&SCAVAR)" OK=WL(Z) Z="_SEL!MEMLI1 !mtype !mgrp !muser !msize !MEMLI2 " !!, " ^CRC+ " OK=WL(Z) Z=")INIT" OK=WL(Z) Z=" .ZVARS = '( +" OK=WL(Z) Z=" MSGLINE +" OK=WL(Z) Z=" ) '" OK=WL(Z) Z=" &ZCURSOR = .CURSOR" OK=WL(Z) Z=" .HELP = FTPCOPYH" OK=WL(Z) Z=" &MSGLINE = &MSGLINE" OK=WL(Z) Z=")REINIT" OK=WL(Z) Z=" REFRESH(*)" OK=WL(Z) Z=" &ZCURSOR = .CURSOR" OK=WL(Z) Z=")PROC" OK=WL(Z) Z=" &PF = .PFKEY" OK=WL(Z) Z=" &PFINHALT = TRUNC(&PFTASTE,2)" OK=WL(Z) Z=" &PFINHALT = .TRAIL" OK=WL(Z) Z=" &PFINHALT = PFK(&PFINHALT)" OK=WL(Z) Z="" OK=WL(Z) Z="&PANELRC = 0" OK=WL(Z) Z="IF (.RESP = END,RETURN)" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" &PANELRC = 8" OK=WL(Z) Z="IF (&ZCMD = CAN,CANCEL)" OK=WL(Z) Z=" &PANELRC = 9" OK=WL(Z) Z=" &PANELRC = 0" OK=WL(Z) Z=" IF (.RESP = END,RETURN)" OK=WL(Z) Z=" &PANELRC = 4" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" IF (&PFINHALT = RETURN)" OK=WL(Z) Z=" &PANELRC = 8" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" IF (&ZCMD = CAN,CANCEL)" OK=WL(Z) Z=" &PANELRC = 9" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" &VZCMD1 = TRUNC(&ZCMD,' ')" OK=WL(Z) Z=" &VZCMD2 = .TRAIL" OK=WL(Z) Z=")End" OK=WL(Z) RETURN WL: if Datatype(WLine.0) <> "NUM" Then WLine.0 = 0 WLine.0 = WLine.0 + 1 WLineI = WLine.0 WLine.WLineI = Arg(1) Return 0 Write_Mem: ADDRESS ISPEXEC 'LMINIT DATAID(DID) DDNAME(PLIB) ENQ(EXCLU)' 'LMOPEN DATAID(&DID) OPTION(OUTPUT)' 'LMMDEL DATAID(&DID) MEMBER('MemName')' DROP INVAR Do i = 1 to WLine.0 P1 = WLine.i "LMPUT DATAID(&DID) MODE(INVAR) DATALOC(P1) DATALEN(80)" End 'LMMADD DATAID(&DID) MEMBER('MemName')' 'LMFREE DATAID(&DID)' 'LMCLOSE DATAID(&DID)' 'LMFREE DATAID(&DID)' Return 0 Init_site_Parm: site.1 = "ASAtrans " site.2 = "AUTOMount " site.3 = "AUTORecall " site.4 = "BLKsize " site.5 = "BLocks " site.6 = "BLOCKSIze " site.7 = "BUfno " site.8 = "CHKptint " site.9 = "CHMod " site.10 = "CONDdisp " site.11 = "CTRLConn " site.12 = "CYlinders " site.13 = "DATAClass " site.14 = "DATAKEEPALIVE " site.15 = "DATASetmode " site.16 = "DBSUB " site.17 = "DCbdsn " site.18 = "DEBug " site.19 = "DESt " site.20 = "Directory " site.21 = "DIRECTORYMode " site.22 = "DSNTYPE " site.23 = "DSWAITTIME " site.24 = "DSWAITTIMEREPLY " site.25 = "DUMP " site.26 = "EATTR " site.27 = "ENCODING " site.28 = "FIFOIOTIME " site.29 = "FIFOOPENTIME " site.30 = "FILEtype " site.31 = "ISPFSTATS " site.32 = "JESENTRYLimit " site.33 = "JESGETBYDSN " site.34 = "JESJOBName " site.35 = "JESLrecl " site.36 = "JESOwner " site.37 = "JESRecfm " site.38 = "JESSTatus " site.39 = "LISTLEVEL " site.40 = "LISTSUBdir " site.41 = "LRecl " site.42 = "MBDATACONN " site.43 = "MBREQUIRELASTEOL " site.44 = "MBSENDEOL " site.45 = "MGmtclass " site.46 = "MIGratevol " site.47 = "NOASAtrans " site.48 = "NOAUTOMount " site.49 = "NOAUTORecall " site.50 = "NODBSUB " site.51 = "NOISPFSTATS " site.52 = "NOJESGETBYDSN " site.53 = "NOLISTSUBdir " site.54 = "NOMBREQUIRELASTEOL " site.55 = "NOQUOtesoverride " site.56 = "NORDW " site.57 = "NOREMOVEINBEOF " site.58 = "NORESTPUT " site.59 = "NOSBSUB " site.60 = "NOSPRead " site.61 = "NOTAPEREADSTREAM " site.62 = "NOTRAILingblanks " site.63 = "NOTRUNcate " site.64 = "NOUCSSUB " site.65 = "NOUCSTRUNC " site.66 = "NOWRAPrecord " site.67 = "NOWRTAPEFastio " site.68 = "PDSTYPE " site.69 = "PRImary " site.70 = "Qdisk " site.71 = "QUOtesoverride " site.72 = "RDW " site.73 = "READTAPEFormat " site.74 = "RECfm " site.75 = "REMOVEINBEOF " site.76 = "RESTPUT " site.77 = "RETpd " site.78 = "SBDataconn " site.79 = "SBSENDEOL " site.80 = "SBSUB " site.81 = "SECondary " site.82 = "SPRead " site.83 = "SQLCol " site.84 = "SUBSYS " site.85 = "TAPEREADSTREAM " site.86 = "TRacks " site.87 = "TRAILingblanks " site.88 = "TRUNcate " site.89 = "UCOUNT " site.90 = "UCSHOSTCS " site.91 = "UCSSUB " site.92 = "UCSTRUNC " site.93 = "UMask " site.94 = "UNICODEFILESYSTEMBOM" site.95 = "Unit " site.96 = "UNIXFILETYPE " site.97 = "VCOUNT " site.98 = "VOLume " site.99 = "WRAPrecord " site.100 = "WRTAPEFastio " site.101 = "XLate " site.0 = 101 return copy_to_my_table: MEMNAME = Arg(1) DDNAME = 'ISPTABL' Ret = LISTDSI(DDNAME' FILE') fromds = tlibdd fromds = Strip(fromds, , "'") !! "(" !! MEMNAME !! ")" fromds = "'" !! fromds !! "'" tods = "'" !! SYSDSNAME !! "(" !! MEMNAME !! ")'" /* Wenn datei schon da ist, dann nicht kopieren */ IF SYSDSN(fromds) <> "OK" then Do Return End IF SYSDSN(tods) = "OK" then Do Return End /* not found then copy dataset */ ADDRESS ISPEXEC "LMINIT DATASET("TLIBDD") DATAID(inpSID) ENQ(SHR)" "LMINIT DATASET('"SYSDSNAME"') DATAID(OUTSID) ENQ(SHRw)" "LMCOPY FROMID("inpSID") TODATAID("OUTSID") FROMMEM("MEMNAME")" IF RC = 0 THEN Do "LMFREE DATAID("INPSID")" "LMFREE DATAID("OUTSID")" End ADDRESS "TSO" return error: failure: syntax: novalue: halt: Address ISPEXEC "TBCLOSE "MEMLIST rexx = sysvar(sysicmd) say SRC.3":" cstr = CONDITION('Condition') /* Name of trapped condition*/ istr = CONDITION('Instruction') /* CALL or SIGNAL */ dstr = CONDITION('Description') /* Description or null */ sstr = CONDITION('Status') /* ON, OFF, or DELAY */ Say 'Condition :'cstr say 'Instruction:'istr say 'Description:'dstr say 'Status :'sstr If condition = 'HALT' Then do Say SRC.3 "manually abort " condition condition('C') End Else Do Say SRC.3 condition condition = condition('C') source = strip(sourceline(sigl),"B") say copies('*',79) say left('* 'condition' CONDITION ON LINE 'sigl' OF REXX 'rexx,78)'*' say left('* 'source,78)'*' say left('* RETURN CODE 'rc,78)'*' say left('* 'errortext(rc),78)'*' say copies('*',79) End If LIBDEF = "Y" then Do ADDRESS ISPEXEC "LIBDEF ISPPLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID( )" "FREE F(PLIB)" ADDRESS TSO "DELETE " !! PLIBDS End exit 100 return