|
Code:
- /TITLE Create FTP Script (generic)
- H Copyright('© Copyright Stewart Enterprises, Inc., 2003') Copyright statement
- H Option( *SRCSTMT : *NODEBUGIO )
- H Dftactgrp(*NO) Actgrp(*CALLER)
- *****************************************************************
- * *
- * STEWART ENTERPRISES, INC. *
- * CORPORATE ACCOUNTS RECEIVABLE SYSTEM *
- * *
- * Program Name: ARU912 *
- * *
- * Program Description: Create FTP Script (generic) *
- * *
- * This program developed By Stewart Enterprises, Inc. *
- * 1333 S. Clearview Parkway, Jefferson, LA 70121 *
- * Copyright 2003 *
- * *
- * AUTHOR: F. Lapeyre 03/03/2003 *
- * *
- * This program will build an FTP script. It will write one *
- * record to the output file each time it is called. The *
- * FTP commands are passed in to the program as a string *
- * parameter, along with the file, library, and member to *
- * write. All parameters are required unless PASS = 'L'. *
- * *
- *****************************************************************
- * M O D I F I C A T I O N S *
- *****************************************************************
- * DATE NAME DESCRIPTION
- *****************************************************************
- * XX/XX/XX X. XXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
- * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
- /EJECT
- *****************************************************************
- * F I L E S P E C I F I C A T I O N S *
- *****************************************************************
- FQftpsrc O E Disk Rename(Qftpsrc:Ftpcmd) Usropn
- F Extfile(Ftpfile) Extmbr(P_Member)
-
- /EJECT
- *****************************************************************
- * D E F I N I T I O N S *
- *****************************************************************
-
- * Program Status Data Structure
- D SDS
- D Pgm 10
- D Status 5
- D Msgid 40 46
- D Lib 81 90
- D Filerr 201 208
- D Namjob 244 253
- D User 10
- D Numjob 6 0
- D Sbmdat 6 0
- D Excdat 6 0
- D Exctim 6 0
- D Cmpdat 6 0
- D Cmptim 6 0
- D Srcfil 304 313
- D Srclib 10
- D Srcmbr 10
-
- * Stand Alone Fields
- D Command_String S 3000A Varying
- D Ftpfile S 21A
- D P_Command S 80A
- D P_File S 10A
- D P_Library S 10A
- D P_Member S 10A
- D Page_Msg S 150A Inz
- D Pass S 1A
- D Workdate S D
-
- * Named constants
- D Quote C ''''
-
- * QCMDEXC prototype
- D Runcmd PR Extpgm('QCMDEXC')
- D Cmdstr 3000A Const Options(*VARSIZE)
- D Cmdlen 15P 5 Const
- D Cmddbcs 3A Const Options(*NOPASS)
-
- * Prototype for Aru912
- D Aru912 PR
- D Pass_ 1
- D P_Library_ 10
- D P_File_ 10
- D P_Member_ 10
- D P_Command_ 80
-
- * *ENTRY Interface for Main Procedure
- D Aru912 PI
- D Pass 1
- D P_Library 10
- D P_File 10
- D P_Member 10
- D P_Command 80
- /EJECT
- *****************************************************************
- * P A R A M E T E R S *
- *****************************************************************
-
- /EJECT
- *****************************************************************
- * M A I N L I N E C O D E *
- *****************************************************************
-
- /Free
- Select;
-
- // Pass = 'L' - close file and exit.
- When Pass = 'L';
- If %OPEN(Qftpsrc);
- Close Qftpsrc;
- Endif;
- *INLR = *ON;
- Return;
-
- // Pass <> 'L'
- When Pass <> 'L' And %PARMS = 5;
-
- // Open the FTP command file.
- If Not %OPEN(Qftpsrc);
-
- // Override to the library and file passed in as parameters (member is specified
- // on the EXTMBR keyword in the F-specs).
- // If the library was passed in, use the fully qualified name for the file.
- If (P_Library = *BLANKS);
- Ftpfile = %TRIM(P_File);
- Else;
- Ftpfile = %TRIM(P_Library) + '/' + %TRIM(P_File);
- Endif;
-
- // Attempt to open the FTP command file. If we can't, then send a pager
- // message to the programmer and exit.
- // (Substitute your paging utility here!! )
- Open(E) Qftpsrc;
-
- If %ERROR;
- Page_Msg = 'Unable to open FTP command' + ' file for AS/400 job ' +
- %EDITC(Numjob:'X') + '/' + %TRIM(User) + '/' + %TRIM(Namjob) +
- '. Check job log.';
- Command_String = 'LXIPAG/SNDPAGMSG MSG(' + Quote + %TRIM(Page_Msg) +
- Quote + ') TOUSERS((PROGRAMMER AR))';
- Runcmd(Command_String : %LEN(%TRIMR(Command_String)));
- Pass = 'E';
- *INLR = *ON;
- Return;
- Endif;
-
- Endif;
-
- // Write source record, after incrementing sequence number.
- // Calling program is responsible for passing the commands in the correct case.
- Workdate = %DATE;
- /End-Free
- C *YMD Move Workdate Srcdat
- /Free
- Srcseq = Srcseq + 1.00;
- Srcdta = %TRIM(P_Command);
- Write Ftpcmd;
-
- Endsl;
-
- Return;
- /End-Free
|
|