/* ************************************************************************** */
/* DBG187CL: WRKUSROUTQ Screen option processor                               */
/* Copyright (C) 2000  Martin Rowe  <martin@dbg400.net>                       */
/*                                                                            */
/* This program is free software; you can redistribute it and/or modify       */
/* it under the terms of the GNU General Public License as published by       */
/* the Free Software Foundation; either version 2 of the License, or          */
/* (at your option) any later version.                                        */
/*                                                                            */
/* This program is distributed in the hope that it will be useful,            */
/* but WITHOUT ANY WARRANTY; without even the implied warranty of             */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              */
/* GNU General Public License for more details.                               */
/*                                                                            */
/* You should have received a copy of the GNU General Public License          */
/* along with this program; if not, write to the Free Software                */
/* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307   USA */
/*                                                                            */
/* Some commands (c) Tom Liotta http://zap.to/tl400 Used with permission      */
/* ************************************************************************** */
PGM PARM(&FILE &JOB &USER &JOBNBR &SPLNBR +
         &OPTION &BATCHFILE &STMFDIR &FTPDIR +
         &REMOTEMACH &REMOTEUSER &REMOTEPASS +
         &FILEEXT &FORMAT &FILENAME &HTMLTITLE)
  DCL        VAR(&BATCHFILE) TYPE(*CHAR) LEN(50)
  DCL        VAR(&EMPTY) TYPE(*CHAR) LEN(10) VALUE(' ')
  DCL        VAR(&FILE) TYPE(*CHAR) LEN(10)
  DCL        VAR(&FILEEXT) TYPE(*CHAR) LEN(5)
  DCL        VAR(&FILEPATH) TYPE(*CHAR) LEN(63)
  DCL        VAR(&FILENAME) TYPE(*CHAR) LEN(50)
  DCL        VAR(&FULLFILE) TYPE(*CHAR) LEN(55)
  DCL        VAR(&FORMAT) TYPE(*CHAR) LEN(1)
  DCL        VAR(&JOB) TYPE(*CHAR) LEN(10)
  DCL        VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
  DCL        VAR(&MBROPT) TYPE(*CHAR) LEN(8)
  DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(512)
  DCL        VAR(&OPTION) TYPE(*CHAR) LEN(1)
  DCL        VAR(&PAGELENGTH) TYPE(*DEC) LEN(3 0)
  DCL        VAR(&PCCMD) TYPE(*CHAR) LEN(250)
  DCL        VAR(&PCFILE) TYPE(*CHAR) LEN(50)
  DCL        VAR(&PCFILEEXT) TYPE(*CHAR) LEN(10)
  DCL        VAR(&PCSTMF) TYPE(*CHAR) LEN(150)
  DCL        VAR(&PCSTMFPATH) TYPE(*CHAR) LEN(150)
  DCL        VAR(&RTNDIR) TYPE(*CHAR) LEN(60)
  DCL        VAR(&FTPDIR) TYPE(*CHAR) LEN(60)
  DCL        VAR(&HTMLTITLE) TYPE(*CHAR) LEN(50)
  DCL        VAR(&DIRNAMLEN) TYPE(*DEC) LEN(7 0)
  DCL        VAR(&REMOTEMACH) TYPE(*CHAR) LEN(15)
  DCL        VAR(&REMOTEUSER) TYPE(*CHAR) LEN(10)
  DCL        VAR(&REMOTEPASS) TYPE(*CHAR) LEN(10)
  DCL        VAR(&SPLNBR) TYPE(*CHAR) LEN(4)
  DCL        VAR(&SPLNBRDEC) TYPE(*DEC) LEN(4 0)
  DCL        VAR(&STARTPOS) TYPE(*DEC) LEN(3 0) VALUE(1)
  DCL        VAR(&STMF) TYPE(*CHAR) LEN(150)
  DCL        VAR(&STMFDIR) TYPE(*CHAR) LEN(60)
  DCL        VAR(&STMFDIRWIN) TYPE(*CHAR) LEN(60)
  DCL        VAR(&SYSPATH) TYPE(*CHAR) LEN(20)
  DCL        VAR(&USER) TYPE(*CHAR) LEN(10)
