You are here: DBG/400>DBG400 Web>SourceCodeList>ClSource>ClDBG187CL (24 Jun 2005, MartinRowe)EditAttach
/* ************************************************************************** */
/* 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 Edit | Attach | Print version | History: r1 | Backlinks | View wiki text | Edit wiki text | More topic actions
Topic revision: r1 - 24 Jun 2005 - 05:14:31 - MartinRowe
Site Map
DBG400
Copyright © 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