/* ************************************************************************** */
/*  GLOBAL MESSAGE MONITOR                                                    */
/* ************************************************************************** */
  MONMSG     MSGID(CPF0000 RPG0000 QRG0000 RSF0000 +
               MCH0000) EXEC(GOTO CMDLBL(##ERROR))
  GOTO       CMDLBL(##NOERROR)
##ERROR:
/*  MOVDIAGMSG (c) Tom Liotta http://zap.to/tl400 Used with permission        */
  MOVDIAGMSG
  MONMSG     MSGID(CPF0000)
/*  RSNESCMSG (c) Tom Liotta http://zap.to/tl400 Used with permission         */
  RSNESCMSG
  MONMSG     MSGID(CPF0000)
  RETURN
##NOERROR:
/* ************************************************************************** */
/*  START OF MAINLINE CODE                                                    */
/* ************************************************************************** */
  CHGVAR     VAR(&MBROPT) VALUE('*REPLACE')
/* Option 1: Send spool file */
  IF         COND(&OPTION *EQ '1') THEN(DO)
    ?          SNDNETSPLF FILE(&FILE) +
                 JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLNBR)
    MONMSG     MSGID(CPF0000)
  ENDDO
/* Option 2: Change spoolfile attributes */
  IF         COND(&OPTION *EQ '2') THEN(DO)
    ?          CHGSPLFA FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) +
                 SPLNBR(&SPLNBR)
    MONMSG     MSGID(CPF0000)
  ENDDO
/* Option 3: Hold spoolfile */
  IF         COND(&OPTION *EQ '3') THEN(DO)
    HLDSPLF    FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) +
                 SPLNBR(&SPLNBR)
    MONMSG     MSGID(CPF0000)
  ENDDO
/* Option 4: Delete spoolfile */
  IF         COND(&OPTION *EQ '4') THEN(DO)
    DLTSPLF    FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) +
                 SPLNBR(&SPLNBR)
    MONMSG     MSGID(CPF0000)
  ENDDO
/* Option 5: Display spoolfile */
  IF         COND(&OPTION *EQ '5') THEN(DO)
    DSPSPLF    FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) +
                 SPLNBR(&SPLNBR)
    MONMSG     MSGID(CPF0000)
  ENDDO
/* Option 6: Release spoolfile */
  IF         COND(&OPTION *EQ '6') THEN(DO)
    RLSSPLF    FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) +
                 SPLNBR(&SPLNBR)
    MONMSG     MSGID(CPF0000)
  ENDDO
/* Option 7: Display messages */
  IF         COND(&OPTION *EQ '7') THEN(DO)
         /* ??Not worked out an easy way of doing this yet?? */

  ENDDO
/* Option 8: Display spoolfile attributes */
  IF         COND(&OPTION *EQ '8') THEN(DO)
    WRKSPLFA   FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) +
                 SPLNBR(&SPLNBR)
    MONMSG     MSGID(CPF0000)
  ENDDO
/* Option 9: Change spoolfile attributes */
  IF         COND(&OPTION *EQ '9') THEN(DO)
    WRKPRTSTS  FILE(&FILE) JOB(&JOBNBR/&USER/&JOB) +
                 SPLNBR(&SPLNBR)
    MONMSG     MSGID(CPF0000)
  ENDDO
/* If one of the formatted/PC file options */
  IF         COND((&OPTION *EQ 'P') *OR (&OPTION *EQ 'T') +
               *OR (&OPTION *EQ 'V') *OR (&OPTION *EQ 'F')) THEN(DO)
    CHGVAR     VAR(&MSGDTA) VALUE('Processing selected +
                 spoolfile. Please wait...')
    SNDPGMMSG  MSGID(GSM9999) MSGF(DBGMSGF) MSGDTA(&MSGDTA) +
                 TOPGMQ(*EXT) MSGTYPE(*STATUS)
/* Clear out the file that will hold the resultant data */
    CLRPFM     FILE(QTEMP/DBG1872W)
/* If target format is HTML, add the standard header */
    IF         COND((&FILEEXT *EQ '.HTML') *OR (&FILEEXT +
                 *EQ '.html')) THEN(DO)
      CALL       PGM(DBG189R4) PARM('HTMLSTART' &HTMLTITLE)
      MONMSG     MSGID(CPF0000)
    ENDDO
/* Load the 'from' file with spoolfile data, if formatting required */
    IF         COND((&OPTION *EQ 'V') *OR (&FORMAT *EQ +
                 'Y')) THEN(DO)
      CPYSPLF    FILE(&FILE) TOFILE(QTEMP/DBG1871W) +
                   JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLNBR) +
                   CTLCHAR(*PRTCTL)
/* Any problems, then quit */
      MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ENDPGM))
/* Format the data (insert blank lines, etc) */
      OVRDBF     FILE(DBG1871W) TOFILE(QTEMP/DBG1871W)
      OVRDBF     FILE(DBG1872W) TOFILE(QTEMP/DBG1872W)
      CHGVAR     VAR(&SPLNBRDEC) VALUE(&SPLNBR)
      CALL       PGM(DBG187R4) PARM(&JOB &USER &JOBNBR &FILE +
                   &SPLNBRDEC)
      DLTOVR     FILE(DBG1871W)
      DLTOVR     FILE(DBG1872W)
    ENDDO
/* Otherwise load the 'to' file directly, as no special formatting required */
    ELSE       CMD(DO)
      CPYSPLF    FILE(&FILE) TOFILE(QTEMP/DBG1872W) +
                   JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLNBR) +
                   MBROPT(*ADD) CTLCHAR(*NONE)
    ENDDO
/* If target format is HTML, add the standard footer */
    IF         COND((&FILEEXT *EQ '.HTML') *OR (&FILEEXT +
                 *EQ '.html')) THEN(DO)
      CALL       PGM(DBG189R4) PARM('HTMLEND' &HTMLTITLE)
      MONMSG     MSGID(CPF0000)
    ENDDO
/* Option V: View formatted spool file */
    IF         COND(&OPTION *EQ 'V') THEN(DO)
      DSPPFM     FILE(QTEMP/DBG1872W)
    ENDDO
/* Option F, T or P: Save spoolfile as text document */
    IF         COND((&OPTION *EQ 'T') *OR (&OPTION *EQ +
                 'P') *OR (&OPTION *EQ 'F')) THEN(DO)
      CHGVAR     VAR(&FULLFILE) VALUE(&FILENAME |< &FILEEXT)
      CHGVAR     VAR(&PCFILE) VALUE('"' |< &FILENAME |< '"')
      CHGVAR     VAR(&PCFILEEXT) VALUE('"' |< &FILEEXT |< '"')
/* Remove any dodgy characters from the PC filename generated */
      CALL       PGM(DBG191R4) PARM(&FULLFILE)
/* If IFS location provided, use it, otherwise use the current directory */
      IF         COND(&STMFDIR *EQ ' ') THEN(DO)
        RTVCURDIR  RTNDIR(&RTNDIR) DIRNAMLEN(&DIRNAMLEN)
        CHGVAR     VAR(&STMFDIR) VALUE(&RTNDIR)
      ENDDO
      CHGVAR     VAR(&STMF) VALUE(&STMFDIR |< '/' || &FULLFILE)
      CHGVAR     VAR(&FILEPATH) +
                   VALUE('/QSYS.LIB/QTEMP.LIB/DBG1872W.FILE/DB+
                   G1872W.MBR')
/* Copy to IFS as a text file                                                 */
      CPYTOSTMF  FROMMBR(&FILEPATH) TOSTMF(&STMF) +
                   STMFOPT(*REPLACE) STMFCODPAG(*PCASCII)
/* Tell user where the file is located (useful for cut'n'paste if required) */
      IF         COND(&OPTION *EQ 'T') THEN(DO)
        CHGVAR     VAR(&MSGDTA) VALUE('File: ' || &STMF)
        SNDPGMMSG  MSGID(GSM9999) MSGF(DBGMSGF) MSGDTA(&MSGDTA) +
                     TOPGMQ(*PRV) MSGTYPE(*COMP)
      ENDDO
/* For option P or F resolve IP address of remote machine if not specified */
      IF         COND((&OPTION *EQ 'P') *OR (&OPTION *EQ +
                   'F')) THEN(DO)
/*  RTNIPADDR (c) Tom Liotta http://zap.to/tl400 Used with permission         */
        IF         COND(&REMOTEMACH *EQ ' ') THEN(RTNIPADDR +
                     IPADDR(&REMOTEMACH))
      ENDDO
/* Option P: Open text document on local PC (requires AS/400 & PC config) */
      IF         COND(&OPTION *EQ 'P') THEN(DO)
        CHGVAR     VAR(&STMFDIRWIN) VALUE(&STMFDIR)
        CALL       PGM(DBG192R4) PARM(&STMFDIRWIN)
        CHGVAR     VAR(&PCSTMFPATH) VALUE('"' || '\\' || +
                     &SYSPATH |< &STMFDIRWIN |< '\"')
        CHGVAR     VAR(&PCCMD) VALUE(&BATCHFILE |> &PCSTMFPATH +
                     |> &PCFILE |> &PCFILEEXT)
        RUNRMTCMD  CMD(&PCCMD) RMTLOCNAME(&REMOTEMACH *IP) +
                     RMTUSER(*CURRENT) RMTPWD(&REMOTEPASS)
        MONMSG     MSGID(CPF9100) EXEC(DO)
/* Tell user they need to have IT set them up for auto transfer */
          CHGVAR     VAR(&MSGDTA) VALUE('Your system is not +
                       correctly configured for opening the PC +
                       file - Contact IT.')
          SNDPGMMSG  MSGID(GSM9999) MSGF(DBGMSGF) MSGDTA(&MSGDTA) +
                       TOPGMQ(*PRV) MSGTYPE(*COMP)
        ENDDO
/* Delete the text file now */
        RMVLNK     OBJLNK(&STMF)
      ENDDO
/* Option F: FTP the document to the target machine */
      IF         COND(&OPTION *EQ 'F') THEN(DO)
        CLRPFM     FILE(QTEMP/FTPSRC) MBR(FTPOUT)
        OVRDBF     FILE(FTPSRC) TOFILE(QTEMP/FTPSRC) MBR(FTPIN)
        CALL       PGM(DBG190R4) PARM(&FILENAME &FILEEXT +
                     &STMFDIR &FTPDIR &REMOTEMACH &REMOTEUSER &REMOTEPASS)
        DLTOVR     FILE(FTPSRC)
        OVRDBF     FILE(INPUT) TOFILE(QTEMP/FTPSRC) MBR(FTPIN)
        OVRDBF     FILE(OUTPUT) TOFILE(QTEMP/FTPSRC) MBR(FTPOUT)
        FTP        RMTSYS(DUMMY_HOST)
        DLTOVR     FILE(INPUT OUTPUT)
        CLRPFM     FILE(QTEMP/FTPSRC) MBR(FTPIN)
/* Delete the text file now */
        RMVLNK     OBJLNK(&STMF)
        CHGVAR     VAR(&MSGDTA) VALUE('File: ' || +
                     &FULLFILE |< ' sent to ' || &REMOTEMACH)
        SNDPGMMSG  MSGID(GSM9999) MSGF(DBGMSGF) MSGDTA(&MSGDTA) +
                     TOPGMQ(*PRV) MSGTYPE(*COMP)
      ENDDO
    ENDDO
  ENDDO
ENDPGM:
  DLTOVR     FILE(DBGUOL00)
  MONMSG     MSGID(CPF9841)
  RETURN
ENDPGM

-- MartinRowe - 24 Jun 2005
Topic revision: r1 - 24 Jun 2005 - 05:14:31 - MartinRowe
 
This site is powered by FoswikiCopyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400? Send feedback